Lazarus TProcess中的输入输出管道



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

Question1:中文和其他特殊字符不能正常显示,我想知道如何解决这个问题。(代码)线程的类和运行;点击事件按钮

截图问题2:我想知道如何在控制台上输入一些命令。我试着打开Windows命令行,然后使用"winver"命令。但是当我点击按钮时,什么也没发生。

发送命令按钮

Winver不是控制台,而是一个GUI程序。要运行一个输出到memo的程序,请使用以下代码,该代码使用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

最新更新