Lazarus TProcess 中的输入和输出管道

Question

我想制作一个带有 Lazarus GUI 应用程序的终端。但我有麻烦了。我希望有人能帮助我。

问题1: 中文等特殊字符无法正常显示，请问如何解决。 (code)Class of the thread and "run" button on click event

screenshot

问题2: 我想知道如何在控制台输入命令。我尝试启动 Windows cmd，并使用“winver”命令。但是当我点击按钮时，没有任何反应。

The send command button

Answer 1

Winver 不是控制台而是 GUI 程序。要运行将输出到备忘录的程序，请使用以下代码，该代码使用 cmd.exe “ver” 命令检索版本。您也可以尝试使用此模板来回答第一个问题。

unit mainprocesstomemo;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Process, Pipes;

Type
  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
  public
    procedure ProcessEvent(Sender,Context : TObject;Status:TRunCommandEventCode;const Message:string);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TProcessMemo }
Type

 TProcessToMemo = class(TProcess)
                            public
                            fmemo : Tmemo;
                            bytesprocessed : integer;
                            fstringsadded : integer;
                            function ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var Data:string;MaxLoops:integer=10):boolean;override;
                          end;



function RunCommandMemo(const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone;memo:TMemo=nil;runrefresh : TOnRunCommandEvent=nil ):boolean;
Var
    p : TProcessToMemo;
    i,
    exitstatus : integer;
    ErrorString : String;
begin
  p:=TProcessToMemo.create(nil);
  if Options<>[] then
    P.Options:=Options - [poRunSuspended,poWaitOnExit];
  p.options:=p.options+[poRunIdle];

  P.ShowWindow:=SwOptions;
  p.Executable:=exename;
  if high(commands)>=0 then
   for i:=low(commands) to high(commands) do
     p.Parameters.add(commands[i]);
  p.fmemo:=memo;
  p.OnRunCommandEvent:=runrefresh;
  try
    result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
  finally
    p.free;
  end;
  if exitstatus<>0 then result:=false;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var s : string;
begin
//RunCommandMemo('testit',[],s,[],swonone,memo1,ProcessEvent);
  RunCommandMemo('cmd.exe',['/w','/c','ver'],s,[],swonone,memo1,ProcessEvent);
end;

procedure TForm1.ProcessEvent(Sender, Context: TObject;
  Status: TRunCommandEventCode; const Message: string);
begin
  if status in [RunCommandIdle, RunCommandFinished] then
    begin
      if status =RunCommandFinished then
        begin
          memo1.lines.add(' process finished');
        end;
      if tprocesstomemo(sender).fstringsadded>0 then
       begin
         tprocesstomemo(sender).fstringsadded:=0;
//         memo1.lines.add('Handle:'+inttostr(tprocesstomemo(sender).ProcessHandle));
         memo1.refresh;
       end;
      sleep(10);
      application.ProcessMessages;
    end;
end;

{ TProcessToMemo }


function TProcessToMemo.ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var Data:string;MaxLoops:integer=10):boolean;
var lfpos : integer;
    crcorrectedpos:integer;
    stradded : integer;
    newstr : string;
begin
  Result:=inherited ReadInputStream(p, BytesRead, DataLength, data, MaxLoops);
  if (result) and (bytesread>bytesprocessed)then
    begin
      stradded:=0;
      lfpos:=pos(#10,data,bytesprocessed+1);
      while (lfpos<>0) and (lfpos<=bytesread) do
        begin
          crcorrectedpos:=lfpos;
          if (crcorrectedpos>0) and (data[crcorrectedpos-1]=#13) then
             dec(crcorrectedpos);
          newstr:=copy(data,bytesprocessed+1,crcorrectedpos-bytesprocessed-1);
          fmemo.lines.add(newstr);
           inc(stradded);
          bytesprocessed:=lfpos;
          lfpos:=pos(#10,data,bytesprocessed+1);
        end;
      inc(fstringsadded,stradded); // check idle event.
    end;
end;

end.

我不知道 minecraft 服务器，很多外部程序可能会对控制台做一些奇怪的事情。但是这里有一个简单的程序组合来测试 http://www.stack.nl/~marcov/files/processmemodemo.zip

Lazarus TProcess 中的输入和输出管道

Input and output pipe in Lazarus TProcess

process

lazarus