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

丑子喵 發表於 2023-5-16 23:17:00

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

相关资料：
https://www.shuzhiduo.com/A/gGdXxNGmd4/        Delphi通过管道执行外部命令行程序（cmd）并获取返回结果
实例代码：
<div class="cnblogs_code"><img src="https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif" id="code_img_closed_d56df01e-1bfd-46f0-8979-cfefb29befba" class="code_img_closed"><img src="https://images.cnblogs.com/OutliningIndicators/ExpandedBlockStart.gif" id="code_img_opened_d56df01e-1bfd-46f0-8979-cfefb29befba" class="code_img_opened" style="display: none">
<div id="cnblogs_code_open_d56df01e-1bfd-46f0-8979-cfefb29befba" class="cnblogs_code_hide">
<pre>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.</pre>
</div>
View Code</div>
 PS：
生成的EXE需要放在被调用者的同目录下。因为有工作空间路径的问题。
 
实例代码：
<div class="cnblogs_code"><img src="https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif" id="code_img_closed_04d527df-512c-4c19-8959-b8241b7da251" class="code_img_closed"><img src="https://images.cnblogs.com/OutliningIndicators/ExpandedBlockStart.gif" id="code_img_opened_04d527df-512c-4c19-8959-b8241b7da251" class="code_img_opened" style="display: none">
<div id="cnblogs_code_open_04d527df-512c-4c19-8959-b8241b7da251" class="cnblogs_code_hide">
<pre>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.</pre>
</div>
View Code</div>
 
 
<div id="qb-sougou-search" style="display: none; opacity: 0">
翻译
搜索
复制
<iframe width="320" height="240"></iframe></div>

</div>
<div id="MySignature" role="contentinfo">
<div id="AllanboltSignature">
 <div>作者：疯狂Delphi</div>
 <div>出处：https://www.cnblogs.com/FKdelphi/</div>
 <div>本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利.</div>
</div>
<div class="div_masklayer" id="div_masklayer"></div>
<div class="div_popup" id="Div_popup">
欢迎关注我，一起进步！扫描下方二维码即可加我
<img class="img_zfb" id="img_zfb" width="150" src="https://images.cnblogs.com/cnblogs_com/FKdelphi/1101510/o_251208113944_QQ.png">
<img class="img_zfb" id="img_zfb" width="150" src="https://images.cnblogs.com/cnblogs_com/FKdelphi/1101510/o_251208115029_WX.png">
</div> 
来源：https://www.cnblogs.com/FKdelphi/p/17407200.html

頁: [1]

琼殿技术论坛's Archiver

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