08 Nisan 2005

PeekNamedPipe

function RunConsolApp(const cmd: string): string;
var
  StartupInfo: TStartupInfo;
  ProcessInformation: TProcessInformation;
  SecurityAttributes: TSecurityAttributes;
  hReadPipe, hWritePipe,hReadError,hWriteError: THandle;
  Buffer,ErrorBuffer: array [1..4096] of char;
  dwRead,dwReadError: integer;
  dwExitCode:dword;
  dwBytesAvail,dwBytesRead,dwBytesReadError:cardinal;

begin
  fillchar(SecurityAttributes, SizeOf(TSecurityAttributes), 0);
  SecurityAttributes.nLength := sizeof(TSecurityAttributes);
  SecurityAttributes.lpSecurityDescriptor := nil;
  SecurityAttributes.bInheritHandle := true;
  if CreatePipe(hReadPipe, hWritePipe, @SecurityAttributes,0) then
  begin
    CreatePipe(hReadError, hWriteError, @SecurityAttributes,0);
    fillchar(StartupInfo, SizeOf(TStartupInfo), 0);
    StartupInfo.cb := sizeof(TStartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    StartupInfo.wShowWindow := SW_HIDE;
    StartupInfo.hStdOutput := hWritePipe;
    StartupInfo.hStdError:=hWriteError;
    Result:='';
    if CreateProcess(nil,pChar(cmd),nil,nil,true,NORMAL_PRIORITY_CLASS,
    nil,nil,StartupInfo,ProcessInformation) then
    begin
      repeat
        repeat
          if PeekNamedPipe(hReadPipe,nil,0,nil,@dwBytesRead,nil) then
          if dwBytesRead>0 then
          begin
            if ReadFile(hReadPipe,Buffer,sizeof(buffer),
                        dwBytesRead,NIL) then
            begin
              result:=Result+Copy(buffer,0,dwBytesRead);
              Application.ProcessMessages;
             end;
           end;
         until dwBytesRead=0;

         repeat
          if PeekNamedPipe(hReadError,nil,0,nil,@dwBytesRead,nil) then
          if dwBytesRead>0 then
          begin
            if ReadFile(hReadError,Buffer,sizeof(buffer),
                        dwBytesRead,NIL) then
            begin
              result:=Result+Copy(buffer,0,dwBytesRead);

              Application.ProcessMessages;
             end;
           end;
         until dwBytesRead=0;
        WaitForSingleObject(ProcessInformation.hProcess,0);
        GetExitCodeProcess(ProcessInformation.hProcess,dwExitCode);
      until dwexitcode<>still_active;

      CloseHandle(hReadPipe);
      CloseHandle(hReadError);
      CloseHandle(ProcessInformation.hProcess);
    end;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
memo1.Text := RunConsolApp(Edit1.Text);
end;
Yorum Gönder