我想用我自己的单元读取从控制台的控制台输出:德尔福控制台管道切换?
unit uConsoleOutput;
interface
uses Classes,
StdCtrls,
SysUtils,
Messages,
Windows;
type
ConsoleThread = class(TThread)
private
OutputString : String;
procedure SetOutput;
protected
procedure Execute; override;
public
App : WideString;
Memo : TMemo;
Directory : WideString;
end;
type
PConsoleData = ^ConsoleData;
ConsoleData = record
OutputMemo : TMemo;
OutputApp : WideString;
OutputDirectory : WideString;
OutputThreadHandle : ConsoleThread;
end;
function StartConsoleOutput (App : WideString; Directory : WideString; Memo : TMemo) : PConsoleData;
procedure StopConsoleOutput (Data : PConsoleData);
implementation
procedure ConsoleThread.SetOutput;
begin
Memo.Lines.BeginUpdate;
Memo.Text := Memo.Text + OutputString;
Memo.Lines.EndUpdate;
end;
procedure ConsoleThread.Execute;
const
ReadBuffer = 20;
var
Security : TSecurityAttributes;
ReadPipe,
WritePipe : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : DWord;
Apprunning : DWord;
begin
Security.nlength := SizeOf(TSecurityAttributes) ;
Security.lpsecuritydescriptor := nil;
Security.binherithandle := true;
if Createpipe (ReadPipe, WritePipe, @Security, 0) then begin
Buffer := AllocMem(ReadBuffer + 1) ;
FillChar(Start,Sizeof(Start),#0) ;
start.cb := SizeOf(start) ;
start.hStdOutput := WritePipe;
start.hStdError := WritePipe;
start.hStdInput := ReadPipe;
start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
if CreateProcessW(nil,pwidechar(APP),@Security,@Security,true,NORMAL_PRIORITY_CLASS,nil,pwidechar(Directory),start,ProcessInfo) then begin
while not(terminated) do begin
BytesRead := 0;
if Terminated then break;
ReadFile(ReadPipe,Buffer[0], ReadBuffer,BytesRead,nil);
if Terminated then break;
Buffer[BytesRead]:= #0;
if Terminated then break;
OemToAnsi(Buffer,Buffer);
if Terminated then break;
OutputString := Buffer;
if Terminated then break;
Synchronize(SetOutput);
end;
FreeMem(Buffer) ;
CloseHandle(ProcessInfo.hProcess) ;
CloseHandle(ProcessInfo.hThread) ;
CloseHandle(ReadPipe) ;
CloseHandle(WritePipe) ;
end;
end;
end;
function StartConsoleOutput (App : WideString; Directory : WideString; Memo : TMemo) : PConsoleData;
begin
result := VirtualAlloc(NIL, SizeOf(ConsoleData), MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE);
Memo.DoubleBuffered := TRUE;
with PConsoleData(result)^ do begin
OutputMemo := Memo;
OutputApp := App;
OutputDirectory := Directory;
OutputThreadHandle := ConsoleThread.Create(TRUE);
OutputThreadHandle.FreeOnTerminate := TRUE;
OutputThreadHandle.Memo := Memo;
OutputThreadHandle.App := App;
OutputThreadHandle.Directory := Directory;
OutputThreadHandle.Resume;
end;
end;
procedure StopConsoleOutput (Data : PConsoleData);
begin
with PConsoleData(Data)^ do begin
OutputThreadHandle.Terminate;
while not(OutputThreadHandle.Terminated) do sleep (100);
end;
VirtualFree (Data,0, MEM_RELEASE);
end;
end.
我用这个控制台应用程序来测试它(worldserver.exe): https://dl.dropboxusercontent.com/u/349314/Server.rar(编译)
源该项目是在这里: https://github.com/TrinityCore/TrinityCore
在如何编译该项目的指南是在这里: http://archive.trinitycore.info/How-to:Win
要启动worldserver.exe我只是用我自己的单位是这样的:
StartConsoleOutput ('C:\worldserver.exe', 'C:\', Memo1);
应用程序启动罚款只是有几个问题/错误,我不明白:
- 它看起来像输出应用程序(worldserver.exe)的时间需要更长的时间,如果我自己打开它(像3秒延迟)。
- 管道似乎被切换或导致我的delphi应用程序输出错误的方式。 (见截图2)
- 我有服务器(worldserver.exe)完整运行与MySQL(这工作正常),并让它输出在我的delphi应用程序。看起来好像有些零件丢失了,然后突然它输出的东西正在写入控制台。
我该怎么办错了吗?
为什么downvote?有什么不对? – 2013-04-20 21:24:30