5

我曾尝试使用 delphi 将命令发送到命令提示符。但是,我无法这样做,因为我使用了 CreateProcess 方法来做到这一点。我试图更改 StdOutPipeWrite,但是,CreateProcess 似乎不允许通过来自 CreateProcess 的初始命令之后的命令。有没有办法利用句柄继续在命令提示符和delphi之间发送和接收命令和消息?

4

2 回答 2

10

我来自 tek-tips.com 的同事 Glenn9999就这个主题写了一篇很好的常见问题解答。我不知道他是否在 SO,但他应该为此获得所有荣誉。我从此处复制了该页面的代码以供将来参考。他使用管道来做控制台和delphi之间的通信。

unit mcunit;

{ written by Glenn9999 @ tek-tips.com.  Posted here 6/21/2011 }
interface

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

type
  monitor = class(TThread)  // pipe monitoring thread for console output
  private
    TextString: String;
    procedure UpdateCaption;
  protected
    procedure Execute; override;
  end;
  TForm1 = class(TForm)
    CommandText: TMemo;
    CommandRun: TComboBox;
    Button2: TButton;
    SaveDialog1: TSaveDialog;
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    cmdcount: integer;
  end;

var
  Form1: TForm1;
  InputPipeRead, InputPipeWrite: THandle;
  OutputPipeRead, OutputPipeWrite: THandle;
  ErrorPipeRead, ErrorPipeWrite: THandle;
  ProcessInfo : TProcessInformation;
  myThread: monitor;

implementation

{$R *.DFM}

procedure WritePipeOut(OutputPipe: THandle; InString: string);
// writes Instring to the pipe handle described by OutputPipe
  var
    byteswritten: DWord;
  begin
// most console programs require CR/LF after their input.
    InString := InString + #13#10;
    WriteFile(OutputPipe, Instring[1], Length(Instring), byteswritten, nil);
  end;

function ReadPipeInput(InputPipe: THandle; var BytesRem: Integer): String;
  {
    reads console output from InputPipe.  Returns the input in function
    result.  Returns bytes of remaining information to BytesRem
  }
  var
    TextBuffer: array[1..32767] of char;
    TextString: String;
    BytesRead: Integer;
    PipeSize: Integer;
  begin
    Result := '';
    PipeSize := Sizeof(TextBuffer);
    // check if there is something to read in pipe
    PeekNamedPipe(InputPipe, nil, PipeSize, @BytesRead, @PipeSize, @BytesRem);
    if bytesread > 0 then
      begin
        ReadFile(InputPipe, TextBuffer, pipesize, bytesread, nil);
        // a requirement for Windows OS system components
        OemToChar(@TextBuffer, @TextBuffer);
        TextString := String(TextBuffer);
        SetLength(TextString, BytesRead);
        Result := TextString;
      end;
  end;

procedure monitor.Execute;
{ monitor thread execution for console output.  This must be threaded.
   checks the error and output pipes for information every 40 ms, pulls the
   data in and updates the memo on the form with the output }
var
  BytesRem: DWord;
begin
  while not Terminated do
    begin
      // read regular output stream and put on screen.
      TextString := ReadPipeInput(OutputPipeRead, BytesRem);
      if TextString <> '' then
         Synchronize(UpdateCaption);
      // now read error stream and put that on screen.
      TextString := ReadPipeInput(ErrorPipeRead, BytesRem);
      if TextString <> '' then
         Synchronize(UpdateCaption);
      sleep(40);
    end;
end;

procedure monitor.UpdateCaption;
// synchronize procedure for monitor thread - updates memo on form.
begin
  With Form1.CommandText.Lines do
    Add(TextString);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  WritePipeOut(InputPipeWrite, 'EXIT'); // quit the CMD we started
  MyThread.Terminate;
  // close process handles
  CloseHandle(ProcessInfo.hProcess);
  CloseHandle(ProcessInfo.hThread);
  // close pipe handles
  CloseHandle(InputPipeRead);
  CloseHandle(InputPipeWrite);
  CloseHandle(OutputPipeRead);
  CloseHandle(OutputPipeWrite);
  CloseHandle(ErrorPipeRead);
  CloseHandle(ErrorPipeWrite);
end;

procedure TForm1.Button2Click(Sender: TObject);
 { takes the input from the command edit box and processes it }
  var
    UpText: String;
  begin
    UpText := UpperCase(CommandRun.Text);  // done to eliminate case-sensitivity
    if UpText = 'CLR' then        // clear the memo
      begin
        CommandText.Clear;
        WritePipeOut(InputPipeWrite, #13);
      end
    else
    if UpText = 'SAVELOG' then    // save the memo box to a file.
      begin
        if SaveDialog1.Execute then
          begin
            CommandText.Lines.SaveToFile(SaveDialog1.FileName);
            CommandText.Lines.Add('Log file saved.');
          end
        else
          CommandText.Lines.Add('Log file not saved.');
      end
  // expand this, it needs to catch any variation where the command-interpreter
  // is called.  Any different ideas?
    else
    if UpText = 'CMD' then
       inc(cmdcount)
    else
    if UpText = 'COMMAND' then
       inc(cmdcount)
  // terminate app if user types exit, else let alone
    else
    if UpText = 'EXIT' then
      begin
        if cmdcount = 1 then
           Application.Terminate
        else
          dec(cmdcount);
      end
    else
      WritePipeOut(InputPipeWrite, CommandRun.Text);
    CommandRun.Items.Add(CommandRun.Text);
    CommandRun.Text := '';
    CommandRun.SetFocus;
  end;

procedure TForm1.FormCreate(Sender: TObject);
 { upon form creation, this calls the command-interpreter, sets up the three
   pipes to catch input and output, and starts a thread to monitor and show
   the output of the command-interpreter }
  var
    DosApp: String;
    DosSize: Integer;
    Security : TSecurityAttributes;
    start : TStartUpInfo;
  begin
    CommandText.Clear;
    // get COMSPEC variable, this is the path of the command-interpreter
    SetLength(Dosapp, 255);
    DosSize := GetEnvironmentVariable('COMSPEC', @DosApp[1], 255);
    SetLength(Dosapp, DosSize);

  // create pipes
    With Security do
      begin
        nlength := SizeOf(TSecurityAttributes) ;
        binherithandle := true;
        lpsecuritydescriptor := nil;
      end;
    CreatePipe(InputPipeRead, InputPipeWrite, @Security, 0);
    CreatePipe(OutputPipeRead, OutputPipeWrite, @Security, 0);
    CreatePipe(ErrorPipeRead, ErrorPipeWrite, @Security, 0);

  // start command-interpreter
    FillChar(Start,Sizeof(Start),#0) ;
    start.cb := SizeOf(start) ;
    start.hStdInput := InputPipeRead;
    start.hStdOutput := OutputPipeWrite;
    start.hStdError :=  ErrorPipeWrite;
    start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;
    if CreateProcess(nil, PChar(DosApp), @Security, @Security, true,
               CREATE_NEW_CONSOLE or SYNCHRONIZE,
               nil, nil, start, ProcessInfo) then
      begin
        MyThread := monitor.Create(false);  // start monitor thread
        MyThread.Priority := tpHigher;
      end;
    Button2.Enabled := true;
    cmdcount := 1;
 end;

 end.

更新(2020 年 5 月 1 日)

此答案仅适用于非 unicode 支持的 Delphi 版本。如果你有一个现代的 Delphi,你可以在这里找到一个工作版本

于 2012-05-15T13:01:50.247 回答
-3

首先声明用途:

ShellAPI

然后使用这个:

ShellExecute(0, nil, 'cmd.exe', '/c **YOUR_COMMAND_HERE**', nil, HIDE_WINDOW);
于 2015-10-01T22:58:21.873 回答