Pagina historie

type
  TArg<T> = reference to procedure(const Arg: T);
.
.
.
procedure  TMainFrm.CaptureConsoleOutput(const ACommand: String; CallBack: TArg<PAnsiChar>);
const
   CReadBuffer READ_BUFFER_SIZE = 4096002400;
var
  saSecurity  Security: TSecurityAttributes;
    piEncoder: TProcessInformation;
    hReadreadableEndOfPipe, writeableEndOfPipe: THandle;
    hWritestart: THandleTStartUpInfo;
  suiStartup  Buffer: TStartupInfoPAnsiChar;
   piProcess BytesRead: TProcessInformationDWORD;
   pBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dRead: DWORD;
  dRunning: DWORD;
  dAvailable: DWORD;
begin
  saSecurity AppRunning: DWORD;

    tmpSL:TStringList;
    tmpS:string;
begin
    tmpS := GetEnvironmentVariable('TEMP') + '\' + 'CKJUNPA.BAT';
    tmpSL := TStringList.Create;
    tmpSL.Add(ACommand);

    // tmpSL.SaveToFile(tmpS, TEncoding.UTF8); - bat file seems correct, but does not work
    // tmpSL.SaveToFile(tmpS, TEncoding.ANSI); - multibyte character is incorrectly written on batch file
    tmpSL.SaveToFile(tmpS, TEncoding.ANSI);

    Security.nLength := SizeOf(TSecurityAttributes);
    saSecuritySecurity.bInheritHandle := trueTrue;
    saSecuritySecurity.lpSecurityDescriptor := nil;

    if CreatePipe(hRead{var}readableEndOfPipe, hWrite{var}writeableEndOfPipe, @saSecurity@Security, 0) then
    begin
     try
   Buffer := AllocMem(READ_BUFFER_SIZE+1);
        FillChar(suiStartupStart, SizeOfSizeof(TStartupInfoStart), #0);
       suiStartup start.cb := SizeOf(TStartupInfo)(start);

        // Set up members of the STARTUPINFO structure.
        // This structure specifies the STDIN and STDOUT handles for redirection.
        // - Redirect the output and error to the writeable end of our pipe.
        // - We must still supply a valid StdInput handle (because we used STARTF_USESTDHANDLES to swear that all three handles will be valid)
        start.dwFlags := start.dwFlags or STARTF_USESTDHANDLES;
      suiStartup  start.hStdInput := hRead; GetStdHandle(STD_INPUT_HANDLE); //we're not redirecting stdInput; but we still have to give it a valid handle
      suiStartup  start.hStdOutput := hWrite; writeableEndOfPipe; //we give the writeable end of the pipe to the child process; we read from the readable end
      suiStartup  start.hStdError := hWrite;writeableEndOfPipe;

        //We can also choose to say that the wShowWindow member contains a value.
      suiStartup  //In our case we want to force the console window to be hidden.
        start.dwFlags := STARTF_USESTDHANDLES orstart.dwFlags + STARTF_USESHOWWINDOW;
      suiStartup  start.wShowWindow := SW_HIDE;

        // Don't forget to set up members of the PROCESS_INFORMATION structure.
        piEncoder := Default(TProcessInformation);

        //WARNING: The unicode version of CreateProcess (CreateProcessW) can modify the command-line "DosApp" string.
        //Therefore "DosApp" cannot be a pointer to read-only memory, or an ACCESS_VIOLATION will occur.
        //We can ensure it's not read-only with the RTL function: UniqueString

        if CreateProcess(nil, PChar(ACommandtmpS), @saSecuritynil, @saSecuritynil, trueTrue, NORMAL_PRIORITY_CLASS, nil, nil, start, suiStartup,
        piProcess) then
        try
 {var}piEncoder) then
        begin
            //Wait for the application to terminate, as it writes it's output to the pipe.
            //WARNING: If the console app outputs more than 2400 bytes (ReadBuffer),
            //it will block on writing to the pipe and *never* close.
            repeat
               dRunning Apprunning := WaitForSingleObject(piProcesspiEncoder.hProcess, 100);
                Application.ProcessMessages;

              PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);  //Read the contents of the pipe out of the readable end
                //WARNING: if (dAvailable > 0) then
 the console app never writes anything to the StdOutput, then ReadFile will block and never return

                repeat
                  dReadBytesRead := 0;
                  ReadFile(hReadreadableEndOfPipe, pBufferBuffer[0], CReadBufferREAD_BUFFER_SIZE, dRead{var}BytesRead, nil);

                  if BytesRead>0 then
                    pBuffer[dRead] begin

                    Buffer[BytesRead]:= #0;
                OemToCharA(pBuffer, dBuffer);
    OemToAnsi(Buffer,Buffer);

                    // added for debugging -----------------------------------------
                    KDEBUG( string(Buffer));
                    // end of debugging --------------------------------------------
                    CallBack(dBufferBuffer);
              until  (dRead < CReadBuffer)end;

                Application.ProcessMessagesuntil BytesRead<READ_BUFFER_SIZE;

            until (dRunningApprunning <> WAIT_TIMEOUT);
        finallyend;
        FreeMem(Buffer);
        CloseHandle(piProcesspiEncoder.hProcess);
          CloseHandle(piProcesspiEncoder.hThread);
        endCloseHandle(readableEndOfPipe);
    finally
      CloseHandle(hReadwriteableEndOfPipe);
      CloseHandle(hWrite)end;
    endtmpSL.Destroy;
end;