Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[18.117.153.38] |
|
Сообщ.
#1
,
|
|
|
Код взят из http://www.torry.net/memos.htm
procedure Dos2Win(CmdLine:String; OutMemo:TMemo); const BUFSIZE = 2000; var SecAttr : TSecurityAttributes; hReadPipe, hWritePipe : THandle; StartupInfo: TStartUpInfo; ProcessInfo: TProcessInformation; Buffer : Pchar; WaitReason, BytesRead : DWord; begin with SecAttr do begin nlength := SizeOf(TSecurityAttributes); binherithandle := true; lpsecuritydescriptor := nil; end; // Creazione della pipe if Createpipe (hReadPipe, hWritePipe, @SecAttr, 0) then begin Buffer := AllocMem(BUFSIZE + 1); // Allochiamo un buffer di dimensioni BUFSIZE+1 FillChar(StartupInfo, Sizeof(StartupInfo), #0); StartupInfo.cb := SizeOf(StartupInfo); StartupInfo.hStdOutput := hWritePipe; StartupInfo.hStdInput := hReadPipe; StartupInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW; StartupInfo.wShowWindow := SW_HIDE; if CreateProcess(nil, PChar(CmdLine), @SecAttr, @SecAttr, true, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then begin // Attendiamo la fine dell'esecuzione del processo repeat WaitReason := WaitForSingleObject( ProcessInfo.hProcess,100); Application.ProcessMessages; until (WaitReason <> WAIT_TIMEOUT); // Leggiamo la pipe Repeat BytesRead := 0; // Leggiamo "BUFSIZE" bytes dalla pipe ReadFile(hReadPipe, Buffer[0], BUFSIZE, BytesRead, nil); // Convertiamo in una stringa "\0 terminated" Buffer[BytesRead]:= #0; // Convertiamo i caratteri da DOS ad ANSI OemToAnsi(Buffer,Buffer); // Scriviamo nell' "OutMemo" l'output ricevuto tramite pipe OutMemo.Text := OutMemo.text + String(Buffer); until (BytesRead < BUFSIZE); end; FreeMem(Buffer); CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread); CloseHandle(hReadPipe); CloseHandle(hWritePipe); end; end; А это исправленный Song'ом вариант для обеспечения вывода текста в real-time: 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 -t 192.168.28.200',Memo1); end; |
Сообщ.
#2
,
|
|
|
В примере Сонга - прога виснит, после выполнения команды в консоли. Зависает она в цикле repeat - until, и дальнейшие команды по освобождению памяти не выполняются. Сравнивая этот пример с вот этим: Запуск консольного приложения и получение результатов работы обнаружил, что пример Сонга начинает работать, если команду CloseHandle(WritePipe); вынести вперед цикла...
Но почему оно начало работать - пока не понимаю, и самому интересно. ВОт что у меня вышло: 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; WasOK : Boolean; begin Screen.Cursor:=CrHourGlass; 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), nil,//@Security, nil,//@Security, true, NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then begin CloseHandle(WritePipe); Apprunning := WaitForSingleObject (ProcessInfo.hProcess,100); try repeat WasOK:=ReadFile(ReadPipe,Buffer[0], ReadBuffer,BytesRead,nil); Buffer[BytesRead]:= #0; OemToAnsi(Buffer,Buffer); AMemo.Text := AMemo.text + String(Buffer); Application.ProcessMessages; until (not WasOK) or ( BytesRead = 0 ); finally CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread); end; end; FreeMem(Buffer); CloseHandle(ReadPipe); end; Screen.Cursor:=CrDefault; end; |