delphi - 如何从命令行启动的 GUI 应用程序写入 StdOut？

Question

我正在用 Delphi 7 编写一个标准的 Windows 应用程序。

如果我正在编写控制台应用程序，我可以调用以下命令输出到 cmd 行或输出文件。

writeln('Some info');

如果我从从命令行启动的标准 GUI 应用程序执行此操作，则会收到错误消息。

I/O Error 105

这个问题必须有一个简单的解决方案。基本上我希望我的应用程序有两种模式，一种 GUI 模式和一种非 GUI 模式。如何正确设置它以便我可以写回 cmd 窗口？

Answer 1

这个问题与我试图完成的事情非常相似（如果不完全相同）。我想检测我的应用程序是否从 cmd.exe 执行并将输出发送到父控制台，否则它将显示 gui。这里的答案帮助我解决了我的问题。这是我作为实验提出的代码：

ParentChecker.dpr

program ParentChecker;

uses
  Vcl.Forms,
  SysUtils,
  PsAPI,
  Windows,
  TLHelp32,
  Main in 'Main.pas' {frmParentChecker};

{$R *.res}

function AttachConsole(dwProcessID: Integer): Boolean; stdcall; external 'kernel32.dll';
function FreeConsole(): Boolean; stdcall; external 'kernel32.dll';

function GetParentProcessName(): String;
const
  BufferSize = 4096;
var
  HandleSnapShot: THandle;
  EntryParentProc: TProcessEntry32;
  CurrentProcessId: THandle;
  HandleParentProc: THandle;
  ParentProcessId: THandle;
  ParentProcessFound: Boolean;
  ParentProcPath: String;
begin
  ParentProcessFound:=False;
  HandleSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  if HandleSnapShot<>INVALID_HANDLE_VALUE then
  begin
    EntryParentProc.dwSize:=SizeOf(EntryParentProc);
    if Process32First(HandleSnapShot,EntryParentProc) then
    begin
      CurrentProcessId:=GetCurrentProcessId();
      repeat
        if EntryParentProc.th32ProcessID=CurrentProcessId then
        begin
          ParentProcessId:=EntryParentProc.th32ParentProcessID;
          HandleParentProc:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,ParentProcessId);
          if HandleParentProc<>0 then
          begin
            ParentProcessFound:=True;
            SetLength(ParentProcPath,BufferSize);
            GetModuleFileNameEx(HandleParentProc,0,PChar(ParentProcPath),BufferSize);
            ParentProcPath:=PChar(ParentProcPath);
            CloseHandle(HandleParentProc);
          end;
          Break;
        end;
      until not Process32Next(HandleSnapShot,EntryParentProc);
    end;
    CloseHandle(HandleSnapShot);
  end;
  if ParentProcessFound then Result:=ParentProcPath
  else Result:='';
end;

function IsPrime(n: Integer): Boolean;
var
  i: Integer;
begin
  Result:=False;
  if n<2 then Exit;
  Result:=True;
  if n=2 then Exit;
  i:=2;
  while i<(n div i + 1) do
  begin
    if (n mod i)=0 then
    begin
      Result:=False;
      Exit;
    end;
    Inc(i);
  end;
end;

var
  i: Integer;
  ParentName: String;

begin
  ParentName:=GetParentProcessName().ToLower;
  Delete(ParentName,1,ParentName.LastIndexOf('\')+1);
  if ParentName='cmd.exe' then
  begin
    AttachConsole(-1);
    Writeln('');
    for i:=1 to 100 do if IsPrime(i) then Writeln(IntToStr(i)+' is prime');
    FreeConsole();
  end
  else
  begin
    Application.Initialize;
    Application.MainFormOnTaskbar:=True;
    Application.CreateForm(TfrmParentChecker, frmParentChecker);
    frmParentChecker.Label1.Caption:='Executed from '+ParentName;
    Application.Run;
  end;
end.

Main.pas（带标签的表单）：

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, RzLabel;

type
  TfrmParentChecker = class(TForm)
    Label1: TLabel;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmParentChecker: TfrmParentChecker;

implementation

{$R *.dfm}

end.

这允许我从命令提示符运行我的 GUI 应用程序并将输出显示到启动我的应用程序的同一控制台。否则，它将运行应用程序的完整 GUI 部分。

控制台窗口的示例输出：

I:\Delphi\Tests and Demos\ParentChecker\Win32\Debug>start /wait ParentChecker.exe

2 is prime
3 is prime
5 is prime
7 is prime
11 is prime
13 is prime
17 is prime
19 is prime
23 is prime
29 is prime
31 is prime
37 is prime
41 is prime
43 is prime
47 is prime
53 is prime
59 is prime
61 is prime
67 is prime
71 is prime
73 is prime
79 is prime
83 is prime
89 is prime
97 is prime

I:\Delphi\Tests and Demos\ParentChecker\Win32\Debug>

Answer 2

调用AllocConsole以避免错误 105。

Answer 3

GUI 子系统应用程序没有可靠的方法连接到其父进程的控制台。如果您尝试这样做，您最终会得到两个共享同一个控制台的活动进程。这会导致无穷无尽的麻烦。

正如 bummi 所建议的那样，在只保留一个可执行文件的同时，另一种方法是拥有一个控制台应用程序，如果它被要求在 GUI 模式下运行，它会释放其控制台。这是一种更好的方法，但是当您想在 GUI 模式下运行时，会导致控制台窗口闪烁，然后关闭。

我在 Stack Overflow 上遇到的关于该主题的最佳讨论是 Rob Kennedy 的出色回答：一个可执行文件可以同时是控制台和 GUI 应用程序吗？

我相信，根据您在评论中所说的，对您来说最好的选择是创建两个单独的可执行文件。一个用于 GUI 子系统，一个用于控制台子系统。这是采取的方法：

• Java：java.exe、javaw.exe。
• Python：python.exe、pythonw.exe。
• Visual Studio：devenv.com、devenv.exe。

是的，您必须发布多个可执行文件。但这样做会给用户最好的体验。

Answer 4

我不太确定您要达到的目标。
据我了解，问题的一种方法可能是

program Project1;
{$APPTYPE CONSOLE}

uses
  Forms, Classes, Windows,
  Unit1 in 'Unit1.pas' { Form1 } ;
{$R *.res}

var
  Finished: Boolean;
  Input: String;

function IsConsoleMode(): Boolean;
var
  SI: TStartupInfo;
begin
  SI.cb := SizeOf(TStartupInfo);
  GetStartupInfo(SI);
  Result := ((SI.dwFlags and STARTF_USESHOWWINDOW) = 0);
end;

procedure HandleInput;
begin
  Finished := Input = 'quit';
  if not Finished then
  begin
    Writeln('Echo: ' + Input);
  end
  else
    Writeln('Bye');
end;

begin
  if IsConsoleMode then
  begin
    Finished := false;
    Writeln('Welcome to console mode');
    while not Finished do
    begin
      readln(Input);
      HandleInput;
    end;
  end
  else
  begin
    Writeln('Entering GUI Mode');
    FreeConsole;
    Application.Initialize;
    Application.MainFormOnTaskbar := True;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end;

end.

Answer 5

FWIW，我解决了这个问题，偶然发现了AttachConsole，这似乎可以解决问题。我在代码中遇到的唯一问题是，如果没有额外的一两个 ENTER 键，程序不会放弃控制台。因为我试图解决这个问题并且（有点）放弃了，所以它并不是真正的完美。也许这里有人会看到它？

program writecon; uses windows, dialogs;

  function AttachConsole(dwProcessID: DWord): BOOL; stdcall; external 'kernel32.dll';

  function load_attach_console: boolean;
    begin
      Result := AttachConsole(-1);
    end;

  begin
    // the function requires XP or greater, you might want to check for that here.
    if load_attach_console = true then
      begin
        writeln;
        writeln('This is running in the console.');
        write('Press ENTER to continue.');
        readln;
        // from the linked page, you have to detach yourself from the console
        // when you're done, this is probably where the problem is.
        Flush(Output);
        Flush(Input);
        FreeConsole;
      end
    else
      MessageDlg('This is not running in the console.', mtInformation, [mbOk], 0);
  end.

Answer 6

我发现这篇关于整个问题的非常完整的文章：http: //www.boku.ru/2016/02/28/posting-to-console-from-gui-app/

我做了一个单元来执行 AttachConsole，挂钩异常处理程序以将消息镜像到控制台。

要使用它，您只需要在代码中调用 ATTACH。最好附加一个命令行选项，例如 -console

if FindCmdLineSwitch('console',true) then AttachConsole(true,true);

这是一个 gui 应用程序，使用它时，您必须使用 START /W 来启动您的程序，如果您希望它在命令行/批处理上阻塞，例如start /w myprogram.exe -console

一个方便的好处是，如果需要，您可以使用控制台独立启动它，并在控制台中查看所有错误消息。

unit ConsoleConnector;
// Connects the/a console to a GUI program
// Can hook exception handler to mirror messages to console.
// To use it, you only need to call ATTACH
// best to make attaching a commandline option e.g -console
//    if FindCmdLineSwitch('console',true) then AttachConsole(true,true);
// When using this, you will use START to launch your program e.g.
// start /w myprogram.exe -console
// creates Console var at end in initialise/finalise - you might want to do this explicitly in your own program instead.
// see: http://www.boku.ru/2016/02/28/posting-to-console-from-gui-app/

//sjb 18Nov16

interface
uses sysutils,forms;

type
  TConsoleConnector = class
  private
    OldExceptionEvent:TExceptionEvent;
    Hooked:boolean;
    BlockApplicationExceptionHandler:boolean; //errors ONLY to console, no error messageboxes blocking program
    procedure DetachErrorHandler;
    procedure GlobalExceptionHandler(Sender: TObject; E: Exception);
    procedure HookExceptionHandler;
  public
    IsAttached:boolean;

    function Attach(
        CreateIfNeeded:boolean=true; //Call ALLOCCONSOLE if no console to attach to
        HookExceptions:boolean=false;  //Hook Application.OnException to echo all unhandled exceptions to console
        OnlyToConsole:boolean=false  // Suppresses exception popups in gui, errors only go to console
        ):boolean;
    procedure Detach;            //detach and unhook
    procedure writeln(S:string); //only writes if console is attached
    procedure ShowMessage(S:string); //Popup ShowMessage box and mirror to console. Obeys OnlyToConsole
  end;

  var Console:TConsoleConnector;

implementation

uses Windows,dialogs;

//winapi function
function AttachConsole(dwProcessId: Int32): boolean; stdcall; external kernel32 name 'AttachConsole';

function TConsoleConnector.Attach(CreateIfNeeded:boolean=true;HookExceptions:boolean=false;OnlyToConsole:boolean=false):boolean;
begin
  IsAttached:=AttachConsole(-1);
  if not IsAttached and CreateIfNeeded
    then begin
      IsAttached:=AllocConsole;
    end;
  result:=IsAttached;
  if HookExceptions then HookExceptionHandler;
end;

procedure TConsoleConnector.Detach;
begin
  FreeConsole;
  IsAttached:=false;
  DetachErrorHandler;
end;

procedure TConsoleConnector.WriteLn(S:string);
begin
  if IsAttached then system.writeln(S);
end;
procedure TConsoleConnector.ShowMessage(S:string);
begin
  self.Writeln(S);
  if BlockApplicationExceptionHandler then exit;
  dialogs.ShowMessage(S);
end;
procedure TConsoleConnector.GlobalExceptionHandler(Sender: TObject; E: Exception);
begin
  self.Writeln(E.Message);
  if BlockApplicationExceptionHandler then exit;
  if assigned(OldExceptionEvent) //i.e there was an old event before we hooked it
    then OldExceptionEvent(Sender,E)
    else Application.ShowException(E);
end;

procedure TConsoleConnector.HookExceptionHandler;
begin
  OldExceptionEvent:=Application.OnException;
  Application.OnException:=GlobalExceptionHandler;
  Hooked:=true;
end;

procedure TConsoleConnector.DetachErrorHandler;
begin
  if Hooked //I have hooked it
    then begin
      Application.OnException:=OldExceptionEvent;
      OldExceptionEvent:=nil;
      Hooked:=false;
    end;
end;

initialization
  Console:=TconsoleConnector.create;
finalization
  Console.Detach;
  Console.Destroy;
end.

Answer 7

AttachConsole 似乎确实有效，如上所述，它等待 ENTER。

但是，就 dos 所见，该程序仍然是 win prog 而不是控制台程序，因此 cmd 在启动后继续执行下一个命令。

test.exe & dir

首先显示目录列表，然后是 test.exe 的输出

start /w test.exe & dir 

确实有效，并且不会因为 ENTER 键而暂停

顺便说一句，上面的建议： PostMessage(GetCurrentProcess,$0101,$0D,0); ENTER，但发出一声巨响。

Answer 8

我也在一份带有​​运行脚本的报告中总结了这个主题：

http://www.softwareschule.ch/download/maxbox_starter70.pdf 作为第二个备份：

https://www.slideshare.net/maxkleiner1/nogui-maxbox-starter70

主程序有一个 nativewriteline 与 writeline 分开：

 for it:=1 to 50 do if IsPrime(it) then NativeWriteln(IntToStr(it)+' is prime');