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

Question

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

Try this code (Tested en Delphi 2010)

program Project7;

{$APPTYPE CONSOLE}

uses
  Psapi,
  Windows,
  tlhelp32,
  SysUtils;

function GetParentProcess : String;
const
BufferSize=4096;
var
  HandleSnapShot   : THandle;
  EntryParentProc  : TProcessEntry32;
  CurrentProcess   : THandle;
  CurrentProcessId : THandle;
  HandleParentProc : THandle;
  ParentProcessId  : THandle;
  FileTime_CurrentProc: Windows.FILETIME;
  DummyCreateFileTime : Windows.FILETIME;
  DummyExitFileTime   : Windows.FILETIME;
  DummyKernelFileTime : Windows.FILETIME;
  DummyUserFileTime   : Windows.FILETIME;
  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
          CurrentProcess       :=GetCurrentProcess();
          GetProcessTimes(CurrentProcess, DummyCreateFileTime, DummyExitFileTime, DummyKernelFileTime, DummyUserFileTime);
          ParentProcessId      := EntryParentProc.th32ParentProcessID;
          FileTime_CurrentProc := DummyCreateFileTime;
          HandleParentProc     := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ParentProcessId);
          if HandleParentProc <> 0 then
          begin
            if GetProcessTimes(HandleParentProc, DummyCreateFileTime, DummyExitFileTime, DummyKernelFileTime, DummyUserFileTime) then
            begin
              ParentProcessFound := CompareFileTime(DummyCreateFileTime, FileTime_CurrentProc) < 0;
              SetLength(ParentProcPath, BufferSize);
              GetModuleFileNameEx(HandleParentProc, 0, PChar(ParentProcPath), BufferSize);
              ParentProcPath     := PChar(ParentProcPath);
            end;
            CloseHandle(HandleParentProc);
          end;
          break;
        end;
      until not Process32Next(HandleSnapShot, EntryParentProc);
    end;
    CloseHandle(HandleSnapShot);
  end;

  if ParentProcessFound then
   Result := ParentProcPath
  else
   Result := '';
end;


var    
ParentAppName : String    
begin
  try
    ParentAppName:=ExtractFileName(GetParentProcess);

    if AnsiCompareText(ParentAppName, 'cmd.exe') = 0 then
    Writeln('Hello from Command Line')
    Else
    if AnsiCompareText(ParentAppName, 'explorer.exe') = 0 then
    Begin
     Writeln('Hello from Windows Explorer');
     Writeln('Press Enter to close the window');
     Readln;
    End
    Else
    Begin
     Writeln('Hello from '+ParentAppName);
     Writeln('Press Enter to close the window');
     Readln;
    End;



  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Bye.

Answer 2

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.

Answer 3

For a program foo.exe, make a batch file named *foo_runner.bat*. Don't document that command, since it's not intended to be used by name by anyone, but use it as the target of any shortcut icons your installer makes. Its contents will be simple:

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

That %~dp0 part gives the directory where the batch file lives, so you're ensured of running the foo.exe in the batch file's directory instead of grabbing one from some other place on the search path.

Answer 4

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

Answer 5

I use (can't remember where I found it):

function WasRanFromConsole() : Boolean;
var
  SI: TStartupInfo;
begin
  SI.cb := SizeOf(TStartupInfo);
  GetStartupInfo(SI);

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

And then use it as such:

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

Answer 6

Wow Nick, that is really impressive! I have test your solution and works great.

So you can do something like this:

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;

And finally:

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;

Cheers mate!

Erwin Haantjes