PureBasic Forums - English

Code: Select all

EnableExplicit

; -- Next 3 elements (structure,macro, procedure) are not my work, taken from https://www.purebasic.fr/english/viewtopic.php?f=3&t=51354 --
Structure CONSOLE_COORD
  StructureUnion
    coord.COORD
    long.l
  EndStructureUnion
EndStructure
Macro ConsoleHandle_() : GetStdHandle_( #STD_OUTPUT_HANDLE )  : EndMacro
Procedure ConsoleDeletePrevLines( CountLines = 1 )
   Protected ConsoleBufferInfo.CONSOLE_SCREEN_BUFFER_INFO
   Protected hConsole
   Protected location.CONSOLE_COORD
   
   If CountLines < 1 : ProcedureReturn #False : EndIf
   
   hConsole = ConsoleHandle_()
   GetConsoleScreenBufferInfo_( hConsole, @ConsoleBufferInfo )
   
   With location
     \coord\x = 0
     \coord\y = ConsoleBufferInfo\dwCursorPosition\y
     While CountLines And \coord\y
        \coord\y - 1
        SetConsoleCursorPosition_( hConsole, \long )
        Print( Space(ConsoleBufferInfo\dwSize\x) )
        If CountLines = 1
           SetConsoleCursorPosition_( hConsole, \long )
        EndIf
        CountLines - 1
     Wend
   EndWith 
   
   ProcedureReturn #True
 EndProcedure
 ; -- end not my work --
 
Import "kernel32.lib"
  AttachConsole( processID )
EndImport

Enumeration
  #ParentInfoPID
  #ParentInfoName
EndEnumeration

Procedure.s GetParentInfo(GetWhat, MyPid = 0 )
  Protected lppe.PROCESSENTRY32
  Protected hSnap = CreateToolhelp32Snapshot_(#TH32CS_SNAPPROCESS , 0)
  Static ParentPID, ParentName.s
  Protected.s ReturnInfo
  
  If ParentName = ""
    If MyPid = 0 
      MyPid = GetCurrentProcessId_()
    EndIf
    
    If hSnap <> #INVALID_HANDLE_VALUE
      lppe\dwSize = SizeOf(PROCESSENTRY32)
      If Process32First_(hSnap, @lppe)
          Repeat        
              If lppe\th32ProcessID = mypid 
                  ParentPID = lppe\th32ParentProcessID
                  Debug "my parent pid is = " + Str(ParentPID)
                  Break
              EndIf    
          Until Process32Next_(hSnap, @lppe) = 0
      EndIf        
  
      If Process32First_(hSnap, @lppe)
          Repeat        
            If lppe\th32ProcessID = ParentPID    
              ParentName = PeekS(@lppe\szExeFile[0])
                Debug "and its name is = " + ParentName
                Break
              EndIf    
          Until Process32Next_(hSnap, @lppe) = 0
      EndIf        
    EndIf
  EndIf
  
  Select GetWhat 
    Case #ParentInfoName
      ReturnInfo = ParentName
    Case #ParentInfoPID
      ReturnInfo = Str(ParentPID)
  EndSelect
  ProcedureReturn ReturnInfo
EndProcedure

Procedure _OpenConsole_()
  Protected hcmdpid = Val(GetParentInfo(#ParentInfoPID))  ; Get PID for existing cmd.exe
  Protected hConsoleID = AttachConsole(hCMDpid) 
  If hConsoleID
    ConsoleDeletePrevLines()
  EndIf 
  ProcedureReturn hConsoleID
EndProcedure
Macro IsConsole() : Bool(LCase(GetParentInfo(#ParentInfoName))="cmd.exe") : EndMacro

; for some reason, native PB console print functions don't work, but input does.
Procedure _Print_( PrintString.s)
  Protected bytesWritten
        
  WriteConsole_(ConsoleHandle_(), PrintString, Len(PrintString), @bytesWritten, 0)
  OutputDebugString_("Bytes written "+Str(bytesWritten))
EndProcedure

;- Macros to make use of some conventional console functions.
Macro PrintN( printString ) : _Print_( printString+#CRLF$ ) : EndMacro
Macro Print( printString) : _Print_(printstring) : EndMacro
Macro OpenConsole() : _OpenConsole_() : EndMacro
Macro CloseConsole() : FreeConsole_() : EndMacro

;- Example.
CompilerIf #PB_Compiler_IsMainFile
  If IsConsole() ; if parent is a command / console window
    If OpenConsole()
      PrintN("This is just some text...")
      PrintN("Hi - press 'enter' to finish exe")
      
      Input() 
      
      CloseConsole() 
    Else ; An error occured, shouldn't get here.
      Debug "Failed to attach to console"
      MessageRequester("Error","Failed to attach to a parent console",#PB_MessageRequester_Error)
    EndIf
  Else ; Program being run as a windows program
    OutputDebugString_("program run from "+GetParentInfo(#ParentInfoName))
    MessageRequester("Windows App","This was NOT run from a command prompt",#PB_MessageRequester_Info)
  EndIf

CompilerEndIf