Manuel Lopez-Michelone
asked on
problems trying to compile a unit to redirect i/o in delphi 7
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.ProcessMessage s;
Sleep(10);
end;
procedure TForm1.OnConEnd(Sender: TOBject);
begin
MessageBox(Application.Han dle, '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( CommandLin e: 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.ReadHan dle(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.SendDat a(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.EndProc ess(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.
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
begin
fCon := TRedirectedConsole.Create(
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:
begin
memo1.Lines.Append(s);
end;
procedure TForm1.OnConStdErr(Sender:
begin
memo2.Lines.Append(s);
end;
procedure TForm1.OnConRun(Sender: TOBject);
begin
Application.ProcessMessage
Sleep(10);
end;
procedure TForm1.OnConEnd(Sender: TOBject);
begin
MessageBox(Application.Han
end;
procedure TForm1.Button2Click(Sender
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(
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.ReadHan
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.SendDat
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.EndProc
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,
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.
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.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
regards
Manuel Lopez (lopem)