| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как вывести результат работы консоли в Memo? [D6, XP]

nord13579 ©   (2007-06-30 21:28:00) 

Нашел в DRKB пример работы с консолью. Пример рабочий если бы не одно но - Программа не выходит из Repeat - Until. Может быть кто-нибудь подскажет где чего нужно подправить?

procedure RunDosInMemo(CmdLine:String;AMemo:TMemo);
const
 ReadBuffer = 2400;
var
 Security            : TSecurityAttributes;
 ReadPipe,WritePipe  : THandle;
 start               : TStartUpInfo;
 ProcessInfo         : TProcessInformation;
 Buffer              : Pchar;
 BytesRead           : DWord;
 Apprunning          : DWord;
begin
Screen.Cursor:=CrHourGlass;
Form1.Button1.Enabled:=False;
With Security do begin
 nlength        := SizeOf(TSecurityAttributes);
 binherithandle    := true;
 lpsecuritydescriptor := nil;
end;
if Createpipe (ReadPipe, WritePipe, @Security, 0) then
begin
 Buffer  := AllocMem(ReadBuffer + 1);
 FillChar(Start,Sizeof(Start),#0);
 start.cb      := SizeOf(start);
 start.hStdOutput  := WritePipe;
 start.hStdInput  := ReadPipe;
 start.dwFlags   := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
 start.wShowWindow := SW_HIDE;
   if CreateProcess(nil,
     PChar(CmdLine),
     @Security,
     @Security,
     true,
     NORMAL_PRIORITY_CLASS,
     nil,
     nil,
     start,
     ProcessInfo)
 then
   begin
     repeat
       Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);
       ReadFile(ReadPipe,Buffer[0], ReadBuffer,BytesRead,nil);
       Buffer[BytesRead]:= #0;
       OemToAnsi(Buffer,Buffer);
       AMemo.Text := AMemo.text + String(Buffer);
       Application.ProcessMessages;
     until (Apprunning <> WAIT_TIMEOUT);
   end;
     FreeMem(Buffer);
     CloseHandle(ProcessInfo.hProcess);
     CloseHandle(ProcessInfo.hThread);
     CloseHandle(ReadPipe);
     CloseHandle(WritePipe);
end;
Screen.Cursor:=CrDefault;
Form1.Button1.Enabled:=True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Memo1.Clear;
 RunDosInMemo('ping ya.ru -r 9 -n 5',Memo1);
end;

end.


---

TUser   (2007-06-30 22:53:00) [1]

> nord13579 ©   (30.06.07 22:00) [3]

Поставь infinate, а то вдруг и тясячи секунд будет мало.

---

nord13579   (2007-06-30 22:00:00) [2]

Все, разобрался. Нужно:

Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);

увеличить

Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 1000);


---

nord13579   (2007-06-30 21:44:00) [3]

> until (Apprunning <> WAIT_TIMEOUT) or (key = #27);

Нужно что-бы выходило само :(

---

Lavrenty   (2007-06-30 21:37:00) [4]

Может код нажатия какой-нибудь клавиши попробовать, например

until (Apprunning <> WAIT_TIMEOUT) or (key = #27);


---

Наверх