如果我在執行 DOS 程式時使用了導向符號 '>' 將執行結果輸出到檔案, 請問要如何即時得到執行中的文字輸出, 因為程式會跑蠻久的,而這個 DOS 程式的輸出會顯示進度的百分比, 想要藉此讀取再做出一個視窗的 ProgressBar 看進度. 執行的方式我有找到使用 WinExecAndWait http://delphi.ktop.com.tw/topic.php?topic_id=66761 請指教,謝謝.

希望可以達到兩個目標, 1.判斷程式是否執行完成 2.可以即時讀取程式導向至檔案的輸出    實際使用的函式如下, 謝謝.    

function WinExecAndWait(FileName: string; Visibility: integer): integer;
var
  zAppName: array[0..512] of char;
  zCurDir: array[0..255] of char;
  WorkDir: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  ReadPipe, WritePipe: THandle;
begin
  StrPCopy(zAppName, FileName);
  GetDir(0, WorkDir);
  StrPCopy(zCurDir, WorkDir);
  FillChar(StartupInfo, Sizeof(StartupInfo), #0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.hStdOutput := WritePipe;
  StartupInfo.hStdInput := ReadPipe;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if CreateProcess(nil,
    zAppName, { pointer to command line string }
    nil, { pointer to process security attributes }
    nil, { pointer to thread security attributes }
    false, { handle inheritance flag }
    CREATE_NEW_CONSOLE or { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil, { pointer to new environment block }
    nil, { pointer to current directory name }
    StartupInfo, { pointer to STARTUPINFO }
    ProcessInfo) then
  begin
    WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
    Result := 0;
  end
  else
    Result := -1; { pointer to PROCESS_INF }
end;

我這邊是有可以在執行結束時將結果mOutputs到螢幕或檔案中。     

function WinExecAndWait32(AppExeName,FileName:String;Visibility:Integer;var mOutputs:string):Cardinal;
var
  sa:TSecurityAttributes;
  hReadPipe,hWritePipe:THandle;
  ret:BOOL;
  strBuff:array[0..255] of char;
  lngBytesread:DWORD;
  
  WorkDir:String;
  StartupInfo:TStartupInfo;
  ProcessInfo:TProcessInformation;
begin
  FillChar(sa,Sizeof(sa),#0);
  sa.nLength := Sizeof(sa);
  sa.bInheritHandle := True;
  sa.lpSecurityDescriptor := nil;
  ret := CreatePipe(hReadPipe, hWritePipe, @sa, 0);      WorkDir:=ExtractFileDir(AppExeName);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb:=Sizeof(StartupInfo);
  StartupInfo.dwFlags:=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  StartupInfo.wShowWindow:=Visibility;      StartupInfo.hStdOutput:=hWritePipe;
  StartupInfo.hStdError:=hWritePipe;      if not CreateProcess(nil,
    PChar(FileName),               { pointer to command line string }
    @sa,                           { pointer to process security attributes }
    @sa,                           { pointer to thread security attributes }
    True,                          { handle inheritance flag }
//    CREATE_NEW_CONSOLE or          { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,                           { pointer to new environment block }
    PChar(WorkDir),                { pointer to current directory name, PChar}
    StartupInfo,                   { pointer to STARTUPINFO }
    ProcessInfo)                   { pointer to PROCESS_INF }
    then Result := INFINITE {-1} else
  begin
//    Form1.Hide;
//    FileOpen(FileName,fmShareExclusive);
//    SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
    ret:=CloseHandle(hWritePipe);
    mOutputs:='';
    while ret do
    begin
      FillChar(strBuff,Sizeof(strBuff),#0);
      ret := ReadFile(hReadPipe, strBuff, 256, lngBytesread, nil);
      mOutputs := mOutputs   strBuff;
    end;        //Application.ProcessMessages;
    WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle(ProcessInfo.hProcess);  { to prevent memory leaks }
    CloseHandle(ProcessInfo.hThread);
//    Form1.Close;                        { exit application }
    ret := CloseHandle(hReadPipe);
  end;
end;

然後再將moutput內容#10後面插入#13即可斷行。 星期一,星期二...星期日..星期一..無窮迴圈@@

------
星期一,二...無窮迴圈＠＠

zombit 您好：    有個由 DevPHP 學來的方法，提供參考與修改。    我改寫成能逐行輸出資料，程式中要加入三個元件：ListBox, Memo, Button.    

////
// following codes are borrowed from the source codes of DevPHP.
function getDOSOutput(Cmd, WorkDir: String): string;
var
  tsi: TStartupInfo;
  tpi: TProcessInformation;
  nRead: DWORD;
  aBuf: Array[0..101] of char;
  sa: TSecurityAttributes;
  hOutputReadTmp, hOutputRead, hOutputWrite, hInputWriteTmp, hInputRead,
  hInputWrite, hErrorWrite: THandle;
  FOutput : String;
  /// added by Rich
  perLine : String;
  len     : integer;
  /// =====
begin
  FOutput := '';
  perLine := '';      sa.nLength              := SizeOf(TSecurityAttributes);
  sa.lpSecurityDescriptor := nil;
  sa.bInheritHandle       := True;      CreatePipe(hOutputReadTmp, hOutputWrite, @sa, 0);
  DuplicateHandle(GetCurrentProcess(), hOutputWrite, GetCurrentProcess(),
    @hErrorWrite, 0, true, DUPLICATE_SAME_ACCESS);
  CreatePipe(hInputRead, hInputWriteTmp, @sa, 0);      DuplicateHandle(GetCurrentProcess(), hOutputReadTmp,  GetCurrentProcess(),
    @hOutputRead,  0, false, DUPLICATE_SAME_ACCESS);
  DuplicateHandle(GetCurrentProcess(), hInputWriteTmp, GetCurrentProcess(),
    @hInputWrite, 0, false, DUPLICATE_SAME_ACCESS);
  CloseHandle(hOutputReadTmp);
  CloseHandle(hInputWriteTmp);      FillChar(tsi, SizeOf(TStartupInfo), 0);
  tsi.cb         := SizeOf(TStartupInfo);
  tsi.dwFlags    := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  tsi.hStdInput  := hInputRead;
  tsi.hStdOutput := hOutputWrite;
  tsi.hStdError  := hErrorWrite;      CreateProcess(nil, PChar(Cmd), @sa, @sa, true, 0, nil, PChar(WorkDir),
    tsi, tpi);
  CloseHandle(hOutputWrite);
  CloseHandle(hInputRead );
  CloseHandle(hErrorWrite);
  Application.ProcessMessages;      repeat
     if (not ReadFile(hOutputRead, aBuf, 16, nRead, nil)) or (nRead = 0) then
     begin
        if GetLastError = ERROR_BROKEN_PIPE then Break
        else MessageDlg('Pipe read error, could not execute file', mtError, [mbOK], 0);
     end;
     aBuf[nRead] := #0;
     FOutput := FOutput   PChar(@aBuf[0]);
     ///// 我增加的部分
 perLine := perLine   PChar(@aBuf[0]);
 len := Pos(chr(10),perLine);
 if ( len>0  ) then
   begin
     Form1.ListBox1.Items.Add(Copy(perLine,1,len-1)); // added by Rich.
     perLine := Copy(perLine, len 1, Length(perLine)-len);
   end;         /////
     Application.ProcessMessages;
  until False;      Result := FOutput;
end;    procedure TForm1.Button1Click(Sender: TObject);
var
   WorkDir : string;
begin
  ListBox1.Items.Clear;
  WorkDir := '.';
  Memo1.Text := getDOSOutput('ping www.google.com.tw', WorkDir);  // OK!
end;

RichTop 敬上 =====***** 把數學當工具，可以解決問題；將數學變能力，能夠發現並解決問題！ =====#####

謝謝 pgdennis, richtop 兄, 你們的程式我先研究一下, 再次感謝.