function TForm1.从管道读取(Pipe: THandle): string; const ReadBuffer =4096; var Buffer: PAnsiChar; BytesRead: DWord; begin Result := ''; if GetFileSize(Pipe, nil) = 0 then Exit;
Buffer := AllocMem(ReadBuffer + 1); repeat BytesRead := 0; ReadFile(Pipe, Buffer[0],ReadBuffer, BytesRead, nil); if BytesRead > 0 then begin Buffer[BytesRead] := #0; //OemToAnsi(Buffer, Buffer); Result := string(Buffer); end; until (BytesRead < ReadBuffer); FreeMem(Buffer); end;
procedure TForm1.写入管道(Pipe: THandle; Value: string); var len: integer; BytesWrite: DWord; Buffer: PChar; begin len := Length(Value) + 1; Buffer := PChar(Value + #10); WriteFile(Pipe, Buffer[0], len, BytesWrite, nil); end;
procedure TForm1.btn1Click(Sender: TObject); begin 创建管道; end;
procedure TForm1.tmr1Timer(Sender: TObject); var tmp:string; begin tmp:=从管道读取(WriteOut); mmo1.Text:=tmp; end;
----------------------------------------------
function RunDosCommand(command: string; mode: Byte = 1): string; var hReadPipe, hWritePipe: THandle; si: STARTUPINFO; lsa: SECURITY_ATTRIBUTES; pi: PROCESS_INFORMATION; cchReadBuffer, BytesRead: DWORD; Dest: array[0..1023] of char; cmdLine: array[0..512] of char; begin Result := ''; case mode of 1: // 命令行结果输出到字符串 begin lsa.nLength := sizeof(SECURITY_ATTRIBUTES); lsa.lpSecurityDescriptor := nil; lsa.bInheritHandle := True;
if CreatePipe(hReadPipe, hWritePipe, @lsa, 0) = False then begin //MessageDlg('Can not create pipe!', mtError, [mbOK], 0); Result := 'Can not create pipe!'; Exit; end;
if CreateProcess(nil, cmdLine, nil, nil, true, 0, nil, nil, si, pi) = False then begin //MessageDlg('Can not create process!', mtError, [mbOK], 0); Result := 'Can not create process!'; Exit; end;
Result := ''; while (True) do begin if not PeekNamedPipe(hReadPipe, @Dest[0], 1024, @cchReadBuffer, nil, nil) then break; if cchReadBuffer <> 0 then begin FillChar(Dest, SizeOf(Dest), 0); if ReadFile(hReadPipe, Dest[0], cchReadBuffer, BytesRead, nil) = false then break; Result := Result + Copy(Dest, 0, BytesRead); end else if (WaitForSingleObject(pi.hProcess, 0) = WAIT_OBJECT_0) then break; Delay(100); end;