Показать сообщение отдельно
  #2  
Старый 24.04.2010, 16:49
Аватар для IllVDG
IllVDG IllVDG вне форума
Новичок
 
Регистрация: 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;
__________________
Жизнь - это игра... Сюжет не очень, зато графика - отпад.
Ответить с цитированием