有DOS 版的AP, 在Win98執行正常, 但在Win2000/WinXP就會有問題,經嘗試多種 方法, 發現透過 PIF 檔的設定可以正常執行, 但重點是該AP執行完後, 我的AP 要負責再將資料備份, 因此就必須等DOS版AP執行完, 以前爬文,用過前輩們的方 式 (WaitForSingleObject), 對於 .exe / .bat / .com 等皆沒問題,這次第一 次用在 PIF 檔, 發現它竟然不會如預期般等 DOS 視窗結束就繼續往下執行. 不知各位前輩是否有解 ? 我的程式如下 : procedure TForm1.Button1Click(Sender: TObject); var ExecInfo : TShellExecuteInfo; FileName : String; sParameter : String; begin FileName := 'D:\TEST.LNK'; // Link 到 M:\Test.Bat sParameter := ''; FillChar(ExecInfo, SizeOf(ExecInfo), 0); ExecInfo.cbSize := SizeOf(ExecInfo); ExecInfo.lpVerb := 'open'; ExecInfo.lpFile := PChar(FileName); ExecInfo.lpParameters := PChar(sParameter); ExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS; ExecInfo.nShow := SW_SHOWDEFAULT; ShellExecuteEx(@ExecInfo); WaitForSingleObject(ExecInfo.hProcess, Infinite); MessageDlg('OK', mtInformation, [mbOK], 0); end;

delphi中如何由 *.lnk档取得其 exe 档案的指向 http://delphi.ktop.com.tw/topic.php?topic_id=58436

先判斷 
if Upper(ExtractFileExt(FileName))='.LNK' then
  FileName:=ResolveLink(FileName);    sParameter := '';
FillChar(ExecInfo, SizeOf(ExecInfo), 0);
ExecInfo.cbSize := SizeOf(ExecInfo);
ExecInfo.lpVerb := 'open';
ExecInfo.lpFile := PChar(FileName);
ExecInfo.lpParameters := PChar(sParameter);
ExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS;
ExecInfo.nShow := SW_SHOWDEFAULT;
ShellExecuteEx(@ExecInfo);    WaitForSingleObject(ExecInfo.hProcess, Infinite);    MessageDlg('OK', mtInformation, [mbOK], 0);
end;    

＠瞭解越多.懂得越少＠

chris_shieh 前輩 : 謝謝您的快速回應 ! 您的方法應是直接去執行該執行檔, 而不是透過PIF, 問題是我的DOS程式若直接 RUN 執行檔會有問題, 目前測試結果, 發現只有透過PIF的一些設定才會正常執 行, 而這些設定好像無法直接設定在該執行檔, 譬如相容性設定, 字碼設定等等 , 也就是說我必須直接執行 PIF ....

用 CreateProcess 的方式不知行不行？ http://groups.google.com.tw/groups?hl=zh-TW&lr=&th=c9f7076693eeccb0&rnum=10

var 
  SI: TStartupInfo; 
  PI:TProgressInformation;
begin
  FillChar(PI, SizeOf(PI), #0);
  FillChar(SI, SizeOf(SI), #0);
  with SI do 
  begin
    cb := SizeOf(SI);
    dwFlags := STARTF_USESHOWWINDOW;
    wShowWindow := SW_SHOW; //or SW_SHOWMINIZED,...
  end;
  if not CreateProcess('C:\.....\BarPrt.pif',
                       'BarPrt.exe /options',
                       nil, 
                       nil, 
                       false,
                       NORMAL_PRIORITY_CLASS,
                       nil, 
                       nil, 
                       SI, 
                       PI) then
      raise Exception.Create('Error CreateProcess');
  WaitForSingleObject(PI.dwProcessID, INFINITE);
end;

hagar前輩 : 謝謝您的回應 ! 我試了您提的方法, 不過還是不行 (程式如下). 若程式直接執行 .BAT 檔, 則執行程式未結束就 show 出 OK , 而且 : (1) 原出處有一個錯誤 : TProgressInformation 應為 TProcessInformation (2) 不知何故, 對 LNK 檔無法順利 create process .... 想用 FormatMessage 讀出 error message , 但一直試不出來, 努力中 .... procedure TForm1.Button3Click(Sender: TObject); var SI: TStartupInfo; PI:TProcessInformation; begin FillChar(PI, SizeOf(PI), #0); FillChar(SI, SizeOf(SI), #0); with SI do begin cb := SizeOf(SI); dwFlags := STARTF_USESHOWWINDOW; wShowWindow := SW_SHOW; //or SW_SHOWMINIZED,... end; if not CreateProcess('D:\TEST.LNK', // 'TEST.BAT', // TEST.BAT 方式失敗 'TEST.LNK', nil, nil, false, NORMAL_PRIORITY_CLASS, nil, nil, SI, PI) then begin raise Exception.Create('Error CreateProcess'); end else begin WaitForSingleObject(PI.dwProcessID, INFINITE); MessageDlg('OK', mtInformation, [mbOK], 0); end; end;

利用Showmessage(SysErrorMessage(GetLastError)); 可以得到Errro message     如果丟.lnk進去 會得到 "%1不是正確的Win32程式" 錯誤    試試看去抓真正要執行的exe 的Process ID 我試過可以正確等到UltraEdit結束才出現OK    

GetPIDByProgramName請參考拙作http://delphi.ktop.com.tw/topic.php?topic_id=61654
function GetPIDByProgramName(const APName: string; bWithOutPath: Boolean = True): THandle;
var
  isFound: boolean;
  AHandle, AhProcess: THandle;
  ProcessEntry32: TProcessEntry32;
  APath: array[0..MAX_PATH] of char;
begin
  try
    Result := 0;
    AHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    ProcessEntry32.dwSize := Sizeof(ProcessEntry32);
    isFound := Process32First(AHandle, ProcessEntry32);        while isFound do
    begin
      AhProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
        false, ProcessEntry32.th32ProcessID);
      GetModuleFileNameEx(AhProcess, 0, @APath[0], sizeof(APath));          if (UpperCase(StrPas(APath)) = UpperCase(APName)) or
        (UpperCase(StrPas(ProcessEntry32.szExeFile)) = UpperCase(APName)) or
        (bWithOutPath and (
        (UpperCase(ExtractFileName(StrPas(APath))) = UpperCase(ExtractFileName(APName))) or //for partial filename without path
        (UpperCase(ExtractFileName(StrPas(ProcessEntry32.szExeFile))) = UpperCase(ExtractFileName(APName)))
        )
        ) then //for partial filename without path
      begin
        Result := ProcessEntry32.th32ProcessID;
        break;
      end;
      isFound := Process32Next(AHandle, ProcessEntry32);
      CloseHandle(AhProcess);
    end;
  finally
    CloseHandle(AHandle);
  end;
end;    procedure TForm1.Button1Click(Sender: TObject);
var
  SI: TStartupInfo;
  PI: TProcessInformation;
  sFile:String;
  PID:THandle;
begin
  FillChar(PI, SizeOf(PI), #0);
  FillChar(SI, SizeOf(SI), #0);
  with SI do
  begin
    cb := SizeOf(SI);
    dwFlags := STARTF_USESHOWWINDOW;
    wShowWindow := SW_SHOW; //or SW_SHOWMINIZED,...
  end;
  if not CreateProcess(nil,
    PChar('cmd /c C:\UltraEdit-32.lnk'), //利用command shell 方式開啟
    nil,
    nil,
    false,
    NORMAL_PRIORITY_CLASS,
    nil,
    nil,
    SI,
    PI) then
  begin
    raise Exception.Create('Error CreateProcess');
    Showmessage(SysErrorMessage(GetLastError));
  end
  else
  begin
    sFile:=ResolveLink('C:\UltraEdit-32.lnk'); //我想實際上還是要去執行真正的exe 所以取得這個訊息應該有用
    sleep(1000);
    PID:=GetPIDByProgramName(sFile);
    WaitForSingleObject(PID, INFINITE);
    MessageDlg('OK', mtInformation, [mbOK], 0);
  end;
end;

發表人 - chris_shieh 於 2005/01/25 12:30:27

還是不行.....  class="code"> procedure TForm1.Button4Click(Sender: TObject); var SI: TStartupInfo; PI: TProcessInformation; sFile:String; PID:THandle; begin FillChar(PI, SizeOf(PI), #0); FillChar(SI, SizeOf(SI), #0); with SI do begin cb := SizeOf(SI); dwFlags := STARTF_USESHOWWINDOW; wShowWindow := SW_SHOW; //or SW_SHOWMINIZED,... end; if not CreateProcess( nil, // PChar('cmd /c D:\TEST.lnk'), //利用command shell 方式開啟 PChar('CMD /C D:\TEST.lnk'), nil, nil, false, NORMAL_PRIORITY_CLASS, nil, nil, SI, PI) then begin Showmessage(SysErrorMessage(GetLastError)); end else begin // sFile:=ResolveLink('C:\UltraEdit-32.lnk'); //我想實際上還是要去執行真正的exe 所以取得這個訊息應該有用 sFile:=ResolveLink('D:\TEST.lnk'); repeat sleep(1000); // PID:=GetPIDByProgramName(sFile); // 會抓不到 PID PID:=GetPIDByProgramName('CMD.EXE'); until PID = 0; // WaitForSingleObject(PID, INFINITE); // 還是不行啊 .... MessageDlg('OK', mtInformation, [mbOK], 0); end; end;

Batch file? I think you can do a lazy trick....    echo > running.dat rem your batch file del running.dat    Now you need to loop and check for FileExists....  < face='Lucida Console'>http://pywong.hk.st http://www.lazybones.ca

引言: echo > running.dat rem your batch file del running.dat Now you need to loop and check for FileExists....

Ha ! Ha ! that's what I had done before for another case ... < >< > but I don't think that's a good solution , so, this time, I want to try other solutions following 2 rules : (1) keep all control in my Delphi AP (2) simplify the batch file anyway , thanks for your response !!!

For shortcut, take a look here:    http://support.microsoft.com/kb/q243378/ I think it is similar for pif file... Can you start the bat file instead? I have no problem in wiating for the bat file... http://pywong.hk.st http://www.lazybones.ca

引言: I think it is similar for pif file... Can you start the bat file instead? I have no problem in wiating for the bat file...

Dear William : I know it works for .bat file , but the DOS AP will cause error like this (sorry , upload image file failed from our company, firewall) : 命令提示字元 - TEST.BAT NTVDM遇到一個系統錯誤 The parameter is incorrect. 請選擇[關閉]來終止應用程式. and that's why I have to try the PIF file ...

I always think running .bat file should consult the .pif in the same folder  face='Lucida Console'>http://pywong.hk.st http://www.lazybones.ca

大同小異！試試這個吧！

function ExecAndWait(const Filename, Params: string; WindowState: word): boolean;
var
  SUInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
  CmdLine: string;
begin
  CmdLine := '"'   Filename   '" '   Params;
  FillChar(SUInfo, SizeOf(SUInfo), #0);
  with SUInfo do
  begin
    lpTitle := @CmdLine;
    cb := SizeOf(SUInfo);
    dwFlags := STARTF_USESHOWWINDOW;
    wShowWindow := WindowState;
  end;
  Result := CreateProcess(NIL, PChar(CmdLine), NIL, NIL, FALSE,
     CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, NIL,
     PChar(ExtractFilePath(Filename)), SUInfo, ProcInfo);
  if Result then
  begin
     WaitForSingleObject(ProcInfo.hProcess, INFINITE);
     CloseHandle(ProcInfo.hProcess);
     CloseHandle(ProcInfo.hThread);
  end;
end;    procedure TForm1.Button1Click(Sender: TObject);
var
  FileName : String;
  sParameter : String;
begin
  FileName := 'E:\san3\Play.BAT';
  sParameter := '';
  ExecAndWait(FileName,'',SW_SHOW);
  MessageDlg('OK', mtInformation, [mbOK], 0);
end;

已成功呼叫三國誌 3 DOS 遊戲(KOEI)，在Windows XP 環境。 {設置 PIF 開啟EMS/XMS 結束時關閉 等} 不成功不要怪我啊！～ w_w 發表人 - wameng 於 2005/01/27 00:58:35