I'm open to alternatives.
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