logo标签列表

如何判断 Delphi 应用程序是否“拥有”其控制台？

delphiconsole-application
8
一个Delphi控制台应用程序可以从现有控制台窗口的命令行中运行，也可以通过双击其图标来运行。在后一种情况下，它将创建自己的控制台窗口，并在应用程序终止时关闭该窗口。
如何判断我的控制台应用程序是否创建了自己的窗口？
我想检测这一点，以便我可以显示一个消息，比如“按Enter键关闭窗口”，让用户在窗口关闭之前阅读显示的内容。显然，如果应用程序是从命令行中运行的，那么这样做是不合适的。
我正在使用Delphi 2010，如果这很重要的话。
1
该应用程序可以在其自己的控制台中运行，并重定向输出，此时您也不应显示该消息。 - mghie
6个回答
8
你基本上需要测试两个方面:

  1. 应用程序控制台是否在进程之间共享？如果你使用cmd.exe运行控制台应用程序，默认情况下它会共享控制台，因此您不需要显示“按Enter关闭窗口”消息。

  2. 输出是否重定向到文件？如果是，则也不必显示该消息。

对于第一个问题，有一个简单的解决方案，就是使用Windows API函数GetConsoleProcessList()。不幸的是，它仅适用于Windows XP及更高版本，但这可能已足够。它不包含在Delphi 2009 Windows单元中，因此您必须自己导入它：
function GetConsoleProcessList(lpdwProcessList: PDWORD;
  dwProcessCount: DWORD): DWORD; stdcall; external 'kernel32.dll';

当然，如果你的软件可以在早期版本的Windows上运行，你应该使用LoadLibrary()和GetProcAddress()代替。
由于您只关心进程句柄数是否大于1，因此可以使用非常小的缓冲区来调用它，例如像这样：
var
  HandleCount: DWORD;
  ProcessHandle: DWORD;
begin
  HandleCount := GetConsoleProcessList(@ProcessHandle, 1);
  // ...
end;

如果您的句柄计数大于1，则表示有其他进程保持控制台处于打开状态，因此可以跳过显示消息。
您可以使用Windows API函数GetFileInformationByHandle()来检查控制台输出句柄是否引用了实际文件。
var
  StdOutHandle: THandle;
  IsNotRedirected: boolean;
  FileInfo: TByHandleFileInformation;
begin
  StdOutHandle := GetStdHandle(STD_OUTPUT_HANDLE);
  IsNotRedirected := not GetFileInformationByHandle(StdOutHandle, FileInfo)
    and (GetLastError = ERROR_INVALID_HANDLE);
  // ...
end;

这段代码只是为了帮助你开始，我相信有一些边角情况没有得到妥善处理。
2
解决了我的问题，也解决了我没有考虑到的问题（重定向输出）。 - Incredulous Monk
5
我过去曾经使用过类似以下内容的东西：

我过去曾经使用过类似以下内容的东西：


program ConsoleTest;
{$APPTYPE CONSOLE}
uses Windows;
function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow';
function IsOwnConsoleWindow: Boolean;
//ONLY POSSIBLE FOR CONSOLE APPS!!!
//If False, we're being called from the console;
//If True, we have our own console (we weren't called from console)
var pPID: DWORD;
begin
  GetWindowThreadProcessId (GetConsoleWindow,pPID);
  Result:= (pPID = GetCurrentProcessId);
end;

开始 写ln（'你好'）; 如果IsOwnConsoleWindow，则开始 写ln（'按回车键关闭控制台'）; readln; 结束; 结束。

简短而精炼... 我喜欢！+1 - Incredulous Monk
2

我知道这是一个旧帖子，但我有一个好的解决方案。

你不必搞乱批处理文件。诀窍在于exe类型，它的子系统属性。将exe编译为GUI应用程序（没有{$APPTYPE CONSOLE}指令），必须将其子系统属性IMAGE_SUBSYSTEM_WINDOWS_GUI更改为IMAGE_SUBSYSTEM_WINDOWS_CUI。好处是当你从控制台执行控制台应用程序时，它不会显示额外的控制台窗口，此时你不需要像“按Enter关闭窗口”这样的消息。编辑：如果你在我的项目中启动另一个控制台应用程序

当你通过单击或start|run从资源管理器等运行它时，Windows会自动打开控制台窗口，当子系统属性为IMAGE_SUBSYSTEM_WINDOWS_CUI时。你不需要指定{$APPTYPE CONSOLE}指令，一切都与子系统属性有关。

RRUZ的解决方案是我也在使用的解决方案，但有一个重要的区别。我检查父进程的子系统以显示“按Enter关闭此窗口”。RUZZ的解决方案只适用于两种情况，即cmd或explorer。只需检查其父进程是否具有属性而不是IMAGE_SUBSYSTEM_WINDOWS_CUI，即可显示消息。

但如何检查exe子系统？我在torry tips（http://www.swissdelphicenter.ch/torry/showcode.php?id=1302）上找到了一个解决方案，以获取PE头信息并将其修改为两个函数：setExeSubSys()和getExeSubSys()。使用setExeSubSys()我制作了一个小型控制台应用程序，以便在编译后更改exe的子系统属性（仅50 kb！）。

在获得父/潜在进程文件名之后，你可以简单地执行以下操作：

    //In the very beginning in the app determine the parent process (as fast as is possible).
// later on you can do:
if( getExeSubSys( parentFilename ) <> IMAGE_SUBSYSTEM_WINDOWS_CUI ) then
 begin
  writeln( 'Press Enter to close the window' );
  readln;
 end;

这是我写的两个函数，但它不能与流一起使用（就像torry示例一样），我使用自己简单的文件单元进行操作，没有繁琐的异常处理。但基本上我认为你已经理解它的思路了。
设置（也适用于当你不指定一个longint指针（nil）时获取）:
type
 PLongInt = ^LongInt;

function setExeSubSys( fileName : string; pSubSystemId : PLongInt = nil ) : LongInt;
var
  signature: DWORD;
  dos_header: IMAGE_DOS_HEADER;
  pe_header: IMAGE_FILE_HEADER;
  opt_header: IMAGE_OPTIONAL_HEADER;
  f : TFile;

begin
 Result:=-1;
 FillChar( f, sizeOf( f ), 0 );
 if( fOpenEx( f, fileName, fomReadWrite )) and ( fRead( f, dos_header, SizeOf(dos_header)))
  and ( dos_header.e_magic = IMAGE_DOS_SIGNATURE ) then
  begin
   if( fSeek( f, dos_header._lfanew )) and ( fRead( f, signature, SizeOf(signature))) and ( signature = IMAGE_NT_SIGNATURE ) then
    begin
     if( fRead( f, pe_header, SizeOf(pe_header))) and ( pe_header.SizeOfOptionalHeader > 0 ) then
      begin
       if( fRead( f, opt_header, SizeOf(opt_header))) then
        begin
         if( Assigned( pSubSystemId )) then
         begin
          opt_header.Subsystem:=pSubSystemId^;
          if( fSeek( f, fPos( f )-SizeOf(opt_header) )) then
           begin
            if( fWrite( f, opt_header, SizeOf(opt_header)) ) then
             Result:=opt_header.Subsystem;
           end;
         end
        else Result:=opt_header.Subsystem;
        end;
      end;
    end;
  end;

 fClose( f );
end;

获取：

function GetExeSubSystem( fileName : string ) : LongInt;
var
  f         : TFile;
  signature : DWORD;
  dos_header: IMAGE_DOS_HEADER;
  pe_header : IMAGE_FILE_HEADER;
  opt_header: IMAGE_OPTIONAL_HEADER;

begin
 Result:=IMAGE_SUBSYSTEM_WINDOWS_CUI; // Result default is console app

 FillChar( f, sizeOf( f ), 0 );

 if( fOpenEx( f, fileName, fomRead )) and ( fRead( f, dos_header, SizeOf(dos_header)))
  and ( dos_header.e_magic = IMAGE_DOS_SIGNATURE ) then
  begin
   if( fSeek( f, dos_header._lfanew )) and ( fRead( f, signature, SizeOf(signature))) and ( signature = IMAGE_NT_SIGNATURE ) then
    begin
     if( fRead( f, pe_header, SizeOf(pe_header))) and ( pe_header.SizeOfOptionalHeader > 0 ) then
      begin
       if( fRead( f, opt_header, SizeOf(opt_header))) then
        Result:=opt_header.Subsystem;
      end;
    end;
  end;

 fClose( f );
end;

如果您想获取更多子系统信息，只需谷歌或访问MSDN网站。 希望这对任何人都有所帮助。
问候， Erwin Haantjes
1
嗨，感谢您这么长时间后的新回答！我以前没有使用子系统属性，但听起来我应该去了解一下。 - Incredulous Monk
2
我使用以下代码（不记得从哪里找到的）：
function WasRanFromConsole() : Boolean;
var
  SI: TStartupInfo;
begin
  SI.cb := SizeOf(TStartupInfo);
  GetStartupInfo(SI);

  Result := ((SI.dwFlags and STARTF_USESHOWWINDOW) = 0);
end;

然后按照以下方式使用：

  if (not WasRanFromConsole()) then
  begin
    Writeln('');
    Writeln('Press ENTER to continue');
    Readln;
  end;
2

哇 Nick，这确实令人印象深刻！我已经测试了你的解决方案，它运行得非常好。

因此，您可以做类似于此的事情：

function isOutputRedirected() : boolean;
var
  StdOutHandle     : THandle;
  bIsNotRedirected : boolean;
  FileInfo         : TByHandleFileInformation;

begin
  StdOutHandle:= GetStdHandle(STD_OUTPUT_HANDLE);
  bIsNotRedirected:=( NOT GetFileInformationByHandle(StdOutHandle, FileInfo)
    and (GetLastError = ERROR_INVALID_HANDLE));
  Result:=( NOT bIsNotRedirected );
end;

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

function GetConsoleSize() : _COORD;
var
  BufferInfo: TConsoleScreenBufferInfo;
begin
  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), BufferInfo);
  Result.x:=BufferInfo.srWindow.Right - BufferInfo.srWindow.Left + 1;
  Result.y:=BufferInfo.srWindow.Bottom - BufferInfo.srWindow.Top + 1;
end;

最后：
var
 cKey : Char;
 fCursorPos  : _COORD;

    if( NOT isOutputRedirected() ) and( NOT isStartedFromConsole() ) then
           begin
             // Windows app starts console.
             // Show message in yellow (highlight) and at the bottom of the window
            writeln;
            fCursorPos:=getConsoleSize();
            Dec( fCursorPos.y );
            Dec( fCursorPos.x, 40 );
            SetConsoleTextAttribute( GetStdHandle(STD_OUTPUT_HANDLE), 14 );
            SetConsoleCursorPosition( GetStdHandle(STD_OUTPUT_HANDLE), fCursorPos );
            write( '<< Press ENTER to close this window >>' );
            read(cKey);
           end;

干杯，伙计！

Erwin Haantjes

1
针对一个名为 foo.exe 的程序，创建一个批处理文件命名为 foo_runner.bat。不要记录该命令，因为它不打算被任何人使用，但可以将其用作安装程序创建的任何快捷图标的目标。其内容将非常简单： 

@echo off
%~dp0\foo.exe %*
pause

%~dp0 这部分提供了批处理文件所在的目录，因此您可以确保在批处理文件所在的目录中运行 foo.exe 而不是从搜索路径上的其他位置获取。

在我的情况下，我想避免批处理文件，但仍然是一个有效的解决方案。+1 - Incredulous Monk
1
@Incredulous Monk：这也不是回答“如何判断Delphi应用程序是否拥有其控制台”的问题，但如果您仅想针对设置创建的图标使用解决方案，并且想避免批处理文件，那么只要存在某个命令行开关，为什么不打印该行并等待一段时间，然后将该开关添加到程序快捷方式图标中呢？ - mghie
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接