у меня он тоже глючил, и я что-то переделывал, но сейчас, глядя на свои исходники, разницы не вижу:
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure RunInMemo (Cmd: string; Memo: TCustomMemo; RefreshTime: integer);
const
bufsize = 2000;
var
sa: TSecurityAttributes;
si: TStartupInfo;
pi: TProcessInformation;
rp, wp: THandle;
buf: pchar;
ec: dword;
bread: dword;
begin
with sa do begin
nLength := SizeOf (TSecurityAttributes);
bInheritHandle := TRUE;
lpSecurityDescriptor := nil;
end;
if CreatePipe (rp, wp, @sa, 0) then begin
FillChar (si, SizeOf (TStartupInfo), #0);
with si do begin
cb := SizeOf (si);
hStdInput := rp;
hStdOutput := wp;
dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
wShowWindow := SW_HIDE;
end;
buf := AllocMem (bufsize + 1);
try
if CreateProcess (nil, pchar (Cmd), @sa, @sa, TRUE, NORMAL_PRIORITY_CLASS, nil, nil, si, pi) then begin
repeat
ec := WaitForSingleObject (pi.hProcess, RefreshTime);
ReadFile (rp, buf [0], bufsize, bread, nil);
buf [bread] := #0;
OemToAnsi (buf, buf);
Memo.Text := Memo.Text + string (buf);
Application.ProcessMessages;
until ec <> WAIT_TIMEOUT;
end;
finally
FreeMem (buf);
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
CloseHandle(rp);
CloseHandle(wp);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RunInMemo (Edit1.Text, Memo1, 100);
end;
end.
|
по сравнению с вариантом Song'а добавлен RefreshInterval.
единственное что, задержку перед чтением из канализации можно и нужно варьировать, одни и те же проги у меня лично глючат при определённых значениях RefreshInterval, который в drkb задан жёстко (соотв. некоторые проги глючат перманентно). |