Page History

send it in

real time to callback function, so the application can handle it such as displaying its progress by adding to memo, so end user may not think the application is hanging while program performing the command.

type
  TArg<T> = reference to procedure(const Arg: T);
.
.
.
procedure TMainFrm.CaptureConsoleOutput(const ACommand: String; CallBack: TArg<PAnsiChar>);
const
   CReadBuffer READ_BUFFER_SIZE = 2400;
var
  saSecurity  Security: TSecurityAttributes;
    piEncoder: TProcessInformation;
    readableEndOfPipe, hReadwriteableEndOfPipe: THandle;
  hWrite  start: THandleTStartUpInfo;
  suiStartup  Buffer: TStartupInfoPAnsiChar;
   piProcess BytesRead: TProcessInformationDWORD;
    pBufferAppRunning: array [0 .. CReadBuffer] of AnsiChar;
  dBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dRead: DWORD;
  dRunning: DWORD;
  dAvailable: DWORD;
begin
  saSecurityDWORD;

    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);
   saSecurity Security.bInheritHandle := trueTrue;
    saSecuritySecurity.lpSecurityDescriptor := nil;

    if CreatePipe(hRead{var}readableEndOfPipe, hWrite{var}writeableEndOfPipe, @saSecurity@Security, 0) then
      try
begin
        Buffer := AllocMem(READ_BUFFER_SIZE+1);
        FillChar(suiStartupStart, SizeOfSizeof(TStartupInfoStart), #0);
        suiStartupstart.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
        suiStartupstart.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.
        //In our case we want to force the console window to be hidden.
       suiStartup 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, suiStartup,
        piProcess) then
        try start, {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;

                //Read the contents of the PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);
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
                dRead  BytesRead := 0;
                  ReadFile(hReadreadableEndOfPipe, pBufferBuffer[0], CReadBufferREAD_BUFFER_SIZE, dRead{var}BytesRead, nil);

                  if BytesRead>0 then
                  begin

                    pBufferBuffer[dReadBytesRead] := #0;
                  OemToCharA  OemToAnsi(pBuffer, dBuffer);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);
        finally
  end;
        FreeMem(Buffer);
        CloseHandle(piProcesspiEncoder.hProcess);
        CloseHandle(piEncoder.hThread);
        CloseHandle(readableEndOfPipe);
        CloseHandle(piProcess.hThread);
        end;
    finally
      CloseHandle(hRead);
      CloseHandle(hWritewriteableEndOfPipe);
    end;
    tmpSL.Destroy;
end;