redirect console process ?

Hello,

here is a function that call a process
and redirects it's input/output to files.
I would like the output (stdout and or stderr)
to be put in something that would be
usable like a string list or similar
without passing trought a file.

Thank you very much for your help.

Regards : JON.

-----------------------
function CreateDOSProcessRedirected(const CommandLine,InputFile,OutputFile,
                                    ErrMsg :string):boolean;
const
  ROUTINE_ID = '[function: CreateDOSProcessRedirected ]';
var
  OldCursor     : TCursor;
  pCommandLine  : array[0..MAX_PATH] of char;
  pInputFile,
  pOutPutFile   : array[0..MAX_PATH] of char;
  StartupInfo   : TStartupInfo;
  ProcessInfo   : TProcessInformation;
  SecAtrrs      : TSecurityAttributes;
  hAppProcess,
  hAppThread,
  hInputFile,
  hOutputFile   : THandle;
begin
  Result := False;
  if not FileExists(InputFile) then
    raise Exception.CreateFmt(ROUTINE_ID+#10+#10+'Input file * %s *'+#10+
                              'does not exist'+#10+#10+ErrMsg,[InputFile]);
  OldCursor     := Screen.Cursor;
  Screen.Cursor := crHourglass;
  StrPCopy(pCommandLine, CommandLine);
  StrPCopy(pInputFile, InputFile);
  StrPCopy(pOutPutFile, OutputFile);
  try
    FillChar(SecAtrrs, SizeOf(SecAtrrs), #0);
    SecAtrrs.nLength              := SizeOf(SecAtrrs);
    SecAtrrs.lpSecurityDescriptor := nil;
    SecAtrrs.bInheritHandle       := True;
    hInputFile := CreateFile(pInputFile,GENERIC_READ or GENERIC_WRITE,
                             FILE_SHARE_READ or FILE_SHARE_WRITE,@SecAtrrs,
                             OPEN_ALWAYS,FILE_ATTRIBUTE_NORMAL
                             or FILE_FLAG_WRITE_THROUGH,0);
    if hInputFile = INVALID_HANDLE_VALUE then
      raise Exception.CreateFmt(ROUTINE_ID+#10+#10+
                                'WinApi function CreateFile returned an' +
                                'invalid handle value'  + #10 +
                                'for the input file * %s *' + #10 + #10 +
                                ErrMsg, [InputFile]);
    hOutputFile := CreateFile(pOutPutFile,GENERIC_READ or GENERIC_WRITE,
                              FILE_SHARE_READ or FILE_SHARE_WRITE,@SecAtrrs,
                              CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL
                              or FILE_FLAG_WRITE_THROUGH,0);
    if hOutputFile = INVALID_HANDLE_VALUE then
      raise Exception.CreateFmt(ROUTINE_ID+#10+#10+
                                'WinApi function CreateFile returned an' +
                                'invalid handle value'  + #10 +
                                'for the output file * %s *' + #10 + #10 +
                                ErrMsg, [OutputFile]);
    FillChar(StartupInfo, SizeOf(StartupInfo), #0);
    StartupInfo.cb          := SizeOf(StartupInfo);
    StartupInfo.dwFlags     := STARTF_USESHOWWINDOW or
                               STARTF_USESTDHANDLES;
    StartupInfo.wShowWindow := SW_HIDE;
    StartupInfo.hStdOutput  := hOutputFile;
    StartupInfo.hStdInput   := hInputFile;
    Result := CreateProcess(nil,pCommandLine,nil,nil,True,HIGH_PRIORITY_CLASS,
                            nil,nil,StartupInfo,ProcessInfo);
    if Result then
    begin
      WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
      hAppProcess  := ProcessInfo.hProcess;
      hAppThread   := ProcessInfo.hThread;
    end
    else
      raise Exception.Create(ROUTINE_ID+#10+#10+
                             'Function failure'+#10+#10+ErrMsg);
  finally
    if hOutputFile <> 0 then CloseHandle(hOutputFile);
    if hInputFile <> 0 then CloseHandle(hInputFile);
    if hAppThread <> 0 then CloseHandle(hAppThread);
    if hAppProcess <> 0 then CloseHandle(hAppProcess);
    Screen.Cursor:= OldCursor;
  end;
end;    { CreateDOSProcessRedirected }

LVL 4
jeurkAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

intheCommented:
hi,
i have 2 examples the first being wrote by philleiphs <sp?>


Add a TButton and two TMemos to a form, then paste in the code below. You might need to change to path of the exe!

BTW, if you want to pass arguments to the exe, then change this:
    Res := CreateProcess(
        PChar(ExeName),
        nil,
to
    Res := CreateProcess(
        PChar(ExeName),
        PChar(' ' + Args),
The space before Args *is* significant.

Cheers,
Phil.


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure ExecConsoleApp(ExeName: string; Output: TStringList; Errors: TStringList);
  var sa: TSECURITYATTRIBUTES;
      si: TSTARTUPINFO;
      pi: TPROCESSINFORMATION;
      hPipeOutputRead: THANDLE;
      hPipeOutputWrite: THANDLE;
      hPipeErrorsRead: THANDLE;
      hPipeErrorsWrite: THANDLE;

      Res: Boolean;
      env: array [0..100] of Char;

      bTest: Boolean;
      dwNumberOfBytesRead: DWORD;
      szBuffer: array [0..256] of Char;
      Stream: TMemoryStream;
  begin
    sa.nLength := sizeof(sa);
    sa.bInheritHandle := true;
    sa.lpSecurityDescriptor := nil;

    CreatePipe(hPipeOutputRead,
               hPipeOutputWrite,
               @sa,
               0);
    CreatePipe(hPipeErrorsRead,
               hPipeErrorsWrite,
               @sa,
               0);

    ZeroMemory(@env, SizeOf(env));
    ZeroMemory(@si, SizeOf(si));
    ZeroMemory(@pi, SizeOf(pi));
    si.cb := SizeOf(si);
    si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    si.wShowWindow := SW_HIDE;
    si.hStdInput   := 0;
    si.hStdOutput  := hPipeOutputWrite;
    si.hStdError   := hPipeErrorsWrite;

    Res := CreateProcess(
        PChar(ExeName),
        nil,
        nil,
        nil,
        true,
        CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
        @env,
        nil,
        si,
        pi);
    if not Res then
      begin
        CloseHandle (hPipeOutputRead);
        CloseHandle(hPipeOutputWrite);
        CloseHandle (hPipeErrorsRead);
        CloseHandle(hPipeErrorsWrite);
        raise Exception.Create('Unable to execute ' + ExeName);
        exit;
      end;

    CloseHandle(hPipeOutputWrite);
    CloseHandle(hPipeErrorsWrite);

    //Read output pipe
    Stream := TMemoryStream.Create;
    try
      while true do
        begin
          bTest:=ReadFile(
                hPipeOutputRead,
                szBuffer,
                256,
                dwNumberOfBytesRead,
                nil);
          if not bTest then
            begin
              break;
            end;
          Stream.Write(szBuffer, dwNumberOfBytesRead);
        end;
      Stream.Position := 0;
      Output.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;

    //Read error pipe
    Stream := TMemoryStream.Create;
    try
      while true do
        begin
          bTest:=ReadFile(
                hPipeErrorsRead,
                szBuffer,
                256,
                dwNumberOfBytesRead,
                nil);
          if not bTest then
            begin
              break;
            end;
          Stream.Write(szBuffer, dwNumberOfBytesRead);
        end;
      Stream.Position := 0;
      Errors.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;

    WaitForSingleObject (pi.hProcess, INFINITE);
    CloseHandle (pi.hProcess);
    CloseHandle (hPipeOutputRead);
    CloseHandle (hPipeErrorsRead);
  end;

procedure TForm1.Button1Click(Sender: TObject);
  var o, e: TStringList;
begin
  o := TStringList.Create;
  e := TStringList.Create;
  ExecConsoleApp('c:\program files\borland\delphi4\bin\convert.exe', o, e);
  Memo1.Lines.Assign(o);
  Memo2.Lines.Assign(e);
  o.Free;
  e.Free;
end;

end.



or another way:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
procedure RunDosInMemo(Que:String;EnMemo:TMemo);
   const
      CUANTOBUFFER = 2000;
   var
     Seguridades         : TSecurityAttributes;
     PaLeer,PaEscribir   : THandle;
     start               : TStartUpInfo;
     ProcessInfo         : TProcessInformation;
     Buffer              : Pchar;
     BytesRead           : DWord;
     CuandoSale          : DWord;
   begin
     With Seguridades do
     begin
       nlength              := SizeOf(TSecurityAttributes);
       binherithandle       := true;
       lpsecuritydescriptor := nil;
     end;
     {Creamos el pipe...}
     if Createpipe (PaLeer, PaEscribir, @Seguridades, 0) then
     begin
       Buffer  := AllocMem(CUANTOBUFFER + 1);
       FillChar(Start,Sizeof(Start),#0);
       start.cb          := SizeOf(start);
       start.hStdOutput  := PaEscribir;
       start.hStdInput   := PaLeer;
       start.dwFlags     := STARTF_USESTDHANDLES +
                            STARTF_USESHOWWINDOW;
       start.wShowWindow := SW_HIDE;

       if CreateProcess(nil,
          PChar(Que),
          @Seguridades,
          @Seguridades,
          true,
          NORMAL_PRIORITY_CLASS,
          nil,
          nil,
          start,
          ProcessInfo)
       then
         begin
           {Espera a que termine la ejecucion}
           repeat
             CuandoSale := WaitForSingleObject( ProcessInfo.hProcess,100);
             Application.ProcessMessages;
           until (CuandoSale <> WAIT_TIMEOUT);
           {Leemos la Pipe}
           Repeat
             BytesRead := 0;
             {Llenamos un troncho de la pipe, igual a nuestro buffer}
             ReadFile(PaLeer,Buffer[0],CUANTOBUFFER,BytesRead,nil);
             {La convertimos en una string terminada en cero}
             Buffer[BytesRead]:= #0;
             {Convertimos caracteres DOS a ANSI}
             OemToAnsi(Buffer,Buffer);
             EnMemo.Text := EnMemo.text + String(Buffer);
           until (BytesRead < CUANTOBUFFER);
         end;
       FreeMem(Buffer);
       CloseHandle(ProcessInfo.hProcess);
       CloseHandle(ProcessInfo.hThread);
       CloseHandle(PaLeer);
       CloseHandle(PaEscribir);
     end;
   end;

 begin
   RunDosInMemo('chkdsk.exe c:\',Memo1);
 end;


end.


hope of some assistance
Regards Barry
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
jeurkAuthor Commented:
:)

I'll try that...
Thanks
0
jeurkAuthor Commented:
hi,
the first command says 'Cannot initialize for RFC.' to the stderr

the second is working strangely.

can you help with the first message ?

thanks
0
Build an E-Commerce Site with Angular 5

Learn how to build an E-Commerce site with Angular 5, a JavaScript framework used by developers to build web, desktop, and mobile applications.

intheCommented:
Hi Jon
sorry i cant help much ,the first method i cant make work properly with command line (like sending command line with a break in it,ive never used it for more than testing)
but i am only trying on tdump.exe
and the second method is also enough for my needs so i've never dig any deeper.
do you know what is "RFC" ?
what is the program your executing?
could it be anything to do with this program? i mean (does it work on any program with you or does it error on all them?)
cheers Barry

btw.
maybe best idea is delete this question and re-ask so it appears on top of question list again and maybe someone who know more details about this stuff may see it and able to offer better help.
Regards Barry
0
jeurkAuthor Commented:
Hello barry.

It's ok for now. I think the problem
does not come from your stuff.
Your stuff is ok. You'll get
the poinst in a couple of days.

To make the first work put the command line
as the second param and set the first
to nil.

My RFC problem comes from the fact that
my program is searching to connect to
a port and it's not possible like that
it seems that the process has no right
to access to the ports, but that is
another question...

Thanks again and CU in another thread.
-John.
0
intheCommented:
with reference to
"To make the first work put the command line as the second param and set the first
to nil. "

 Thanks :-)
0
jeurkAuthor Commented:
No problem. You're welcome.
And we are here to learn and to help each other.
0
jeurkAuthor Commented:
thanks again.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.