unit AnonymousPipeThreads;
interface
uses
Classes, Windows, Sysutils;
const
CRLF=#13#10;
bufsize=1024;
// 1KByte buffer
type
TAnonymousPipeThread =
class(TThread)
private
Sendbuffer :
string;
FChannel : Integer;
FFileToRun :
string;
procedure SetChannel(Value: Integer);
procedure SetFileToRun(Value:
string);
protected
procedure Execute;
override;
procedure SplitLines(s:
string);
function IsWinNT: Boolean;
public
LineOut:
procedure(s:
string; channel : integer);
// Variable setzen um die Ausgaben der gestarteten
// Anwendungen auf eine (oder auch verschiedene)
// Prozedur(en) der mit der folgenden Syntax
// (AusgabeDerEngine; EngineIdentifier)
// umzuleiten.
property Channel : Integer
write SetChannel;
// > id um mehrere gestarte Prozesse und deren
// Ausgaben zu unterscheiden...
property FileToRun :
string write SetFileToRun;
// > diser Eigenschaft wird entnommen welche
// Anwendung der Thread starten soll
// (z.B. 'C:\Windows\System32\cmd.exe' )
procedure LineIn (s:
string);
// Mit dem Aufruf dieser Prozedur sendet der Thread
// den String an die gestarte Konsolenanwendung
end;
implementation
procedure TAnonymousPipeThread.Execute;
var
newstdin, newstdout, read_stdout, write_stdin: tHandle;
buf:
array [0..bufsize-1]
of char;
si: tSTARTUPINFO;
sa: tSECURITYATTRIBUTES;
sd: tSECURITYDESCRIPTOR;
pi: tPROCESSINFORMATION;
bread, avail: dword;
ProcessExitCode: Cardinal;
LoopEnd: Boolean;
begin
// Konfigurieren der Sicherheits-Attribute
If IsWinNT
then begin
InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
SetSecurityDescriptorDacl(@sd, true,
nil, false);
sa.lpSecurityDescriptor:=@sd;
sa.bInheritHandle:=true;
//hier war der urspr. Fehler
end else sa.lpSecurityDescriptor:=nil;
// 1. Pipe erstellen
If not CreatePipe(newstdin, write_stdin, @sa, 1024)
then begin
LineOut('
Error creating first pipe', FChannel);
exit;
end;
// 2. Pipe erstellen
If not CreatePipe(read_stdout, newstdout, @sa, 1024)
then begin
LineOut('
Error creating second pipe', FChannel);
CloseHandle(newstdin);
CloseHandle(write_stdin);
exit;
end;
// StartupInfo für den zu startenden Prozess konfigurieren...
GetStartupInfo(si);
si.dwFlags:=STARTF_USESTDHANDLES
or STARTF_USESHOWWINDOW;
si.wShowWindow:=SW_HIDE;
si.hStdOutput:=newstdout;
si.hStdError:=newstdout;
si.hStdInput:=newstdin;
// Prozess (Konsolenanwendung) starten...
If not CreateProcess(pchar(FFileToRun),
nil,
nil,
nil, true, CREATE_NEW_CONSOLE,
nil, pChar(ExtractFilePath(FFileToRun)), si, pi)
then begin
LineOut('
Error creating process: '+ FFileToRun, FChannel);
CloseHandle(newstdin);
CloseHandle(newstdout);
CloseHandle(read_stdout);
CloseHandle(write_stdin);
exit;
end;
// Loop (infinite till process quits)
fillchar(buf, sizeof(buf), 0);
LoopEnd:=false;
Sendbuffer:='
';
Repeat
Sleep(1);
GetExitCodeProcess(pi.hProcess, ProcessExitCode);
If (ProcessExitCode<>STILL_ACTIVE)
then LoopEnd:=True;
PeekNamedPipe(read_stdout, @buf, bufsize, @bread, @avail,
nil);
// eingehende Nachrichten
If (bread<>0)
then begin
fillchar(buf, bufsize, 0);
If (avail>bufsize)
then
While (bread>=bufsize)
do begin
ReadFile(read_stdout, buf, bufsize, bread,
nil);
SplitLines(buf);
fillchar(buf, bufsize, 0);
end
else begin
ReadFile(read_stdout, buf, bufsize, bread,
nil);
SplitLines(buf);
end;
end;
// ausgehende Nachrichten
While (Length(Sendbuffer)>0)
do begin
WriteFile(write_stdin, Sendbuffer[1], 1, bread,
nil);
Delete(Sendbuffer, 1, 1);
end;
until LoopEnd;
// Aufräumarbeiten...
CloseHandle(pi.hThread);
CloseHandle(pi.hProcess);
CloseHandle(newstdin);
CloseHandle(newstdout);
CloseHandle(read_stdout);
CloseHandle(write_stdin);
end;
procedure TAnonymousPipeThread.SplitLines(s:
string);
var t:
string;
begin
While pos(#$A, s)<>0
do begin
t:=copy(s, 1, pos(#$A, s)-1);
LineOut(t, FChannel);
// Ausgabe (von der Konsolenanwendung)
delete(s, 1, pos(#$A, s));
end;
If length(s)>0
then LineOut(s, FChannel);
end;
procedure TAnonymousPipeThread.LineIn(s:
string);
begin
Sendbuffer:=Sendbuffer+s+CRLF;
// Eingabe (an die Konsolenanwendung)
end;
procedure TAnonymousPipeThread.SetChannel(Value: Integer);
begin
FChannel:=Value;
end;
procedure TAnonymousPipeThread.SetFileToRun(Value:
string);
begin
FFileToRun:=Value;
end;
function TAnonymousPipeThread.IsWinNT: Boolean;
var osv: tOSVERSIONINFO;
begin
osv.dwOSVersionInfoSize:=sizeof(osv);
GetVersionEx(osv);
result:=osv.dwPlatformID=VER_PLATFORM_WIN32_NT;
end;
end.