2013-04-20 82 views
1

我想用我自己的单元读取从控制台的控制台输出:德尔福控制台管道切换?

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); 

应用程序启动罚款只是有几个问题/错误,我不明白:

  1. 它看起来像输出应用程序(worldserver.exe)的时间需要更长的时间,如果我自己打开它(像3秒延迟)。
  2. 管道似乎被切换或导致我的delphi应用程序输出错误的方式。 (见截图2)
  3. 我有服务器(worldserver.exe)完整运行与MySQL(这工作正常),并让它输出在我的delphi应用程序。看起来好像有些零件丢失了,然后突然它输出的东西正在写入控制台。

Screenshot1 Screenshot2

我该怎么办错了吗?

+0

为什么downvote?有什么不对? – 2013-04-20 21:24:30

回答

4

最基本的问题是,您已经创建了一个管道,并且使外部进程使用同一管道的两端。管道用于连接两个不同的进程。所以每个过程只应该知道它的一端。

所以想象你想要app1发送信息到app2。创建一个写入结束和读取结束的管道。典型的配置看起来像这样。

app1, stdout --> pipe write end --> pipe read end --> app2, stdin 

这是你会得到什么,如果你在命令解释器中写道

app1 | app2 

但是您已将管道的读取末尾附加到app1 stdin。所以在你的情况下,图是这样的

app1, stdout --> pipe write end --- 
|         | 
|         | 
app1, stdin <-- pipe read end <-- 

这是你的程序中的一个明显的错误。当app1写入它的stdout时,无论它写在它自己的stdin中!绝对不是你想要的。

故事中的额外扭曲是你的应用程序也试图读取管道的读取结束。所以你的应用程序和外部进程都在阅读它。现在,这是一场比赛。谁来说哪一个获得内容?

也许您所需要的只是删除分配hStdInput的行并将其保留为0。

最后一点。写Text := Text + ...效率很低。备忘录的全部内容将被读取和写入。

+0

非常感谢您的支持者。我编辑我的单位,并将每个管道改为个人。现在的问题是,它可能会“卡住”读取错误输出(如果错误输出中没有任何内容)。如何使这个工作首先读取错误 - 如果缓冲区中没有任何内容继续读取stdout?希望你明白我的意思?!就像我自己打开应用程序一样。 – 2013-04-20 17:10:41

+2

您的问题编辑完全改变了问题。我的答案不再有效。我宁愿你将问题还原为原始代码。然后问一个关于你后续问题的新问题。 – 2013-04-20 17:14:18

+0

对不起。我有点迷失在这里。我会开一个新的问题,谢谢。 – 2013-04-20 17:16:13