Solved

problems trying to compile a unit to redirect i/o in delphi 7

Posted on 2007-04-10
2
504 Views
Last Modified: 2008-03-17
Hi guys,

I have this code of console i/o redirection. I am trying to compile it using delphi 7, but I get this error:

   Types of actual and formal var parameters must be identicals

The guilty line is here:  hRT := CreateRemoteThread(hProc, nil, 0, pExitProcess, nil, 0, iTI);

I checked against the SDK Help in Delphi 7 and I can't find the error. I didn't write the code, I just need to redirect the stdin and stdout to communicate a console application and a GUI one. It seems to me all the parameters look correct. Any help around?

best regards,
Lopem (Manuel Lopez)


Here is the complete unit.

unit RedCon;

(*
simple yet working console i/o redirection
(c) 2002-2004 bhoc@pentagroup.ch
freeware

there are two Data events (OnStdOut and OnStdErr) that return a string;
two other events just signal that the program is running or that it has ended.
the SendData() method will submit a string to an open application such as cmd.exe.

sample:

procedure TForm1.Button1Click(Sender: TObject);
begin
  fCon := TRedirectedConsole.Create(Edit1.Text);
  fCon.OnStdOut := OnConStdOut;
  fCon.OnStdErr := OnConStdErr;
  fCon.OnRun := OnConRun;
  fCon.OnEnd := OnConEnd;
  fCon.Run;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fCon.Free;
end;

procedure TForm1.OnConStdOut(Sender: TObject; s: String);
begin
  memo1.Lines.Append(s);
end;

procedure TForm1.OnConStdErr(Sender: TObject; s: String);
begin
  memo2.Lines.Append(s);
end;

procedure TForm1.OnConRun(Sender: TOBject);
begin
  Application.ProcessMessages;
  Sleep(10);
end;

procedure TForm1.OnConEnd(Sender: TOBject);
begin
  MessageBox(Application.Handle, 'Program has ended', 'Program Ended', MB_OK or MB_ICONINFORMATION or MB_SETFOREGROUND);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  fCon.SendData(edit2.Text + #13#10);
end;

*)

interface

uses windows;

type
  TOnData = procedure(Sender: TObject; Data: String) of object;
  TOnRun = procedure(Sender: TObject) of object;
  TRedirectedConsole = Class(TObject)
  private
    fExitTimeOut: Integer;
    fStdInRead, fStdInWrite: THandle;
    fStdOutRead, fStdOutWrite: THandle;
    fStdErrRead, fStdErrWrite: THandle;
    fSA: TSecurityAttributes;
    fPI: TProcessInformation;
    fSI: TStartupInfo;
    fDestroying: Boolean;
    fCmdLine: String;
    fOnStdOut, fOnStdErr: TOnData;
    fOnRun, fOnEnd: TOnRun;
    fIsRunning: Boolean;
    fHidden: boolean;
    fMerge: boolean;
    fStdOut, fStdErr: String;
    function ReadHandle(h: THandle; var s: string): integer;
    Procedure EndProcess(hProc: THandle);
  protected
  public
    constructor Create(CommandLine: String);
    destructor Destroy; override;
    procedure Run;
    procedure Stop;
    procedure SendData(s: String);
    property ExitTimeOut: integer read fExitTimeout write fExitTimeout;
    property OnStdOut: TOnData read fOnStdOut write fOnStdOut;
    property OnStdErr: TOnData read fOnStdErr write fOnStdErr;
    property OnRun: TOnRun read fOnRun write fOnRun;
    property OnEnd: TOnRun read fOnEnd write fOnEnd;
    property MergeOutput: boolean read fMerge write fMerge;
    property IsRunning: boolean read fIsRunning;
    property HideWindow: boolean read fHidden write fHidden;
    property StdOut: string read fStdOut;
    property StdErr: string read fStdErr;
  end;

implementation

const BufSize = 1024;

constructor TRedirectedConsole.Create(CommandLine: String);
begin
  inherited Create;
  fCmdLine := CommandLine;
  fExitTimeOut := 5000;
  fIsRunning := False;
  fHidden := True;
  fMerge := False;
  fDestroying := False;
  FillChar(fSA, SizeOf(fSA), 0);
  fSA.nLength := SizeOf(fSA);
  fSA.lpSecurityDescriptor := nil;
  fSA.bInheritHandle := True;
  CreatePipe(fStdInRead, fStdInWrite, @fSA, BufSize);
  CreatePipe(fStdOutRead, fStdOutWrite, @fSA, BufSize);
  CreatePipe(fStdErrRead, fStdErrWrite, @fSA, BufSize);
end;

destructor TRedirectedConsole.Destroy;
begin
  fDestroying := True;
  fOnEnd := nil;
  fOnRun := nil;
  fOnStdOut := nil;
  fOnStdErr := nil;
  Stop;
  CloseHandle(fStdInWrite);
  CloseHandle(fStdOutRead);
  CloseHandle(fStdErrRead);
  inherited;
end;

function TRedirectedConsole.ReadHandle(h: THandle; var s: String): integer;
var
  BytesWaiting: Cardinal;
  Buf: Array[1..BufSize] of char;
{$IFDEF VER100}
  BytesRead: Integer;
{$ELSE}
  BytesRead: Cardinal;
{$ENDIF}
begin
  Result := 0;
  PeekNamedPipe(h, nil, 0, nil, @BytesWaiting, nil);
  if BytesWaiting > 0 then
  begin
    if BytesWaiting > BufSize then
      BytesWaiting := BufSize;
    ReadFile(h, Buf[1], BytesWaiting, BytesRead, nil);
    s := Copy(Buf, 1, BytesRead);
    Result := BytesRead;
  end;
end;

procedure TRedirectedConsole.SendData(s: String);
var
{$IFDEF VER100}
  BytesWritten: Integer;
{$ELSE}
  BytesWritten: Cardinal;
{$ENDIF}
begin
  if fIsRunning then
  begin
    WriteFile(fStdInWrite, s[1], Length(s), BytesWritten, nil);
  end;
end;

procedure TRedirectedConsole.Stop;
begin
  if fIsRunning then
    EndProcess(fPI.hProcess);
end;

procedure TRedirectedConsole.EndProcess(hProc: THandle);
var
  hLib: THandle;
  hRT: THandle;
  pExitProcess: pointer;
  iTI: Integer;
  bTerminated: Boolean;
begin
  bTerminated := False;
  hLib := LoadLibrary('KERNEL32.dll');
  if hLib <> 0 then
  begin
    pExitProcess := GetProcAddress(hLib, 'ExitProcess');
    if pExitProcess <> nil then
    begin
      hRT := CreateRemoteThread(hProc, nil, 0, pExitProcess, nil, 0, iTI); //HERE IS THE GUILTY CODE
      if hRT <> 0 then
      begin
        bTerminated := (WaitForSingleObject(hRT, fExitTimeOut) = WAIT_OBJECT_0);
        CloseHandle(hRT);
      end;
    end;
    FreeLibrary(hLib);
  end;
  if not bTerminated then
  begin
    TerminateProcess(hProc, 0);
    WaitForSingleObject(hProc, fExitTimeOut);
  end;
  fIsRunning := False;
end;

procedure TRedirectedConsole.Run;
var
  s: String;
  hProcOld: THandle;
begin
  fStdOut := '';
  fStdErr := '';
  FillChar(fSI, SizeOf(fSI), 0);
  fSI.cb := SizeOf(fSI);
  if fHidden then
    fSI.wShowWindow := SW_HIDE
  else
    fSI.wShowWindow := SW_SHOWDEFAULT;
  fSI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  fSI.hStdInput := fStdInRead;
  fSI.hStdOutput := fStdOutWrite;
  if fMerge then
    fSI.hStdError := fStdOutWrite
  else
    fSI.hStdError := fStdErrWrite;
  if CreateProcess(nil, PChar(fCmdLine), nil, nil, True, CREATE_NEW_PROCESS_GROUP or NORMAL_PRIORITY_CLASS, nil, nil, fSI, fPI) then
  begin
    hProcOld := fPI.hProcess;
    fIsRunning := True;
    CloseHandle(fStdOutWrite);
    CloseHandle(fStdErrWrite);
    CloseHandle(fStdInRead);
    CloseHandle(fPI.hThread);
    While ((WaitForSingleObject(fPI.hProcess, 10) = WAIT_TIMEOUT) and fIsRunning) do
    begin
      if fDestroying then
        exit;
      if ReadHandle(fStdOutRead, s) > 0 then
        if Assigned(fOnStdOut) then
          fOnStdOut(Self, s)
        else
          fStdOut := Concat(fStdOut, s);
      if ReadHandle(fStdErrRead, s) > 0 then
        if Assigned(fOnStdErr) then
          fOnStdErr(Self, s)
        else
          fStdErr := Concat(fStdErr, s);
      if Assigned(fOnRun) then
        fOnRun(Self);
    end;
    if fDestroying then
      exit;
    if ReadHandle(fStdOutRead, s) > 0 then
      if Assigned(fOnStdOut) then
        fOnStdOut(Self, s)
      else
        fStdOut := Concat(fStdOut, s);
    if ReadHandle(fStdErrRead, s) > 0 then
      if Assigned(fOnStdErr) then
        fOnStdErr(Self, s)
      else
        fStdErr := Concat(fStdErr, s);
    if (fPI.hProcess = hProcOld) then
      CloseHandle(fPI.hProcess);
    fIsRunning := False;
    if Assigned(fOnEnd) then
      fOnEnd(Self);
  end;
end;

end.
0
Comment
Question by:lopem
2 Comments
 
LVL 17

Accepted Solution

by:
mokule earned 125 total points
ID: 18887799
You need to change
  iTI: Integer;
to
  iTI: Cardinal;
0
 
LVL 3

Author Comment

by:lopem
ID: 18887809
Oops, I wonder why I never found it... Thanks!  You got the points...

regards
Manuel Lopez (lopem)
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
This video discusses moving either the default database or any database to a new volume.
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now