Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to tell if a Delphi app "owns" its console?

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.

like image 229
Incredulous Monk Avatar asked Sep 27 '09 02:09

Incredulous Monk


3 Answers

You have basically two things to test for:

  1. Is the application console shared between processes? If you use cmd.exe to run a console application it will per default share the console, so you won't need to show the "Press Enter to close the window" message.

  2. Is the output redirected to a file? If so it's not necessary to show the message either.

For the first one there is a simple solution in form of the GetConsoleProcessList() Windows API function. Unfortunately it is available only on Windows XP and later versions, but maybe that's good enough for you. It's not in the Delphi 2009 Windows unit, so you will have to import it yourself:

function GetConsoleProcessList(lpdwProcessList: PDWORD;
  dwProcessCount: DWORD): DWORD; stdcall; external 'kernel32.dll';

Of course, if your software is otherwise able to run on earlier Windows versions you should use LoadLibrary() and GetProcAddress() instead.

Since you are only interested in whether the number of process handles is higher than 1 you can call it with a very small buffer for the handles, for example like this:

var
  HandleCount: DWORD;
  ProcessHandle: DWORD;
begin
  HandleCount := GetConsoleProcessList(@ProcessHandle, 1);
  // ...
end;

If your handle count is larger than 1 you have other processes keeping the console open, so you can skip showing the message.

You can use the GetFileInformationByHandle() Windows API function to check whether your console output handle references a real file or not:

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

This code is intended to get you started only, I'm sure there are some corner cases not handled properly.

like image 63
mghie Avatar answered Nov 04 '22 07:11

mghie


I've used something like the below in the past:


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;

begin writeln ('Hello '); if IsOwnConsoleWindow then begin writeln ('Press enter to close console'); readln; end; end.

like image 33
PhiS Avatar answered Nov 04 '22 06:11

PhiS


I know, this is a old thread but i have a nice solution to this.

You don't have to mess around with batch files. The trick is in the type of exe, it's subsystem attribute. After compiling the exe as GUI application (without the {$APPTYPE CONSOLE} directive, you must change it's subsystem attribute IMAGE_SUBSYSTEM_WINDOWS_GUI to IMAGE_SUBSYSTEM_WINDOWS_CUI. Nice thing is when you execute the console app from a console it doesn't show an extra console window and at that point you don't need a message like "Press Enter to close the window". EDIT: In case you starting another console app inside a console app like i did in a project of mine)

When you run it from explorer etc by clicking it or by start|run, Windows opens automaticly a console window when the subsystem attribute is IMAGE_SUBSYSTEM_WINDOWS_CUI. You don't need to specify {$APPTYPE CONSOLE} directive, it's all about the subsystem attribute.

The solution of RRUZ is a solution i also using but with one important difference. I check the subsystem of the parent process to show a "Press Enter to close this window". RUZZ it's solution only works in two cases, when it is cmd or explorer. By simply check if it's parent process has the attribute is NOT IMAGE_SUBSYSTEM_WINDOWS_CUI, you can display the message.

But how to check the exe subsystem? I found a solution on torry tips (http://www.swissdelphicenter.ch/torry/showcode.php?id=1302) to get the PE Header info and modify it into two functions: setExeSubSys() and getExeSubSys(). With the setExeSubSys() i made a little console app so that i can change the exe's subsystem attribute after compiling (it is only 50 kb!).

After you have the parent/potential process filename, you can simply do something like this:

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

Here are the two functions i made but it is not working with streams (like the torry example), i use my own easy unit for files for it without the silly exeption stuff. But basically i think you get the idea around it.

To set (and also to get when you not specifying a pointer to a 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;

To get:

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;

If you want more info at the subsystem, just google or go to the MSDN website. Hope it was helpful to anyone.

Greetz, Erwin Haantjes

like image 25
Erwinus Avatar answered Nov 04 '22 06:11

Erwinus