пятница, 31 августа 2012 г.

Вызов консольного приложения из программы на Delphi

Для вызова внешнего приложения из программы на Delphi обычно используется функция WinAPI CreateProcess. Но как получить то, что это приложение выводит в консоль, и, например, отобразить в логе программы?  Варианта два. Первый: пере-направить вывод консольного приложения в файл и потом прочитать этот файл. Однако, создавать временный файл не охота. А кроме того, такой способ не всегда хорошо работает. Есть другой способ - использовать пайпы (pipes). Ниже приведен код процедуры RunDosCommand на Delphi, который использует этот способ. Весь вывод на консоль записывается в AMemo: TMemo.

function RunDosCommand(ACmdString: String; AMemo: TMemo;
  AReadPipe, AWritePipe:  THandle): Boolean;
const
  ReadBuffer = 4200;
var
  Security : TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start : TStartUpInfo;
  ProcessInfo : TProcessInformation;
  Buffer : Pchar;
  BytesRead : DWord;
begin
  Result := False;
  if AMemo <> nil then
  begin
    AMemo.SelStart := Length(AMemo.Text);
    AMemo.SelText := ACmdString + #13#10;
    AMemo.SelStart := Length(AMemo.Text);
    Application.ProcessMessages;
  end;
  ReadPipe := AReadPipe;
  WritePipe := AWritePipe;
  with Security do
  begin
    nLength := SizeOf(TSecurityAttributes);
    bInheritHandle := true;
    lpSecurityDescriptor := nil;
  end;
  if (ReadPipe = 0) and (WritePipe = 0) then
  begin
    if not CreatePipe(ReadPipe, WritePipe, @Security, 0) then
    begin
      ReadPipe := 0;
      WritePipe := 0;
    end;
  end;
  if (ReadPipe <> 0) or (WritePipe <> 0) then
  begin
    if AMemo <> nil then
    begin
      Buffer := AllocMem(ReadBuffer + 1);
    end;
    FillChar(Start, Sizeof(Start), #0);
    start.cb := SizeOf(start) ;
    start.hStdOutput := WritePipe;
    start.hStdError := WritePipe;
    start.hStdInput := ReadPipe;
    start.dwFlags := STARTF_USESTDHANDLES +
                     STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;
    if CreateProcess(nil,
           PChar(ACmdString),
           @Security,
           @Security,
           true,
           NORMAL_PRIORITY_CLASS,
           nil,
           nil,
           start,
           ProcessInfo) then
    begin
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      if AMemo <> nil then
      begin
        BytesRead := 0;
        ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        AMemo.SelStart := Length(AMemo.Text);
        AMemo.SelText := String(Buffer);
        AMemo.SelStart := Length(AMemo.Text);
        Application.ProcessMessages;
      end;
      Result := True;
    end else
    if AMemo <> nil then
    begin
      AMemo.SelStart := Length(AMemo.Text);
      AMemo.SelText :='Command failed.'#13#10;
      AMemo.SelStart := Length(AMemo.Text);
      Application.ProcessMessages;
    end;
    if AMemo <> nil then
    begin
      FreeMem(Buffer);
    end;
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    if (AReadPipe = 0) and (AWritePipe = 0) then
    begin
      CloseHandle(ReadPipe);
      CloseHandle(WritePipe);
    end;
  end;
end;

===
Перепечатка материалов блога разрешается с обязательной ссылкой на blog.coolsoftware.ru

Комментариев нет:

Отправить комментарий