Delphi-Delphi通过管道执行外部命令行程序（cmd）并获取返回结果

相关资料：

https://www.shuzhiduo.com/A/gGdXxNGmd4/        Delphi通过管道执行外部命令行程序（cmd）并获取返回结果

实例代码：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function RunDosCommand(Command: string): string;
var
  hReadPipe: THandle;
  hWritePipe: THandle;
  SI: TStartUpInfo;
  PI: TProcessInformation;
  SA: TSecurityAttributes;
  //     SD   :   TSecurityDescriptor;
  BytesRead: DWORD;
  Dest: AnsiString;
  TmpList: TStringList;
  Avail, ExitCode, wrResult: DWORD;
  osVer: TOSVERSIONINFO;
  tmpstr: AnsiString;
begin
  SetLength(Dest, 1024);
  osVer.dwOSVersionInfoSize := Sizeof(TOSVERSIONINFO);
  GetVersionEX(osVer);

  if osVer.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
  //         InitializeSecurityDescriptor(@SD,   SECURITY_DESCRIPTOR_REVISION);
  //         SetSecurityDescriptorDacl(@SD,   True,   nil,   False);
    SA.nLength := SizeOf(SA);
    SA.lpSecurityDescriptor := nil; //@SD;
    SA.bInheritHandle := True;
    CreatePipe(hReadPipe, hWritePipe, @SA, 0);
  end
  else
    CreatePipe(hReadPipe, hWritePipe, nil, 1024);
  try
    FillChar(SI, SizeOf(SI), 0);
    SI.cb := SizeOf(TStartUpInfo);
    SI.wShowWindow := SW_HIDE;
    SI.dwFlags := STARTF_USESHOWWINDOW;
    SI.dwFlags := SI.dwFlags or STARTF_USESTDHANDLES;
    SI.hStdOutput := hWritePipe;
    SI.hStdError := hWritePipe;
    if CreateProcess(nil, PChar(@Command[1]), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, SI, PI) then
    begin
      ExitCode := 0;
      while ExitCode = 0 do
      begin
        wrResult := WaitForSingleObject(PI.hProcess, 500);
  //                 if   PeekNamedPipe(hReadPipe,   nil,   0,   nil,   @Avail,   nil)   then
        if PeekNamedPipe(hReadPipe, @Dest[1], 1024, @Avail, nil, nil) then
        begin
          if Avail > 0 then
          begin
            TmpList := TStringList.Create;
            try
              FillChar(Dest[1], Length(Dest) * SizeOf(Char), 0);
              ReadFile(hReadPipe, Dest[1], Avail, BytesRead, nil);
              TmpStr := Copy(Dest, 0, BytesRead - 1);
              TmpList.Text := TmpStr;
              Result := tmpstr;
            finally
              TmpList.Free;
            end;
          end;
        end;
        if wrResult <> WAIT_TIMEOUT then ExitCode := 1;
      end;
      GetExitCodeProcess(PI.hProcess, ExitCode);
      CloseHandle(PI.hProcess);
      CloseHandle(PI.hThread);
    end;
  finally
    CloseHandle(hReadPipe);
    CloseHandle(hWritePipe);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  memo1.Text := RunDosCommand('lanzhou_2023.EXE 22058878,2,88,32460,,13040503,94,1,K22.301|K11.901|E11.900|I10.x05,96.0800x005');
  //memo1.Text := RunDosCommand('PING WWW.BAIDU.COM');
end;

end.

View Code

 PS：

生成的EXE需要放在被调用者的同目录下。因为有工作空间路径的问题。

实例代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

 // procedure group_txt(); stdcall; external 'lanzhou_2023.dll';

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin

 // memo1.Text = group_record('"22082078,1,24, 9105, 3470,13050201, 6, 1,\"K63.500,K52.910\",\"00.5500,45.4300x010,45.4300x013\""');
 // memo1.Text := group_record('22082078,1,24, 9105, 3470,13050201, 6, 1,"K63.500,K52.910","00.5500,45.4300x010,45.4300x013"');

// group_txt();
end;

function GetRunConsoleResult(FileName:String;Visibility:Integer;var mOutputs:string):Integer;
var
  sa:TSecurityAttributes;
  hReadPipe,hWritePipe:THandle;
  ret:BOOL;
  strBuff:array[0..255] of char;
  lngBytesread:DWORD;
  
  WorkDir:String;
  StartupInfo:TStartupInfo;
  ProcessInfo:TProcessInformation;
begin
  FillChar(sa,Sizeof(sa),#0);
  sa.nLength := Sizeof(sa);
  sa.bInheritHandle := True;
  sa.lpSecurityDescriptor := nil;
  if not(CreatePipe(hReadPipe, hWritePipe, @sa, 0)) then
    begin
      Result:=-2;  //通道创建失败
    end;
  WorkDir:=ExtractFileDir(Application.ExeName);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb:=Sizeof(StartupInfo);
  StartupInfo.dwFlags:=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  StartupInfo.wShowWindow:=Visibility;
 
  StartupInfo.hStdOutput:=hWritePipe;
  StartupInfo.hStdError:=hWritePipe;
 
  if not CreateProcess(nil,
    PChar(FileName),               { pointer to command line string }
    @sa,                           { pointer to process security attributes }
    @sa,                           { pointer to thread security attributes }
    True,                          { handle inheritance flag }
    NORMAL_PRIORITY_CLASS,
    nil,                           { pointer to new environment block }
    PChar(WorkDir),                { pointer to current directory name, PChar}
    StartupInfo,                   { pointer to STARTUPINFO }
    ProcessInfo)                   { pointer to PROCESS_INF }
  then
    Result := INFINITE {-1 进程创建失败}
  else
    begin
      CloseHandle(hWritePipe);
      mOutputs:='';
      while ret do
      begin
        FillChar(strBuff,Sizeof(strBuff),#0);
        ret := ReadFile(hReadPipe, strBuff, 256, lngBytesread, nil);
        mOutputs := mOutputs + strBuff;
      end;
 
      Application.ProcessMessages;
      //等待console结束
      WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
      GetExitCodeProcess(ProcessInfo.hProcess,  Cardinal(Result));
      CloseHandle(ProcessInfo.hProcess);  { to prevent memory leaks }
      CloseHandle(ProcessInfo.hThread);
      CloseHandle(hReadPipe);
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  e, p, s: string;
begin
  e:='D:\java\DRG_Csharp\drg_group\lanzhou_2023\delphi\lanzhou_2023.exe';
  p:='22082078,1,24, 9105, 3470,13050201, 6, 1,"K63.500,K52.910","00.5500,45.4300x010,45.4300x013"';
// GetRunConsoleResult(执行文件,SW_SHOWNORMAL,返回字符串); //函数执行成功返回 0
 GetRunConsoleResult(e,SW_SHOWNORMAL,s); //函数执行成功返回 0
 memo1.Text:= s;
end;

end.

View Code

翻译

搜索

复制