Question

DELPHI CreatePipe 方法读取一个DOS窗口返回的数值。

就好比我用DELPHI的WINEXEC创建了一个PING xx.xx.xx.xx -t的命令，然后用管道技术将结果取回存入变量供我分析。

最好能给写成一个 procedure,我直接调用就可以了，哈哈。
写入文件再读出方式无效，因为文本会被另一进程占用，DELPHI读取时会报错，所以才会想到用管道。

能给个现成的例子是最好不过的。

只要管道形式的，其他存为文本方式答案一律忽略。

Answer 1

通过管道技术就可以读取到DOS窗口的返回。

写过一个单元文件可以取到，代码如下：

unit mylib;

interface

uses
  Windows, ShellAPI;
  function GetDosOutput(CommandLine: string): string;

implementation

function GetDosOutput(CommandLine: string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array [0 .. 255] of AnsiChar;
  BytesRead: Cardinal;
  Handle: Boolean;
begin
  Result := '';
  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    Handle := CreateProcess(nil, PChar('cmd /c ' + CommandLine), nil, nil,
      True, 0, nil, nil, SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

end.

测试代码：

procedure TForm1.btn1Click(Sender: TObject);
begin
  mmo1.Text:= GetDosOutput('ping www.baidu.com');
end;

执行效果：

Answer 2

考虑使用dos命令直接将结果写入文件，然后操作文件即可

比如PING xx.xx.xx.xx >>1.txt

Answer 3

if WinExec('cmd.exe /c ping 192.168.0.1 >f:\ping.txt',sw_hide)>31 then
begin
Sleep(5000);//等待文件生成
Memo1.Lines.LoadFromFile('f:\ping.txt');
end;

Answer 4

function AnsiToWide(var aAString: AnsiString): string;

var

temp: string;

count: Integer;

begin

count := Length(aAString);

SetLength(temp, count);

MultiByteToWideChar(CP_ACP, 0, PAnsiChar(aAString), count, PChar(temp), count);

Result := temp;

end;

function RunProgram(aExecutablePath, aArguments: string): string;

var

buffer: array[0..4095] of AnsiChar;

bufferStr: AnsiString;

sa: TSecurityAttributes;

hReadPipe, hWritePipe: THandle;

si: TStartupInfo;

pi: TProcessInformation;

dwExitCode: DWORD;

dwSize, dwRead, dwTemp: DWORD;

begin

FillChar(sa, SizeOf(sa), 0);

sa.nLength := SizeOf(sa);

sa.lpSecurityDescriptor := nil;

sa.bInheritHandle := True;

if CreatePipe(hReadPipe, hWritePipe, @sa, SizeOf(sa)) then

begin

FillChar(si, SizeOf(si), 0);

si.cb := SizeOf(si);

si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

si.wShowWindow := SW_HIDE;

si.hStdInput := hReadPipe;

si.hStdOutput := hWritePipe;

si.hStdError := hWritePipe;

if (Length(aArguments) > 0) and (aArguments[1] <> ' ') then

begin

aArguments := ' ' + aArguments;

end;

if CreateProcess(PChar(aExecutablePath), PChar(aArguments), nil, nil, True, 0, nil, nil, si, pi) then

begin

while True do

begin

if GetExitCodeProcess(pi.hProcess, dwExitCode) then

begin

if dwExitCode <> STILL_ACTIVE then Break;

if PeekNamedPipe(hReadPipe, nil, 0, nil, @dwSize, nil) then

begin

dwTemp := 0;

while dwTemp < dwSize do

begin

FillChar(buffer, dwSize + 2, 0);

if ReadFile(hReadPipe, buffer, dwSize, dwRead, nil) then

begin

Inc(dwTemp, dwRead);

bufferStr := buffer;

Result := Result + AnsiToWide(bufferStr);

end

else

Break;

end;

end

else

Break;

Sleep(10);

end

else

Break;

end;

CloseHandle(pi.hThread);

CloseHandle(pi.hProcess);

end;

CloseHandle(hReadPipe);

CloseHandle(hWritePipe);

end;

end;

a = RunProgram('C:\Windows\system32\ping.exe', '-t 192.168.0.1')

delphi2010下通过

Answer 5

procedure GetDosRes(Que:String; var Res:string);
const
CUANTOBUFFER = 2000;
var
Seguridades :TSecurityAttributes;
PaLeer,PaEscribir :THandle;
start :TStartUpInfo;
ProcessInfo :TProcessInformation;
Buffer :Pchar;
BytesRead :DWord;
CuandoSale :DWord;
begin
with Seguridades do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
if Createpipe(PaLeer,PaEscribir,@Seguridades,0) then
begin
Buffer := AllocMem(CUANTOBUFFER + 1);
try
FillChar(Start,Sizeof(Start),#0);
start.cb := SizeOf(start);
start.hStdOutput := PaEscribir;
start.hStdInput := PaLeer;
start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
if CreateProcess(nil,PChar(Que),@Seguridades,@Seguridades,true,NORMAL_PRIORITY_CLASS,nil, nil,start,ProcessInfo)
then
begin
repeat
CuandoSale := WaitForSingleObject( ProcessInfo.hProcess,100);
Application.ProcessMessages;
until (CuandoSale <> WAIT_TIMEOUT);
Res := '';
repeat
BytesRead := 0;
ReadFile(PaLeer,Buffer[0],CUANTOBUFFER,BytesRead,nil);
Buffer[BytesRead] := #0;
OemToAnsi(Buffer,Buffer);
Res := Res + String(Buffer);
until (BytesRead < CUANTOBUFFER);
end;
finally
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(PaLeer);
CloseHandle(PaEscribir);
end;
end;
end;

调用
var
s :string;
begin
GetDosRes('Ping www.baidu.com',s);
showmessage(s);
end;