Beiträge von UEZ

#Include "win\shlobj.bi"
#Include "win\tlhelp32.bi"
#Include "windows.bi"

Function _WinAPI_GetBinaryType(sFilename As String) As DWORD
    Dim As DWORD lpBinaryType
    If GetBinaryTypeW(sFilename, @lpBinaryType) = 0 Then Return -1 'https://learn.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-getbinarytypew
    Return lpBinaryType
End Function

Function _WinAPI_FindFile(sPath As String, sFilename As String) As String
    Dim As WIN32_FIND_DATA FindFileData
    Dim As HANDLE hFind
    Static As String sFile, sTmp
    hFind = FindFirstFile(sPath, @FindFileData)
    If hFind = INVALID_HANDLE_VALUE Then Return ""
    While FindNextFile(hFind, @FindFileData) <> 0
        If FindFileData.cFileName <> ".." Then
            If (FindFileData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then Return _WinAPI_FindFile(Left(sPath, InStrRev(sPath, "\")) & FindFileData.cFileName & "\*", sFilename)
            sTmp = Rtrim(sPath, "*") & sFilename
            Dim As Dword lpBinaryType = _WinAPI_GetBinaryType(sTmp) 
            If FindFileData.cFileName = sFilename And (lpBinaryType = 6 Or lpBinaryType = 0) Then sFile = sTmp
        Endif
    Wend
    
    FindClose(hFind)
    Return sFile
End Function

Function _WinAPI_IsOSx86() As Boolean 'https://learn.microsoft.com/en-us/windows/win32/api/sysinfoapi/nf-sysinfoapi-getnativesysteminfo?redirectedfrom=MSDN
    Dim As SYSTEM_INFO lpSystemInfo
    GetNativeSystemInfo(@lpSystemInfo)
    Return lpSystemInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_INTEL
End Function

Function _WinAPI_GetParentProcess(iPID As Integer = 0) As Integer
    Dim As DWORD pid = Iif(iPID = 0, GetCurrentProcessId(), iPID), pid_parent = 0
    Dim As HANDLE hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    Dim As PROCESSENTRY32 tPROCESSENTRY32
    tPROCESSENTRY32.dwSize = Sizeof(tPROCESSENTRY32)
    Process32First(hSnapshot, @tPROCESSENTRY32)
    While TRUE
        If tPROCESSENTRY32.th32ProcessID = pid Then
            pid_parent = tPROCESSENTRY32.th32ParentProcessID
            Exit While
        End If
        Process32Next(hSnapshot, @tPROCESSENTRY32)
    Wend
    CloseHandle(hSnapshot)
    Return pid_parent
End Function

Function _WinAPI_GetProcessName(iPid As DWORD) As String
    Dim As HANDLE hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, iPid)
    If hSnapshot = 0 Then Return ""
    Dim As PROCESSENTRY32W tPROCESSENTRY32W
    tPROCESSENTRY32W.dwSize = Sizeof(PROCESSENTRY32W)
    Process32FirstW(hSnapshot, @tPROCESSENTRY32W)
    While True
        If tPROCESSENTRY32W.th32ProcessID = iPid Then Exit While
        If Process32NextW(hSnapshot,  @tPROCESSENTRY32W) = 0 Then Exit While
    Wend
    CloseHandle(hSnapshot)
    Return tPROCESSENTRY32W.szExeFile
End Function

Function _WinAPI_TerminateProcess(iPID As Integer, iExitCode As Integer = 0, bInheritHandle As Boolean = True) As Boolean
    Dim As Long dwDesiredAccess = PROCESS_TERMINATE
    Dim As Handle hProcess = OpenProcess(dwDesiredAccess, bInheritHandle, iPID)
    If hProcess = Null Then Return False
    TerminateProcess(hProcess, iExitCode)
    CloseHandle(hProcess)
    Return True
End Function

Sub GetCommandLineArguments(Byref sArguments As String)
    Dim As Ubyte i = 1
    Dim As String s
    While True
        s = Command(i)
        If Len(s) = 0 Then Exit While
        sArguments &= s & " "
        i += 1
    Wend
End Sub

Sub SetConsoleSize(cols As Long, lines As Long)
    Shell "MODE CON: COLS=" + Str(cols) + "LINES=" + Str(lines)
End Sub

    
Declare Function RtlGetVersion Lib "NtDll.dll" Alias "RtlGetVersion" (OsVersionInformation As RTL_OSVERSIONINFOW) As Long

Dim As RTL_OSVERSIONINFOW OS
OS.dwOSVersionInfoSize = Sizeof(RTL_OSVERSIONINFOW)
RtlGetVersion(OS)

Dim Shared As HWND hConsole
Dim As Handle hStdOut, hStdIn

AllocConsole()

hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)
hStdIn = GetStdHandle(STD_INPUT_HANDLE)
hConsole = GetConsoleWindow()
SetConsoleSize(80, 15)

Dim As Integer iStyle = GetWindowLong(hConsole, GWL_STYLE)

Dim As Wstring * 4096 sClassname
GetClassNameW(hConsole, @sClassname, 4096)

Dim As String sArguments = " "
GetCommandLineArguments(sArguments)

'Restert exe if it is in a Terminal Window
If (SendMessageW(hConsole, WM_GETICON, Iif(OS.dwBuildNumber < 9200, 1, 0), 0) = 0 And sClassname = "PseudoConsoleWindow") And Command(1) <> "restart" Then 'restart app in CMD window
    #ifdef __FB_64BIT__
        Shell("conhost.exe """ &  Command(0) & """ restart" & sArguments)
    #Else
        If _WinAPI_IsOSx86() = False Then
            Dim As String sConhost = _WinAPI_FindFile("C:\Windows\WinSxS\amd64_microsoft-onecore-console-host-core_*", "conhost.exe")
            'If sConhost <> "" Then Shell("""" & sConhost & """" & " """ & Command(0) & """ restart" & sArguments)
            If sConhost <> "" Then 
                Shell(sConhost & " """ & Command(0) & """ restart" & sArguments)
            Else
                ? "Couldn't find conhost.exe"
                Sleep
            Endif
        Else
            Shell("conhost.exe """ &  Command(0) & """ restart" & sArguments)
        Endif
    #endif 
    FreeConsole()
    End 1000
Endif

If Command(1) = "restart" Then
    Dim As String exeName = Mid(Command(0), Instrrev(Command(0), "/") + 1, Len(Command(0)))
    Dim As Ubyte countParentPIDs = 0
    Dim As Integer iPID, parentPID = _WinAPI_GetParentProcess()
    While True
        iPID = _WinAPI_GetParentProcess(parentPID)
        If _WinAPI_GetProcessName(iPID) <> "cmd.exe" Then 
            parentPID = iPID
            countParentPIDs += 1
            If countParentPIDs > 5 Then Exit While
        Else
            _WinAPI_TerminateProcess(iPID, 0, True)
            Exit While
        Endif
    Wend
Endif


Dim As CONSOLE_FONT_INFO tFontInfo
GetCurrentConsoleFont(hStdOut, False, @tFontInfo)
Dim As COORD tFonts = GetConsoleFontSize(hStdOut, tFontInfo.nFont)


Dim Shared As Integer iOldStyle
iOldStyle = GetWindowLong(hConsole, GWL_STYLE)
SetWindowLong(hConsole, GWL_STYLE, iOldStyle And Not WS_MAXIMIZEBOX And Not WS_VSCROLL And Not WS_HSCROLL) 'Not WS_SIZEBOX And

Dim Shared As LONG_PTR g_OldWndProc

Function WindowProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
    Select Case uMsg
        Case WM_CLOSE
            PostQuitMessage(0)
        Case WM_WINDOWPOSCHANGING
            Dim As WINDOWPOS Ptr tWinPos
            tWinPos = Cast(WINDOWPOS Ptr, lParam)
            ? tWinPos->cx, tWinPos->cy
            Return 0
    End Select
    ? hWnd, hConsole, uMsg
    Return CallWindowProc(Cast(WNDPROC, g_OldWndProc), hwnd, uMsg, wParam, lParam)
End Function

g_OldWndProc =  SetWindowLongPtr(hConsole, GWLP_WNDPROC, Cast(LONG_PTR, @WindowProc))

? g_OldWndProc

Dim msg As MSG

While GetMessage(@msg, 0, 0, 0)
    TranslateMessage(@msg)
    DispatchMessage(@msg)
Wend
SetWindowLongPtr(hCOnsole, GWLP_WNDPROC, Cast(LONG_PTR, @g_OldWndProc))
FreeConsole()