Znalazłem całkiem dobrze działającą funkcyjkę ,która przechwytuje cały tekst z aplikacji DOS'owej do MEMO. Problem wtym że niedokońca jest dobrze napisana bo strasznie obciąża procek okolo 50% na rdzeń. Coś mi świta że częśc kodu powinna byc w osobnym wątku ale nie za bardzo wiem jak to zrobic.
function ExecDOS(const CommandLine: String): Longword;
const
STILL_ACTIVE = 259;
BufferSize = 254; // Tamanho do Buffer
var
Security : TSecurityAttributes;
ReadPipe,
WritePipe : THandle;
StartUpInfo : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : String[BufferSize];
PipeReaded : Cardinal;
PipeAvailable : Cardinal;
TotalPipeReaded : Cardinal;
BytesToRead : Cardinal;
X : Integer;
S, Resto : String;
function LastPos(const S : String; const C : Char): Integer;
var I : Integer;
begin
Result := -1;
For I:=Length(S) downto 1 do
If S[I]=C then
begin
Result := I;
Break;
end;
end;
begin
with Security do
begin
nLength := SizeOf(TSecurityAttributes);
lpSecurityDescriptor := nil;
bInheritHandle := True;
end;
If CreatePipe(ReadPipe, WritePipe, @Security, 0) then
try
FillChar(StartUpInfo, Sizeof(StartUpInfo), #0);
StartUpInfo.cb := SizeOf(StartUpInfo);
StartUpInfo.hStdOutput := WritePipe;
StartUpInfo.hStdInput := ReadPipe;
StartUpInfo.hStdError := WritePipe;
StartUpInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
StartUpInfo.wShowWindow := SW_HIDE;
If CreateProcess(nil, PChar(CommandLine), @Security, @Security, True,
CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS, nil, nil, StartUpInfo,
ProcessInfo) then
try
S := '';
Resto := '';
PipeReaded := 0;
PipeAvailable := 0;
TotalPipeReaded := 0;
While PeekNamedPipe(ReadPipe, nil, 0, @TotalPipeReaded,
@PipeAvailable, nil) do
begin
Application.ProcessMessages;
If PipeAvailable = 0 then
If not(GetExitCodeProcess(ProcessInfo.hProcess, Result)) or
(Result <> STILL_ACTIVE) then
Break else
Continue;
While PipeAvailable > TotalPipeReaded do
begin
If PipeAvailable - TotalPipeReaded > BufferSize then
BytesToRead := BufferSize else
BytesToRead := PipeAvailable - TotalPipeReaded;
Application.ProcessMessages;
If Canceled then
begin
While not TerminateProcess(ProcessInfo.hProcess, 0) do
Application.ProcessMessages;
raise Exception.Create('Operao cancelada!');
end;
If not ReadFile(ReadPipe, Buffer[1], BytesToRead, PipeReaded, nil)
then Break;
If PipeReaded <= 0 then Continue;
SetLength(Buffer, PipeReaded);
Inc(TotalPipeReaded, PipeReaded);
X := LastPos(Buffer, #10);
If X > 0 then
begin
S := Copy(Buffer, X+1, MaxInt);
Delete(Buffer, X-1, MaxInt);
end else
S := '';
MemoLog.Lines.Add(Resto+Buffer);
Resto := S;
end;
end;
MemoLog.Lines.Add(Resto);
finally
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end;
finally
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
end;