delphi 运行带参数的程序等待其并获取结果-木庄网络博客

本文整理自网络，侵删。
 歪果仁的代码：

var
xExeCuter:TExeCuter;
begin
xExeCuter:=TExeCuter.create;
 xExeCuter.ExecuteApp('ping www.delphitop.com','',
    procedure(const Line: PAnsiChar)
    begin
    mmLog.Lines.Add(Line);
    end);

execut.pas
(*
  Developer: Attila pergel
  web: www.pergel.hu
  email: pergel@pergel.hu
  Project started: 2016
*)
unit execut;

interface

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

type

  TArg<T> = reference to procedure(const Arg: T);

  TExeCuter = class(TObject)
  private
    { Private declarations }

    function GetContent: string;
    procedure SetContent(const Value: string);

  public
    { Public declarations }
    FContents: TStringList;
    procedure ExecuteApp(const ACommand, AParameters: String; CallBack: TArg<PAnsiChar>);
    property Content: string read GetContent write SetContent;
    constructor create;
    destructor destroy;

    procedure test;
  end;

implementation

uses main;

function ArrayToString(const a: array of AnsiChar): string;
begin
  if Length(a) > 0 then SetString(Result, PChar(@a[0]), Length(a))
  else Result := '';
end;

constructor TExeCuter.create;
begin
  FContents := TStringList.create;
end;

destructor TExeCuter.destroy;
begin

  FContents.create.destroy;
end;

procedure TExeCuter.ExecuteApp(const ACommand, AParameters: String; CallBack: TArg<PAnsiChar>);
const
  CReadBuffer = 1024;
var
  saSecurity: TSecurityAttributes;
  hRead: THandle;
  hWrite: THandle;
  suiStartup: TStartupInfo;
  piProcess: TProcessInformation;
  pBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dRead: DWORD;
  dRunning: DWORD;
  dAvailable: DWORD;
  tmpContent: string;
begin
  saSecurity.nLength := SizeOf(TSecurityAttributes);
  saSecurity.bInheritHandle := true;
  saSecurity.lpSecurityDescriptor := nil;
  if CreatePipe(hRead, hWrite, @saSecurity, 0) then
    try
      FillChar(suiStartup, SizeOf(TStartupInfo), #0);
      suiStartup.cb := SizeOf(TStartupInfo);
      suiStartup.hStdInput := hRead;
      suiStartup.hStdOutput := hWrite;
      suiStartup.hStdError := hWrite;
      suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      suiStartup.wShowWindow := SW_HIDE;
      if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity, @saSecurity, true, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess) then
        try
          repeat
            dRunning := WaitForSingleObject(piProcess.hProcess, 100);
            PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);
            if (dAvailable > 0) then
              repeat
                dRead := 0;
                ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
                pBuffer[dRead] := #0;
                OemToCharA(pBuffer, dBuffer);
                tmpContent := tmpContent + dBuffer;
                Content := tmpContent;
                CallBack(dBuffer)
              until (dRead < CReadBuffer);
            Application.ProcessMessages;
          until (dRunning <> WAIT_TIMEOUT);

        finally
          CloseHandle(piProcess.hProcess);
          CloseHandle(piProcess.hThread);
        end;
    finally
      CloseHandle(hRead);
      CloseHandle(hWrite);
    end;
end;

function TExeCuter.GetContent: string;
begin
  Result := FContents.text;

end;

procedure TExeCuter.SetContent(const Value: string);
begin
  FContents.text := Value;
end;

procedure TExeCuter.test;
var
  s: string;
begin

  ExecuteApp
    ('youtube-dl.exe --no-check-certificate -f "bestvideo[ext=mp4]+bestaudio[ext=m4a]/best[ext=mp4]/best" --simulate --get-url   --yes-playlist "https://www.youtube.com/watch?v=wXUBX9wmUOE&list=PLuKq2nkb8ZFt4bYja1rDxB2Z1q0t4IaDm"',
    '',
    procedure(const Line: PAnsiChar)
    begin
      // Memo1.Lines.Add(String(Line));

      s := Line;
    end);

end;

end.

  end.
delphi 运行带参数的程序等待其并获取结果

相关推荐

评论
