如何判断一个Delphi应用程序“拥有”它的控制台？(How to tell if a Delphi

2019-08-16 22:14发布

站内文章 / 前端开发

24 0

女 | 书童

私信

A Delphi console application can be run from the command line of an existing console window, and it can be run by double-clicking on its icon. In the latter case it will create its own console window, and close it once the application terminates.

How can I tell if my console application has created its own window?

I want to detect this so that I can display a message like "Press Enter to close the window", to let the user read what's displayed before the window closes. Obviously, it wouldn't be appropriate to do that if the application is being run from the command line.

I'm using Delphi 2010, in case that's significant.

Answer 1:

你已经基本上两件事情来测试：

是应用程序控制台进程间共享？如果你使用cmd.exe运行每默认共享一个控制台应用程序它将控制台，这样你就不会需要显示“按Enter键关闭窗口”的消息。
是输出重定向到一个文件？如果是这样，没有必要要么显示消息。

对于第一个有在的形式的简单解决方案GetConsoleProcessList() Windows API函数。遗憾的是仅适用于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，你有其他进程保持控制台打开，这样你就可以跳过显示该消息。

您可以使用GetFileInformationByHandle() Windows API函数来检查您的控制台输出句柄是否引用了一个真正的文件或不：

var
  StdOutHandle: THandle;
  IsNotRedirected: boolean;
  FileInfo: TByHandleFileInformation;
begin
  StdOutHandle := GetStdHandle(STD_OUTPUT_HANDLE);
  IsNotRedirected := not GetFileInformationByHandle(StdOutHandle, FileInfo)
    and (GetLastError = ERROR_INVALID_HANDLE);
  // ...
end;

这段代码的目的是让你才开始，我敢肯定有不妥善处理一些极端情况。

Answer 2:

我用的东西，如低于过去：

 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; 
   开始writeln（ '你好'）;  如果IsOwnConsoleWindow然后开始writeln（“按ENTER键关闭控制台”）;  readln;  结束;  结束。

Answer 3:

我知道，这是一个古老的线程，但我有一个很好的解决了这个。

您不必更动批处理文件。诀窍是exe文件的类型，它的子系统属性。编译EXE的GUI应用程序（不{$ APPTYPE CONSOLE}指令后，必须改变它的子系统属性IMAGE_SUBSYSTEM_WINDOWS_GUI到IMAGE_SUBSYSTEM_WINDOWS_CUI。好处是当你从一个控制台执行控制台应用程序，它并没有显示出额外的控制台窗口，并在这一点你不需要的消息，如“按Enter键关闭窗口” 编辑：如果你启动另一个控制台应用程序控制台应用程序里面就像我在我的一个项目一样）

当您通过单击或开始从资源管理器等运行|运行，在Windows打开一个全自动控制台窗口当子系统属性是IMAGE_SUBSYSTEM_WINDOWS_CUI。你并不需要指定{$ APPTYPE CONSOLE}指令，它是所有关于子系统属性。

RRUZ的解决方案是我也用，但有一个重要区别的解决方案。我检查父进程的子系统，以显示“按Enter键关闭此窗口”。 RUZZ它的解决方案仅适用于两种情况，当它是CMD或资源管理器。通过简单的检查，如果它的父进程具有属性不是IMAGE_SUBSYSTEM_WINDOWS_CUI，可以显示该消息。

但是，如何检查的exe子系统？我发现托里提示（解决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;

这里有两个功能我做，但它不与工作流（如托里例子），我用我自己的方便单位为它文件，而不傻exeption东西。但基本上我想你周围的想法。

要设置（也获得当你不指定指针成Longint（无））：

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网站。希望这是有帮助的人。

格尔茨，欧文Haantjes

Answer 4:

我使用（不记得在那里我发现它）：

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;

Answer 5:

哇尼克，这是真是令人印象深刻！我测试的解决方案和伟大工程。

所以，你可以这样做：

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;

队友的欢呼声！

欧文Haantjes