
24.04.2010, 16:49
|
 |
Новичок
|
|
Регистрация: 14.07.2007
Сообщения: 85
Репутация: 10
|
|
Разобрался с проблемой через потоки. Если кому-нибудь еще понадобится хороший, годный код перевода из командной строки в Memo без подвисаний, то вот:
Код:
...
type
TDosThread = class(TThread)
cmd: string;
WasOK: Boolean;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
Buffer: array[0..255] of Char;
BytesRead: Cardinal;
private
{ Private declarations }
protected
procedure sync1;
procedure sync2;
procedure sync3;
procedure Execute; override;
end;
...
implementation
...
procedure workres(a:WideString);
begin
Form1.mmo2.lines.add(a);
end;
procedure TDosThread.sync1; begin WasOK:=CreateProcess(nil, PChar(cmd), nil, nil, True, 0, nil, nil, SI, PI) end;
procedure TDosThread.sync2; begin Form1.mmo2.lines.add('x Непонятная ошибка.'); end;
procedure TDosThread.sync3; begin workres(Buffer); end;
procedure TDosThread.Execute;
var
SA: TSecurityAttributes;
WorkDir, Line: string;
begin
SA.nLength:=SizeOf(SA);
SA.bInheritHandle := True;
SA.lpSecurityDescriptor := nil;
CreatePipe(StdOutPipeRead,StdOutPipeWrite,@SA,0);
try
FillChar(SI, SizeOf(SI), 0);
SI.cb := SizeOf(SI);
SI.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
SI.wShowWindow := SW_HIDE;
SI.hStdInput := GetStdHandle(STD_INPUT_HANDLE); // стандартный ввод не перенаправляем
SI.hStdOutput := StdOutPipeWrite;
SI.hStdError := StdOutPipeWrite;
Synchronize(sync1);
CloseHandle(StdOutPipeWrite);
if not WasOK then
Synchronize(sync2)
else
try
Line := '';
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
Synchronize(sync3);
end;
Application.ProcessMessages;
until not WasOK or (BytesRead = 0) or Terminated;
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
...
procedure TForm1.btn1Click(Sender: TObject);
var
T: TDosThread;
begin
T:=TDosThread.Create(true);
T.FreeOnTerminate:=true;
//T.Priority:=tpLower;
T.cmd:='ping 127.0.0.1';
T.Resume;
end;
__________________
Жизнь - это игра... Сюжет не очень, зато графика - отпад.
|