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;
    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
  saSecurityAppRunning: 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);
  saSecurity  Security.bInheritHandle := trueTrue;
   saSecurity Security.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);
       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;
        suiStartupstart.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
        suiStartupstart.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.
        suiStartupstart.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
                if (dAvailable > 0) then
//WARNING: if 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

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

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

               Application.ProcessMessages until 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
writeableEndOfPipe);
    end;
    tmpSL.Destroy;
end;