PowerBASIC Peer Support Forums
 

Go Back   PowerBASIC Peer Support Forums > User to user Discussions > Source Code

Source Code PowerBASIC and related source code. Please do not post questions or discussions, just source code.

Reply
 
Thread Tools Display Modes
  #1  
Old Apr 13th, 2012, 06:53 PM
Yuzree Esmera Yuzree Esmera is offline
Member
 
Join Date: Sep 2004
Location: Kuala Lumpur, Malaysia
Posts: 48
ConsoleInit - Make PBCC work with API Consoles; Attach Consoles! CON.NEW in PBCC 5!

Okay, so you don't really get the "CON.NEW" object/method in PBCC 5, but you can implement an identical equivalent . See the demo program below for an example.

ConsoleInit makes API consoles compatible with PBCC's built-in instructions.

Now you can easily implement AllocConsole & AttachConsole (Windows XP or later only) in your PBCC 5 or PBCC 6 code without leaving the comfort of PBCC's convenient intrinsic functions. All you need is a single call to ConsoleInit after you've allocated or attached the console to your process and it will take care of the rest

Discussion is HERE.

Here's ConsoleInit:
Code:
SUB ConsoleInit ()
    '
    ' v1.00 by Yuzree Esmera
    ' Requires Windows 2000 or later, PBCC 5 or later.
    '
    ' Initializes the current Console for use with PBCC.
    '
    ' Since the WIN32API.INC (dated 23 April 2010) shipped with PBCC 5.05
    ' doesn't include declarations for "GetConsoleWindow", this needs to be
    ' declared in your code for ConsoleInit to work.

    REGISTER x&
    LOCAL pIDH AS IMAGE_DOS_HEADER PTR, pNTH AS IMAGE_NT_HEADERS PTR
    LOCAL dwBase???, bSects?, zName AS ASCIZ * 9

    'Unicode support
    #IF %DEF (%UNICODE)
        LOCAL zTmp AS WSTRINGZ * 8
    #ELSE
        LOCAL zTmp AS ASCIZ * 8
    #ENDIF

    'Get module handle
    pIDH = GetModuleHandle (BYVAL 0&)

    'Exit if unsuccessful
    IF pIDH = 0& THEN EXIT SUB

    'Get address of PE image
    pNTH = pIDH + @pIDH.e_lfanew
    dwBase??? = @pNTH.OptionalHeader.ImageBase

    'Get number of sections in PE
    bSects? = @pNTH.FileHeader.NumberOfSections

    'Overlay IMAGE_SECTION_HEADER array immediately after PE header
    DIM ISH (1? TO bSects?) AS IMAGE_SECTION_HEADER AT pNTH + _
                            @pNTH.FileHeader.SizeOfOptionalHeader + 24&

    'Get address of ".data" section from Section Table
    FOR x& = 1& TO bSects?
        zName = LCASE$(PEEK$(VARPTR(ISH(x&)), 8&)) 'ISH(x&).Name
        IF zName = ".data" THEN
            dwBase??? += ISH(x&).VirtualAddress
            RESET bSects?
            EXIT FOR
        END IF
    NEXT

    'Exit if ".data" Section not found
    IF bSects? THEN EXIT SUB

    'Free orphaned console input handle
    CloseHandle (BYVAL GETSTDKBD)

    'Update stored window handle / CONSHNDL
    POKE DWORD, dwBase??? + IIF&(%PB_REVISION < &H600, &H2A0, &H3DC), GetConsoleWindow ()

    'Overlay array on internal PBCC structure
    DIM CCInit (1& TO 7&) AS LONG AT dwBase??? + IIF&(%PB_REVISION < &H600, &H664, &H980)

    'Update PBCC structure with valid info
    CCInit& (7&) = GetStdHandle (BYVAL %STD_OUTPUT_HANDLE) ' GETSTDOUT
    CCInit& (6&) = GetStdHandle (BYVAL %STD_INPUT_HANDLE)  ' GETSTDIN
    CCInit& (5&) = GetStdHandle (BYVAL %STD_ERROR_HANDLE)  ' GETSTDERR

    'Open new console input handle
    zTmp = "CONIN$"
    CCInit& (3&) = CreateFile (BYVAL VARPTR(zTmp), _       ' GETSTDKBD
                               BYVAL %GENERIC_READ, _
                               BYVAL %FILE_SHARE_READ, BYVAL 0&, _
                               BYVAL %OPEN_EXISTING, BYVAL 0&, BYVAL 0&)

    CCInit& (2&) = IIF&(GetConsoleMode(BYVAL CCInit& (7&), BYVAL VARPTR(dwBase???)), -1&, 0&) ' CONSOUT
    CCInit& (1&) = IIF&(GetConsoleMode(BYVAL CCInit& (6&), BYVAL VARPTR(dwBase???)), -1&, 0&) ' CONSIN
    CCInit& (4&) = IIF&(CCInit& (2&), CCInit& (7&), CCInit& (5&)) 'hConsoleOutput for API wrappers
END SUB
The Demo comes in two flavors - the full one which includes implementation examples for both AllocConsole and AttachConsole, and a Windows 2000 version which excludes AttachConsole.

Here's the Full Demo:
Code:
'------------------------------------------------------------------------------
'   ** Metastatements **
'------------------------------------------------------------------------------
#TOOLS ON
#DEBUG DISPLAY ON
#DEBUG ERROR ON

#OPTION VERSION5
#COMPILER PBCC 5, PBCC 6

#COMPILE EXE "ConsoleInit.exe"
#DIM ALL

'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
'Declare Unicode on PBCC 6
#IF %PB_REVISION => &H600
    %UNICODE = 1&
#ENDIF
#INCLUDE ONCE "Win32API.inc"

'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Declarations **
'------------------------------------------------------------------------------
DECLARE FUNCTION GetConsoleWindow LIB "KERNEL32.DLL" ALIAS "GetConsoleWindow" _
                 () AS DWORD
DECLARE FUNCTION AttachConsole LIB "KERNEL32.DLL" ALIAS "AttachConsole" _
                 (BYVAL dwProcessId AS DWORD) AS LONG

'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Subs **
'------------------------------------------------------------------------------

SUB ConsoleResizeEx (OPT BYVAL WColumns??, BYVAL WRows??, BYVAL BColumns??, BYVAL BRows??, BYVAL hBuffer&)
    '
    ' v1.03 by Yuzree Esmera
    ' Requires Windows 2000 or later, PBCC 5 or later.
    '
    ' Resizes a Screen Buffer and/or it's associated Window according to the
    ' specified dimensions.
    '
    ' WColumns?? [In, Optional]
    '   Target width of the Window in character columns.
    '   Defaults to current Window width if NULL or unspecified.
    '
    ' WRows?? [In, Optional]
    '   Target height of the Window in character rows.
    '   Defaults to current Window height if NULL or unspecified.
    '
    ' BColumns?? [In, Optional]
    '   Target width of the Screen Buffer in character columns.
    '   Defaults to current Screen Buffer width if NULL or unspecified.
    '
    ' BRows?? [In, Optional]
    '   Target height of the Screen Buffer in character rows.
    '   Defaults to current Screen Buffer height if NULL or unspecified.
    '
    ' hBuffer& [In, Optional]
    '   The handle of the Screen Buffer to resize.
    '   Defaults to the active Screen Buffer's handle if NULL or unspecified.

    REGISTER Wx??, Wy??, Bx??, By??
    LOCAL CBI AS CONSOLE_SCREEN_BUFFER_INFO

    'Unicode support
    #IF %DEF (%UNICODE)
        LOCAL zTmp AS WSTRINGZ * 8
    #ELSE
        LOCAL zTmp AS ASCIZ * 8
    #ENDIF

    DO WHILE GetConsoleScreenBufferInfo (BYVAL hBuffer&, BYVAL VARPTR(CBI)) = 0&

        'Exit if already tried & still unsuccessful
        IF LEN(zTmp) THEN EXIT SUB

        'hBuffer& is likely invalid; open handle to active Screen Buffer
        zTmp = "CONOUT$"
        hBuffer& = CreateFile (BYVAL VARPTR(zTmp), _
                               BYVAL %GENERIC_READ OR %GENERIC_WRITE, _
                               BYVAL %FILE_SHARE_WRITE, BYVAL 0&, _
                               BYVAL %OPEN_EXISTING, BYVAL 0&, BYVAL 0&)
    LOOP

    'Get maximum width & height possible (discounting Screen Buffer)
    POKE DWORD, VARPTR(CBI.dwMaximumWindowSize), GetLargestConsoleWindowSize (BYVAL hBuffer&)

    'Initialize working variables
    Wx?? = IIF&(WColumns??, WColumns??, CBI.srWindow.xRight - CBI.srWindow.xLeft + 1??)
    Wy?? = IIF&(WRows??,    WRows??,    CBI.srWindow.xBottom - CBI.srWindow.xTop + 1??)
    Bx?? = IIF&(BColumns??, BColumns??, MAX&(CBI.dwSize.X, Wx??))
    By?? = IIF&(BRows??,    BRows??,    MAX&(CBI.dwSize.Y, Wy??))

    'Limit target Window dimensions to lowest of target, Screen Buffer or max possible
    Wx?? = MIN&(Wx??, Bx??, CBI.dwMaximumWindowSize.X)
    Wy?? = MIN&(Wy??, By??, CBI.dwMaximumWindowSize.Y)

    'Resize Window to smallest possible
    RESET CBI
    SetConsoleWindowInfo (BYVAL hBuffer&, BYVAL 1&, BYVAL VARPTR(CBI.srWindow))

    'Resize Screen Buffer to target dimensions
    CBI.dwSize.X = Bx??
    CBI.dwSize.Y = By??
    SetConsoleScreenBufferSize (BYVAL hBuffer&, BYVAL PEEK(DWORD, VARPTR(CBI.dwSize)))

    'Resize Window to target dimensions
    CBI.srWindow.xRight  = Wx?? - 1??
    CBI.SrWindow.xBottom = Wy?? - 1??
    SetConsoleWindowInfo (BYVAL hBuffer&, BYVAL 1&, BYVAL VARPTR(CBI.srWindow))

    'Cleanup
    IF LEN(zTmp) THEN CloseHandle (hBuffer&)
END SUB

'------------------------------------------------------------------------------

SUB ConsoleCenterClient ()
    'Center console on client area of desktop
    REGISTER dcx&, dcy&, lx&, ly&, x&, y&
    SLEEP 100
    DESKTOP GET CLIENT TO dcx&, dcy&
    DESKTOP GET LOC TO lx&, ly&
    CONSOLE GET SIZE TO x&, y&
    CONSOLE SET LOC lx& + (dcx& - x&) / 2&, ly& + (dcy& - y&) / 2&
END SUB

'------------------------------------------------------------------------------

SUB ConsoleSave (BYREF StrAddr&, StrLen???, hStrMem&, OPT BYVAL TL???, BYVAL BR???, BYVAL hBuffer&)
    '
    ' v1.01 by Yuzree Esmera
    ' Requires Windows 2000 or later, PBCC 5 or later.
    '
    ' Saves a Screen Buffer, or a region within it, to a string.
    '
    ' StrAddr& [Out]
    '   The variable that receives the address of the saved string.
    '
    ' StrLen??? [Out]
    '   The variable that receives the length of the saved string.
    '
    ' hStrMem& [Out]
    '   The variable that receives the handle to the global memory object that
    '   was created to store the saved string. It is the programmer's
    '   responsibility to free the global memory object after retrieving the
    '   saved string.
    '
    ' TL??? [In, Optional]
    '   The Top-Left boundary coordinates of the region to be saved.
    '     The High-Order WORD specifies the Top boundary.
    '     The Low-Order WORD specifies the Left boundary.
    '   Defaults to the Top-Left coordinates of the Screen Buffer (0, 0) if
    '   NULL or unspecified.
    '
    ' BR??? [In, Optional]
    '   The Bottom-Right boundary coordinates of the region to be saved.
    '     The High-Order WORD specifies the Bottom boundary.
    '     The Low-Order WORD specifies the Right boundary.
    '   Defaults to the Bottom-Right coordinates of the Screen Buffer if NULL
    '   or unspecified.
    '
    ' hBuffer& [In, Optional]
    '   The handle of the Screen Buffer to be saved.
    '   Defaults to the active Screen Buffer's handle if NULL or unspecified.

    REGISTER x&, y&, z&
    LOCAL CBI AS CONSOLE_SCREEN_BUFFER_INFO
    LOCAL wTop??, wBottom??, wLeft??, wRight??, lLines&, lChars&, lSkip&

    'Unicode support
    #IF %DEF (%UNICODE)
        LOCAL sTmp$$, zTmp AS WSTRINGZ * 8
    #ELSE
        LOCAL sTmp$, zTmp AS ASCIZ * 8
    #ENDIF

    'Zero output variables
    RESET StrAddr&, StrLen???, hStrMem&

    DO WHILE GetConsoleScreenBufferInfo (BYVAL hBuffer&, BYVAL VARPTR(CBI)) = 0&

        'Exit if already tried & still unsuccessful
        IF LEN(zTmp) THEN EXIT SUB

        'hBuffer& is likely invalid; open handle to active Screen Buffer
        zTmp = "CONOUT$"
        hBuffer& = CreateFile (BYVAL VARPTR(zTmp), _
                               BYVAL %GENERIC_READ OR %GENERIC_WRITE, _
                               BYVAL %FILE_SHARE_WRITE, BYVAL 0&, _
                               BYVAL %OPEN_EXISTING, BYVAL 0&, BYVAL 0&)
    LOOP

    'Ensure boundaries are within the Screen Buffer's dimensions,
    'and that they don't invalidate each other.
    wTop??    = MIN%(HI(WORD, TL???), CBI.dwSize.Y - 1??)
    wLeft??   = MIN%(LO(WORD, TL???), CBI.dwSize.X - 1??)
    wBottom?? = MIN%(HI(WORD, BR???), CBI.dwSize.Y)
    wRight??  = MIN%(LO(WORD, BR???), CBI.dwSize.X)
    wBottom?? = IIF%(wBottom??, MAX%(wBottom??, wTop?? + 1??), CBI.dwSize.Y)
    wRight??  = IIF%(wRight??,  MAX%(wRight??, wLeft?? + 1??), CBI.dwSize.X)

    'Number of lines to read
    lLines& = wBottom?? - wTop??

    'Number of characters to read
    x& = (CBI.dwSize.X * lLines&) - (wLeft?? + (CBI.dwSize.X - wRight??))

    'Allocate memory for character buffer
    #IF %DEF (%UNICODE)
        GLOBALMEM ALLOC x& * 2 TO y&
    #ELSE
        GLOBALMEM ALLOC x& TO y&
    #ENDIF
    GLOBALMEM LOCK y& TO z&

    'Read from Top-Left to Bottom-Right
    IF ReadConsoleOutputCharacter (BYVAL hBuffer&, BYVAL z&, BYVAL x&, _
                                   BYVAL MAK(DWORD, wLeft??, wTop??), _
                                   BYVAL VARPTR(lChars&)) = 0? THEN GOTO Cleanup
    'Length to read
    lChars& = wRight?? - wLeft??

    'Length to skip
    lSkip& = wLeft?? + lChars& + (CBI.dwSize.X - wRight??)
    #IF %DEF (%UNICODE)
        lSkip& *= 2&
    #ENDIF

    'Read each line of the region into a string
    FOR x& = 1& TO lLines&
        'Read from address
        #IF %DEF (%UNICODE)
            sTmp$$ &= RTRIM$(PEEK$$(z&, lChars&), ANY $$WHITESPACE) & $$CRLF
        #ELSE
            sTmp$ &= RTRIM$(PEEK$(z&, lChars&), ANY CHR$(32, 9, 13, 10)) & $CRLF
        #ENDIF
        'Set pointer to next read address
        z& += lSkip&
    NEXT

    'Output string length
    StrLen??? = LEN(sTmp)

    'Allocate buffer & store output string
    #IF %DEF (%UNICODE)
        GLOBALMEM ALLOC StrLen??? * 2 TO hStrMem&
        GLOBALMEM LOCK hStrMem& TO StrAddr&
        POKE$$ StrAddr&, sTmp$$
    #ELSE
        GLOBALMEM ALLOC StrLen??? TO hStrMem&
        GLOBALMEM LOCK hStrMem& TO StrAddr&
        POKE$ StrAddr&, sTmp$
    #ENDIF

Cleanup:
    GLOBALMEM FREE y& TO y&
    IF LEN(zTmp) THEN CloseHandle (BYVAL hBuffer&)
END SUB

'------------------------------------------------------------------------------

SUB ConsoleType (BYVAL dwLine???)
    'Simulate keyboard typing + enter key
    REGISTER x&, y&, z&
    LOCAL lRecs&
    DIM IR AS INPUT_RECORD

    y& = VARPTR(IR)

    IR.EventType = %KEY_EVENT
    POKE LONG, y& + 4&, 1&  'IR.KeyEvent.bKeyDown
    POKE WORD, y& + 8&, 1?? 'IR.KeyEvent.wRepeatCount

    #IF %DEF (%UNICODE)
        LOCAL sLine$$
        sLine$$ = PEEK$$(WSTRINGZ, dwLine???, 4096&)
    #ELSE
        LOCAL sLine$
        sLine$ = PEEK$(ASCIZ, dwLine???, 2048&)
    #ENDIF

    z& = LEN(sLine)
    DO WHILE x& < z&
        INCR x&
        SLEEP 350
        POKE INTEGER, y& + 14&, ASC(sLine, x&) 'IR.KeyEvent.uChar
        WriteConsoleInput (BYVAL GETSTDIN, BYVAL y&, BYVAL 1&, BYVAL VARPTR(lRecs&))
    LOOP

    SLEEP 1500
    POKE INTEGER, y& + 14&, 13% 'IR.KeyEvent.uChar
    WriteConsoleInput (BYVAL GETSTDIN, BYVAL y&, BYVAL 1&, BYVAL VARPTR(lRecs&))
END SUB

'------------------------------------------------------------------------------

SUB InfoShow ()
    STATIC bAfter?
    LOCAL lTmp&

    #IF %DEF (%UNICODE)
        LOCAL sInf$$, sTit$$, CInfo$$()
    #ELSE
        LOCAL sInf$, sTit$, CInfo$()
    #ENDIF

    DIM CInfo (1 TO 2, 1 TO 7)

    CInfo (1, 1) = FORMAT$(CONSHNDL)
    CInfo (1, 2) = FORMAT$(GETSTDERR)
    CInfo (1, 3) = FORMAT$(GETSTDOUT)
    CInfo (1, 4) = FORMAT$(GETSTDIN)
    CInfo (1, 5) = FORMAT$(GETSTDKBD)
    CInfo (1, 6) = FORMAT$(CONSIN)
    CInfo (1, 7) = FORMAT$(CONSOUT)

    CInfo (2, 1) = FORMAT$(GetConsoleWindow())
    CInfo (2, 2) = FORMAT$(GetStdHandle (BYVAL %STD_ERROR_HANDLE))
    CInfo (2, 3) = FORMAT$(GetStdHandle (BYVAL %STD_OUTPUT_HANDLE))
    CInfo (2, 4) = FORMAT$(GetStdHandle (BYVAL %STD_INPUT_HANDLE))
    CInfo (2, 5) = IIF$(bAfter?, CInfo (1, 5), "N/A *")
    CInfo (2, 6) = IIF$(GetConsoleMode(BYVAL VAL(CInfo (2, 4)), BYVAL VARPTR(lTmp&)), "-1", "0")
    CInfo (2, 7) = IIF$(GetConsoleMode(BYVAL VAL(CInfo (2, 3)), BYVAL VARPTR(lTmp&)), "-1", "0")

    sInf =          $TAB & $TAB & "PBCC"       & $TAB & $TAB & "API"        & $CRLF & _
                    $TAB & $TAB & "------"     & $TAB & $TAB & "-----"      & $CRLF & _
           "HWND" & $TAB & $TAB & CInfo (1, 1) & $TAB & $TAB & CInfo (2, 1) & $CRLF & _
         "STDERR" & $TAB & $TAB & CInfo (1, 2) & $TAB & $TAB & CInfo (2, 2) & $CRLF & _
         "STDOUT" & $TAB & $TAB & CInfo (1, 3) & $TAB & $TAB & CInfo (2, 3) & $CRLF & _
          "STDIN" & $TAB & $TAB & CInfo (1, 4) & $TAB & $TAB & CInfo (2, 4) & $CRLF & _
         "STDKBD" & $TAB & $TAB & CInfo (1, 5) & $TAB & $TAB & CInfo (2, 5) & $CRLF & _
         "CONSIN" & $TAB & $TAB & CInfo (1, 6) & $TAB & $TAB & CInfo (2, 6) & $CRLF & _
        "CONSOUT"        & $TAB & CInfo (1, 7) & $TAB & $TAB & CInfo (2, 7)

    sInf &= IIF$(bAfter?, "", $CRLF & $CRLF & "* As PBCC opened STDKBD by "   & _
                "API, it would be impractical to do the same for as long as " & _
                "STDKBD remains open, we'll always get a different handle."   & _
                $CRLF & $CRLF & "A valid STDKBD will be passed to PBCC by " & _
                "ConsoleInit (& shown here) shortly.")

    sTit = "Console Info " & IIF$(bAfter?, "after", "before") & " calling ConsoleInit"

    MessageBox (BYVAL GetConsoleWindow(), BYVAL STRPTR(sInf), BYVAL STRPTR(sTit), BYVAL %MB_ICONINFORMATION)

    bAfter? XOR= 1?
END SUB

'------------------------------------------------------------------------------

SUB ConsoleInit ()
    '
    ' v1.00 by Yuzree Esmera
    ' Requires Windows 2000 or later, PBCC 5 or later.
    '
    ' Initializes the current Console for use with PBCC.
    '
    ' Since the WIN32API.INC (dated 23 April 2010) shipped with PBCC 5.05
    ' doesn't include declarations for "GetConsoleWindow", this needs to be
    ' declared in your code for ConsoleInit to work.

    REGISTER x&
    LOCAL pIDH AS IMAGE_DOS_HEADER PTR, pNTH AS IMAGE_NT_HEADERS PTR
    LOCAL dwBase???, bSects?, zName AS ASCIZ * 9

    'Unicode support
    #IF %DEF (%UNICODE)
        LOCAL zTmp AS WSTRINGZ * 8
    #ELSE
        LOCAL zTmp AS ASCIZ * 8
    #ENDIF

    'Get module handle
    pIDH = GetModuleHandle (BYVAL 0&)

    'Exit if unsuccessful
    IF pIDH = 0& THEN EXIT SUB

    'Get address of PE image
    pNTH = pIDH + @pIDH.e_lfanew
    dwBase??? = @pNTH.OptionalHeader.ImageBase

    'Get number of sections in PE
    bSects? = @pNTH.FileHeader.NumberOfSections

    'Overlay IMAGE_SECTION_HEADER array immediately after PE header
    DIM ISH (1? TO bSects?) AS IMAGE_SECTION_HEADER AT pNTH + _
                            @pNTH.FileHeader.SizeOfOptionalHeader + 24&

    'Get address of ".data" section from Section Table
    FOR x& = 1& TO bSects?
        zName = LCASE$(PEEK$(VARPTR(ISH(x&)), 8&)) 'ISH(x&).Name
        IF zName = ".data" THEN
            dwBase??? += ISH(x&).VirtualAddress
            RESET bSects?
            EXIT FOR
        END IF
    NEXT

    'Exit if ".data" Section not found
    IF bSects? THEN EXIT SUB

    'Free orphaned console input handle
    CloseHandle (BYVAL GETSTDKBD)

    'Update stored window handle / CONSHNDL
    POKE DWORD, dwBase??? + IIF&(%PB_REVISION < &H600, &H2A0, &H3DC), GetConsoleWindow ()

    'Overlay array on internal PBCC structure
    DIM CCInit (1& TO 7&) AS LONG AT dwBase??? + IIF&(%PB_REVISION < &H600, &H664, &H980)

    'Update PBCC structure with valid info
    CCInit& (7&) = GetStdHandle (BYVAL %STD_OUTPUT_HANDLE) ' GETSTDOUT
    CCInit& (6&) = GetStdHandle (BYVAL %STD_INPUT_HANDLE)  ' GETSTDIN
    CCInit& (5&) = GetStdHandle (BYVAL %STD_ERROR_HANDLE)  ' GETSTDERR

    'Open new console input handle
    zTmp = "CONIN$"
    CCInit& (3&) = CreateFile (BYVAL VARPTR(zTmp), _       ' GETSTDKBD
                               BYVAL %GENERIC_READ, _
                               BYVAL %FILE_SHARE_READ, BYVAL 0&, _
                               BYVAL %OPEN_EXISTING, BYVAL 0&, BYVAL 0&)

    CCInit& (2&) = IIF&(GetConsoleMode(BYVAL CCInit& (7&), BYVAL VARPTR(dwBase???)), -1&, 0&) ' CONSOUT
    CCInit& (1&) = IIF&(GetConsoleMode(BYVAL CCInit& (6&), BYVAL VARPTR(dwBase???)), -1&, 0&) ' CONSIN
    CCInit& (4&) = IIF&(CCInit& (2&), CCInit& (7&), CCInit& (5&)) 'hConsoleOutput for API wrappers
END SUB

'------------------------------------------------------------------------------

SUB Stage2 ()
    REGISTER x&, y&, z&
    LOCAL SI AS STARTUPINFO, PI AS PROCESS_INFORMATION, dwTmp???

    CONSOLE NAME "Stage 2 : Attaching a Console"

    CLS
    ?
    ? " ***********************"
    ? " * Attaching a Console *"
    ? " ***********************"
    ?
    ? " Let's say we need to work with an existing console by attaching to it,"
    ? " grabbing some data directly from there (without any of those clunky"
    ? " redirected-output files), & then displaying that data."

    IF AnyKey ("Press any key to continue (X to exit)...") = "x" THEN EXIT SUB

    SI.cb = LEN(SI)

    #IF %DEF (%UNICODE)
        LOCAL sCmdLine$$, sTmp$$
        sCmdLine$$ = "cmd" & $$NUL
    #ELSE
        LOCAL sCmdLine$, sTmp$
        sCmdLine$ = "cmd" & $NUL
    #ENDIF

    x& = CreateProcess (BYVAL 0&, BYVAL STRPTR(sCmdLine), BYVAL 0&, BYVAL 0&, _
                        BYVAL 0&, BYVAL %CREATE_NEW_CONSOLE, BYVAL 0&, _
                        BYVAL 0&, BYVAL VARPTR(SI), BYVAL VARPTR(PI))
    SLEEP 100
    SetWindowpos (BYVAL CONSHNDL, BYVAL %HWND_TOPMOST, BYVAL 0&, BYVAL 0&, _
                  BYVAL 0&, BYVAL 0&, _
                  BYVAL (%SWP_NOMOVE OR %SWP_NOSIZE OR %SWP_SHOWWINDOW))

    CLS
    ?
    ? " As you can see, CMD.EXE has it's own console window."
    ?
    ? " Let's detach this console, attach CMD.EXE's, & call ConsoleInit."
    ?
    ? " Detaching in 8 seconds..."

    FOR x& = 7 TO 0 STEP -1
        SLEEP 1000
        LOCATE 6, 14
        ? x&
    NEXT

    FreeConsole ()
    AttachConsole (BYVAL PI.dwProcessId)

    InfoShow ()
    ConsoleInit ()
    InfoShow ()

    ConsoleResizeEx (80, 25, 80, 100)
    ConsoleCenterClient ()

    CONSOLE NAME "All your console are belong to us" ' :P

    'Suspend CMD.EXE to prevent it from hogging the input buffer
    SuspendThread (BYVAL PI.hThread)

    sCmdLine = $NUL
    #IF %DEF (%UNICODE)
        sCmdLine$$ &= $NUL
    #ENDIF

    'Enter an empty line to the input buffer to free CMD.EXE's
    'wait object on it (so that we can execute the WAITKEY$ below).
    ConsoleType (BYVAL STRPTR(sCmdLine))

    CURSOR OFF
    ?
    ? " And here we are!"
    ?
    ? " Now that we're here, we can do all sorts of"
    ? " stuff with CMD.EXE; let's get a directory"
    ? " listing for now."
    ?
    ? " Press any key to continue..."
    ?
    WAITKEY$
    CURSOR ON

    'Resume execution of CMD.EXE
    ResumeThread (BYVAL PI.hThread)

    sCmdLine = "dir /n /oe /s" & $NUL
    #IF %DEF (%UNICODE)
        sCmdline$$ &= $NUL
    #ENDIF

    'Enter command-line
    ConsoleType (BYVAL STRPTR(sCmdLine))

    'Sleep for 1 second to allow DIR command completion
    SLEEP 1000

    'Capture entire output buffer
    ConsoleSave (x&, y&, z&)

    sCmdLine = "exit" & $NUL
    #IF %DEF (%UNICODE)
        sCmdLine$$ &= $NUL
    #ENDIF

    'Close CMD.EXE the old-fashioned way ;)
    ConsoleType (BYVAL STRPTR(sCmdLine))

    CURSOR OFF
    RESET sCmdLine

    IF x& AND y& AND z& THEN
        'Grab string from memory
        #IF %DEF (%UNICODE)
            sCmdLine$$ = PEEK$$(x&, y&)
        #ELSE
            sCmdLine$ = PEEK$(x&, y&)
        #ENDIF
        GLOBALMEM FREE z& TO z&

        'Retain CMD.EXE's output
        sCmdLine = RTRIM$(REMAIN$(REMAIN$(REMAIN$(sCmdLine, ">"), ">"), $CRLF), ANY $SPC & $CRLF)
        sCmdLine = RTRIM$(LEFT$(sCmdLine, INSTR(-1, sCmdLine, $CRLF) - 1&), ANY $SPC & $CRLF)
    END IF

    CLS
    ?
    ? " This is CMD.EXE's response to the command we entered earlier..."

    sTmp = "CMD Says..."
    MessageBox (BYVAL CONSHNDL, BYVAL STRPTR(sCmdLine), BYVAL STRPTR(sTmp), BYVAL %MB_ICONINFORMATION)
    ?
    ? " Since we've stored the response in a string, we could now parse"
    ? " & work with it in all sorts of ways; but that's not the purpose"
    ? " of this demo."

    AnyKey (" Press any key to exit...")

    'Cleanup
    CloseHandle (BYVAL PI.hThread)
    CloseHandle (BYVAL PI.hProcess)
END SUB

'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Functions **
'------------------------------------------------------------------------------

FUNCTION AnyKey (BYVAL Prompt$) AS STRING
    COLOR 3
    ?
    ? $SPC Prompt$
    COLOR 7

    FUNCTION = LCASE$(WAITKEY$)
END FUNCTION

'------------------------------------------------------------------------------

THREAD FUNCTION THStage1 (BYVAL Blah&) AS LONG
    COLOR 13

    SLEEP 5000
    ?
    ? " * Spawned worker thread " HEX$(THREADID)

    SLEEP 25000
    ?
    ? " * Calling ConsoleInit..."

    INPUT FLUSH
    ConsoleInit ()
    InfoShow ()
    ?
    ? " * Worker thread " HEX$(THREADID) " done, you can press any key now ;)"
    COLOR 7
END FUNCTION

'------------------------------------------------------------------------------

FUNCTION Stage1 () AS BYTE
    REGISTER x&

    #IF %DEF (%UNICODE)
        LOCAL sTmp$$
    #ELSE
        LOCAL sTmp$
    #ENDIF

    CONSOLE NAME "Stage 1 : Creating a Console"

    CLS
    ?
    ? " ***********************"
    ? " * Creating a Console *"
    ? " ***********************"
    ?
    ? " Creating a console with API may be a breeze, but getting it to work"
    ? " with PBCC is another story, as we'll find out shortly."
    ?
    ? " We'll now create a new console & attach it to this process."

    sTmp = AnyKey ("Press any key to continue (S to skip this stage, X to exit)...")

    IF sTmp = "x" THEN FUNCTION = 1?
    IF sTmp = "x" OR sTmp = "s" THEN EXIT FUNCTION

    FreeConsole ()
    AllocConsole ()

    CURSOR OFF
    CLS
    ?
    ? " This is the new console."

    InfoShow ()
    ?
    ? " Immediately after printing this, a worker thread will be"
    ? " created to call ConsoleInit in 30 seconds."
    ?
    ? " After the creation of the thread, a WAITKEY$ function will"
    ? " be executed."
    ?
    ? " If the handle of the current input buffer is different from"
    ? " what is stored by PBCC, the WAITKEY$ function will cause a"
    ? " deadlock."
    ?
    ? " Try pressing any key to resume execution..."

    THREAD CREATE THStage1 (BYVAL 0&) TO x&
    THREAD CLOSE x& TO x&

    WAITKEY$

    ConsoleResizeEx (80, 25, 80, 50)
    ConsoleCenterClient ()
    CURSOR OFF
    ?
    ? " Welcome back! Now another WAITKEY$ will be executed; this"
    ? " time there shouldn't be any deadlock as ConsoleInit has"
    ? " fixed PBCC's internal structure."

    IF AnyKey ("Press any key to continue (X to exit)...") = "x" THEN FUNCTION = 1?
END FUNCTION

'------------------------------------------------------------------------------

FUNCTION PBMAIN () AS LONG

    CONSOLE NAME "ConsoleInit Demo by Yuzree Esmera"
    CURSOR OFF

    ConsoleResizeEx (80, 25, 80, 100)
    ConsoleCenterClient ()

    ?
    ? " ----------------"
    ? " | Introduction |"
    ? " ----------------"
    ?
    ? " Unlike PBCC 6 with the CON.NEW Method, PBCC 5 has no built-in support for"
    ? " creating consoles. Both PBCC 5 & 6 lack the ability to attach an existing"
    ? " console to their applications, let alone work with one once it's attached."
    ?
    ? " All of these functions can be easily accomplished using Windows API. However,"
    ? " this is where the problem begins."
    ?
    ? " When a PBCC console program starts up & when certain " $SQ "key" $SQ " instructions are"
    ? " processed for the first time, pertinent data (such as handles) is initialized"
    ? " & stored in an internal structure so that it can be re-used by PBCC should"
    ? " the need arise."
    ?
    ? " If another console is then attached to the program using API, this internal"
    ? " data could get invalidated as PBCC doesn't reactively update it. As such, many"
    ? " instructions that depend on this data could no longer work as intended. For"
    ? " example, the WAITKEY$ Function could become stuck in an infinite loop, waiting"
    ? " on a non-existent input buffer."

    IF AnyKey (BYVAL "Press any key to continue (X to exit)...") = "x" THEN GOTO ByeBye
    ?
    ? " ---------------"
    ? " | ConsoleInit |"
    ? " ---------------"
    ?
    ? " As mentioned earlier, attaching or allocating a console to a PBCC program"
    ? " using API could render many built-in instructions inoperative due to"
    ? " potentially invalid internal data."
    ?
    ? " Since PBCC 5 assumes we'll be working with only the one console, it regards"
    ? " it's data as constant & uses it in all related instructions. PBCC 6 updates"
    ? " it's data ONLY when a new console is created using the CON.NEW Method."
    ? " Otherwise, it reverts to PBCC 5 behavior."
    ?
    ? " Consequently, the affected instructions would have to be emulated somehow, or"
    ? " we could use the more practical approach of fixing this data dynamically. This"
    ? " is where ConsoleInit comes in."
    ?
    ? " ConsoleInit works by updating PBCC's internal structure with proper data so"
    ? " that intrinsic PBCC functions would continue to work normally with an"
    ? " API-instantiated or attached console."
    ?

    IF AnyKey (BYVAL "Press any key to continue (X to exit)...") = "x" THEN GOTO ByeBye
    ?
    ? " --------"
    ? " | Demo |"
    ? " --------"
    ?
    ? " There are two stages in this demo."
    ?
    ? " The first demonstrates implementing a new console instance using API &"
    ? " ConsoleInit."
    ?
    ? " The second stage covers attaching a console to the demo's process, & then"
    ? " making it workable with PBCC using ConsoleInit."
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    IF AnyKey (BYVAL "Press any key to begin (X to exit)...") = "x" THEN GOTO ByeBye

    IF Stage1 () THEN GOTO ByeBye
    Stage2 ()

ByeBye:
    ?
    ? " Thank you for trying this demo, I'd appreciate any comments or suggestions!"
    ?
    WAITKEY$
    CURSOR ON
END FUNCTION
'------------------------------------------------------------------------------
Here's the Windows 2000 Demo:
Code:
'------------------------------------------------------------------------------
'   ** Metastatements **
'------------------------------------------------------------------------------
#TOOLS ON
#DEBUG DISPLAY ON
#DEBUG ERROR ON

#OPTION VERSION5
#COMPILER PBCC 5, PBCC 6

#COMPILE EXE "ConsoleInit_Win2K.exe"
#DIM ALL

'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
'Declare Unicode on PBCC 6
#IF %PB_REVISION => &H600
    %UNICODE = 1&
#ENDIF
#INCLUDE ONCE "Win32API.inc"

'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Declarations **
'------------------------------------------------------------------------------
DECLARE FUNCTION GetConsoleWindow LIB "KERNEL32.DLL" ALIAS "GetConsoleWindow" _
                 () AS DWORD

'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Subs **
'------------------------------------------------------------------------------

SUB ConsoleResizeEx (OPT BYVAL WColumns??, BYVAL WRows??, BYVAL BColumns??, BYVAL BRows??, BYVAL hBuffer&)
    '
    ' v1.03 by Yuzree Esmera
    ' Requires Windows 2000 or later, PBCC 5 or later.
    '
    ' Resizes a Screen Buffer and/or it's associated Window according to the
    ' specified dimensions.
    '
    ' WColumns?? [In, Optional]
    '   Target width of the Window in character columns.
    '   Defaults to current Window width if NULL or unspecified.
    '
    ' WRows?? [In, Optional]
    '   Target height of the Window in character rows.
    '   Defaults to current Window height if NULL or unspecified.
    '
    ' BColumns?? [In, Optional]
    '   Target width of the Screen Buffer in character columns.
    '   Defaults to current Screen Buffer width if NULL or unspecified.
    '
    ' BRows?? [In, Optional]
    '   Target height of the Screen Buffer in character rows.
    '   Defaults to current Screen Buffer height if NULL or unspecified.
    '
    ' hBuffer& [In, Optional]
    '   The handle of the Screen Buffer to resize.
    '   Defaults to the active Screen Buffer's handle if NULL or unspecified.

    REGISTER Wx??, Wy??, Bx??, By??
    LOCAL CBI AS CONSOLE_SCREEN_BUFFER_INFO

    'Unicode support
    #IF %DEF (%UNICODE)
        LOCAL zTmp AS WSTRINGZ * 8
    #ELSE
        LOCAL zTmp AS ASCIZ * 8
    #ENDIF

    DO WHILE GetConsoleScreenBufferInfo (BYVAL hBuffer&, BYVAL VARPTR(CBI)) = 0&

        'Exit if already tried & still unsuccessful
        IF LEN(zTmp) THEN EXIT SUB

        'hBuffer& is likely invalid; open handle to active Screen Buffer
        zTmp = "CONOUT$"
        hBuffer& = CreateFile (BYVAL VARPTR(zTmp), _
                               BYVAL %GENERIC_READ OR %GENERIC_WRITE, _
                               BYVAL %FILE_SHARE_WRITE, BYVAL 0&, _
                               BYVAL %OPEN_EXISTING, BYVAL 0&, BYVAL 0&)
    LOOP

    'Get maximum width & height possible (discounting Screen Buffer)
    POKE DWORD, VARPTR(CBI.dwMaximumWindowSize), GetLargestConsoleWindowSize (BYVAL hBuffer&)

    'Initialize working variables
    Wx?? = IIF&(WColumns??, WColumns??, CBI.srWindow.xRight - CBI.srWindow.xLeft + 1??)
    Wy?? = IIF&(WRows??,    WRows??,    CBI.srWindow.xBottom - CBI.srWindow.xTop + 1??)
    Bx?? = IIF&(BColumns??, BColumns??, MAX&(CBI.dwSize.X, Wx??))
    By?? = IIF&(BRows??,    BRows??,    MAX&(CBI.dwSize.Y, Wy??))

    'Limit target Window dimensions to lowest of target, Screen Buffer or max possible
    Wx?? = MIN&(Wx??, Bx??, CBI.dwMaximumWindowSize.X)
    Wy?? = MIN&(Wy??, By??, CBI.dwMaximumWindowSize.Y)

    'Resize Window to smallest possible
    RESET CBI
    SetConsoleWindowInfo (BYVAL hBuffer&, BYVAL 1&, BYVAL VARPTR(CBI.srWindow))

    'Resize Screen Buffer to target dimensions
    CBI.dwSize.X = Bx??
    CBI.dwSize.Y = By??
    SetConsoleScreenBufferSize (BYVAL hBuffer&, BYVAL PEEK(DWORD, VARPTR(CBI.dwSize)))

    'Resize Window to target dimensions
    CBI.srWindow.xRight  = Wx?? - 1??
    CBI.SrWindow.xBottom = Wy?? - 1??
    SetConsoleWindowInfo (BYVAL hBuffer&, BYVAL 1&, BYVAL VARPTR(CBI.srWindow))

    'Cleanup
    IF LEN(zTmp) THEN CloseHandle (hBuffer&)
END SUB

'------------------------------------------------------------------------------

SUB ConsoleCenterClient ()
    'Center console on client area of desktop
    REGISTER dcx&, dcy&, lx&, ly&, x&, y&
    SLEEP 100
    DESKTOP GET CLIENT TO dcx&, dcy&
    DESKTOP GET LOC TO lx&, ly&
    CONSOLE GET SIZE TO x&, y&
    CONSOLE SET LOC lx& + (dcx& - x&) / 2&, ly& + (dcy& - y&) / 2&
END SUB

'------------------------------------------------------------------------------

SUB InfoShow ()
    STATIC bAfter?
    LOCAL lTmp&

    #IF %DEF (%UNICODE)
        LOCAL sInf$$, sTit$$, CInfo$$()
    #ELSE
        LOCAL sInf$, sTit$, CInfo$()
    #ENDIF

    DIM CInfo (1 TO 2, 1 TO 7)

    CInfo (1, 1) = FORMAT$(CONSHNDL)
    CInfo (1, 2) = FORMAT$(GETSTDERR)
    CInfo (1, 3) = FORMAT$(GETSTDOUT)
    CInfo (1, 4) = FORMAT$(GETSTDIN)
    CInfo (1, 5) = FORMAT$(GETSTDKBD)
    CInfo (1, 6) = FORMAT$(CONSIN)
    CInfo (1, 7) = FORMAT$(CONSOUT)

    CInfo (2, 1) = FORMAT$(GetConsoleWindow())
    CInfo (2, 2) = FORMAT$(GetStdHandle (BYVAL %STD_ERROR_HANDLE))
    CInfo (2, 3) = FORMAT$(GetStdHandle (BYVAL %STD_OUTPUT_HANDLE))
    CInfo (2, 4) = FORMAT$(GetStdHandle (BYVAL %STD_INPUT_HANDLE))
    CInfo (2, 5) = IIF$(bAfter?, CInfo (1, 5), "N/A *")
    CInfo (2, 6) = IIF$(GetConsoleMode(BYVAL VAL(CInfo (2, 4)), BYVAL VARPTR(lTmp&)), "-1", "0")
    CInfo (2, 7) = IIF$(GetConsoleMode(BYVAL VAL(CInfo (2, 3)), BYVAL VARPTR(lTmp&)), "-1", "0")

    sInf =          $TAB & $TAB & "PBCC"       & $TAB & $TAB & "API"        & $CRLF & _
                    $TAB & $TAB & "------"     & $TAB & $TAB & "-----"      & $CRLF & _
           "HWND" & $TAB & $TAB & CInfo (1, 1) & $TAB & $TAB & CInfo (2, 1) & $CRLF & _
         "STDERR" & $TAB & $TAB & CInfo (1, 2) & $TAB & $TAB & CInfo (2, 2) & $CRLF & _
         "STDOUT" & $TAB & $TAB & CInfo (1, 3) & $TAB & $TAB & CInfo (2, 3) & $CRLF & _
          "STDIN" & $TAB & $TAB & CInfo (1, 4) & $TAB & $TAB & CInfo (2, 4) & $CRLF & _
         "STDKBD" & $TAB & $TAB & CInfo (1, 5) & $TAB & $TAB & CInfo (2, 5) & $CRLF & _
         "CONSIN" & $TAB & $TAB & CInfo (1, 6) & $TAB & $TAB & CInfo (2, 6) & $CRLF & _
        "CONSOUT"        & $TAB & CInfo (1, 7) & $TAB & $TAB & CInfo (2, 7)

    sInf &= IIF$(bAfter?, "", $CRLF & $CRLF & "* As PBCC opened STDKBD by "   & _
                "API, it would be impractical to do the same for as long as " & _
                "STDKBD remains open, we'll always get a different handle."   & _
                $CRLF & $CRLF & "A valid STDKBD will be passed to PBCC by " & _
                "ConsoleInit (& shown here) shortly.")

    sTit = "Console Info " & IIF$(bAfter?, "after", "before") & " calling ConsoleInit"

    MessageBox (BYVAL GetConsoleWindow(), BYVAL STRPTR(sInf), BYVAL STRPTR(sTit), BYVAL %MB_ICONINFORMATION)

    bAfter? XOR= 1?
END SUB

'------------------------------------------------------------------------------

SUB ConsoleInit ()
    '
    ' v1.00 by Yuzree Esmera
    ' Requires Windows 2000 or later, PBCC 5 or later.
    '
    ' Initializes the current Console for use with PBCC.
    '
    ' Since the WIN32API.INC (dated 23 April 2010) shipped with PBCC 5.05
    ' doesn't include declarations for "GetConsoleWindow", this needs to be
    ' declared in your code for ConsoleInit to work.

    REGISTER x&
    LOCAL pIDH AS IMAGE_DOS_HEADER PTR, pNTH AS IMAGE_NT_HEADERS PTR
    LOCAL dwBase???, bSects?, zName AS ASCIZ * 9

    'Unicode support
    #IF %DEF (%UNICODE)
        LOCAL zTmp AS WSTRINGZ * 8
    #ELSE
        LOCAL zTmp AS ASCIZ * 8
    #ENDIF

    'Get module handle
    pIDH = GetModuleHandle (BYVAL 0&)

    'Exit if unsuccessful
    IF pIDH = 0& THEN EXIT SUB

    'Get address of PE image
    pNTH = pIDH + @pIDH.e_lfanew
    dwBase??? = @pNTH.OptionalHeader.ImageBase

    'Get number of sections in PE
    bSects? = @pNTH.FileHeader.NumberOfSections

    'Overlay IMAGE_SECTION_HEADER array immediately after PE header
    DIM ISH (1? TO bSects?) AS IMAGE_SECTION_HEADER AT pNTH + _
                            @pNTH.FileHeader.SizeOfOptionalHeader + 24&

    'Get address of ".data" section from Section Table
    FOR x& = 1& TO bSects?
        zName = LCASE$(PEEK$(VARPTR(ISH(x&)), 8&)) 'ISH(x&).Name
        IF zName = ".data" THEN
            dwBase??? += ISH(x&).VirtualAddress
            RESET bSects?
            EXIT FOR
        END IF
    NEXT

    'Exit if ".data" Section not found
    IF bSects? THEN EXIT SUB

    'Free orphaned console input handle
    CloseHandle (BYVAL GETSTDKBD)

    'Update stored window handle / CONSHNDL
    POKE DWORD, dwBase??? + IIF&(%PB_REVISION < &H600, &H2A0, &H3DC), GetConsoleWindow ()

    'Overlay array on internal PBCC structure
    DIM CCInit (1& TO 7&) AS LONG AT dwBase??? + IIF&(%PB_REVISION < &H600, &H664, &H980)

    'Update PBCC structure with valid info
    CCInit& (7&) = GetStdHandle (BYVAL %STD_OUTPUT_HANDLE) ' GETSTDOUT
    CCInit& (6&) = GetStdHandle (BYVAL %STD_INPUT_HANDLE)  ' GETSTDIN
    CCInit& (5&) = GetStdHandle (BYVAL %STD_ERROR_HANDLE)  ' GETSTDERR

    'Open new console input handle
    zTmp = "CONIN$"
    CCInit& (3&) = CreateFile (BYVAL VARPTR(zTmp), _       ' GETSTDKBD
                               BYVAL %GENERIC_READ, _
                               BYVAL %FILE_SHARE_READ, BYVAL 0&, _
                               BYVAL %OPEN_EXISTING, BYVAL 0&, BYVAL 0&)

    CCInit& (2&) = IIF&(GetConsoleMode(BYVAL CCInit& (7&), BYVAL VARPTR(dwBase???)), -1&, 0&) ' CONSOUT
    CCInit& (1&) = IIF&(GetConsoleMode(BYVAL CCInit& (6&), BYVAL VARPTR(dwBase???)), -1&, 0&) ' CONSIN
    CCInit& (4&) = IIF&(CCInit& (2&), CCInit& (7&), CCInit& (5&)) 'hConsoleOutput for API wrappers
END SUB

'------------------------------------------------------------------------------

SUB Stage1 ()
    REGISTER x&

    #IF %DEF (%UNICODE)
        LOCAL sTmp$$
    #ELSE
        LOCAL sTmp$
    #ENDIF

    CLS
    ?
    ? " ***********************"
    ? " * Creating a Console *"
    ? " ***********************"
    ?
    ? " Creating a console with API may be a breeze, but getting it to work"
    ? " with PBCC is another story, as we'll find out shortly."
    ?
    ? " We'll now create a new console & attach it to this process."

    IF AnyKey ("Press any key to continue (X to exit)...") = "x" THEN EXIT SUB

    FreeConsole ()
    AllocConsole ()

    CURSOR OFF
    CLS
    ?
    ? " This is the new console."

    InfoShow ()
    ?
    ? " Immediately after printing this, a worker thread will be"
    ? " created to call ConsoleInit in 30 seconds."
    ?
    ? " After the creation of the thread, a WAITKEY$ function will"
    ? " be executed."
    ?
    ? " If the handle of the current input buffer is different from"
    ? " what is stored by PBCC, the WAITKEY$ function will cause a"
    ? " deadlock."
    ?
    ? " Try pressing any key to resume execution..."

    THREAD CREATE THStage1 (BYVAL 0&) TO x&
    THREAD CLOSE x& TO x&

    WAITKEY$

    ConsoleResizeEx (80, 25, 80, 50)
    ConsoleCenterClient ()
    CURSOR OFF
    ?
    ? " Welcome back! Now another WAITKEY$ will be executed; this"
    ? " time there shouldn't be any deadlock as ConsoleInit has"
    ? " fixed PBCC's internal structure."

    AnyKey ("Press any key to exit...")
END SUB

'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Functions **
'------------------------------------------------------------------------------

FUNCTION AnyKey (BYVAL Prompt$) AS STRING
    COLOR 3
    ?
    ? $SPC Prompt$
    COLOR 7

    FUNCTION = LCASE$(WAITKEY$)
END FUNCTION

'------------------------------------------------------------------------------

THREAD FUNCTION THStage1 (BYVAL Blah&) AS LONG
    COLOR 13

    SLEEP 5000
    ?
    ? " * Spawned worker thread " HEX$(THREADID)

    SLEEP 25000
    ?
    ? " * Calling ConsoleInit..."

    INPUT FLUSH
    ConsoleInit ()
    InfoShow ()
    ?
    ? " * Worker thread " HEX$(THREADID) " done, you can press any key now ;)"
    COLOR 7
END FUNCTION

'------------------------------------------------------------------------------

FUNCTION PBMAIN () AS LONG

    CONSOLE NAME "ConsoleInit Demo by Yuzree Esmera"
    CURSOR OFF

    ConsoleResizeEx (80, 25, 80, 100)
    ConsoleCenterClient ()

    ?
    ? " ----------------"
    ? " | Introduction |"
    ? " ----------------"
    ?
    ? " Unlike PBCC 6 with the CON.NEW Method, PBCC 5 has no built-in support for"
    ? " creating consoles. Both PBCC 5 & 6 lack the ability to attach an existing"
    ? " console to their applications, let alone work with one once it's attached."
    ?
    ? " All of these functions can be easily accomplished using Windows API. However,"
    ? " this is where the problem begins."
    ?
    ? " When a PBCC console program starts up & when certain " $SQ "key" $SQ " instructions are"
    ? " processed for the first time, pertinent data (such as handles) is initialized"
    ? " & stored in an internal structure so that it can be re-used by PBCC should"
    ? " the need arise."
    ?
    ? " If another console is then attached to the program using API, this internal"
    ? " data could get invalidated as PBCC doesn't reactively update it. As such, many"
    ? " instructions that depend on this data could no longer work as intended. For"
    ? " example, the WAITKEY$ Function could become stuck in an infinite loop, waiting"
    ? " on a non-existent input buffer."

    IF AnyKey (BYVAL "Press any key to continue (X to exit)...") = "x" THEN GOTO ByeBye
    ?
    ? " ---------------"
    ? " | ConsoleInit |"
    ? " ---------------"
    ?
    ? " As mentioned earlier, attaching or allocating a console to a PBCC program"
    ? " using API could render many built-in instructions inoperative due to"
    ? " potentially invalid internal data."
    ?
    ? " Since PBCC 5 assumes we'll be working with only the one console, it regards"
    ? " it's data as constant & uses it in all related instructions. PBCC 6 updates"
    ? " it's data ONLY when a new console is created using the CON.NEW Method."
    ? " Otherwise, it reverts to PBCC 5 behavior."
    ?
    ? " Consequently, the affected instructions would have to be emulated somehow, or"
    ? " we could use the more practical approach of fixing this data dynamically. This"
    ? " is where ConsoleInit comes in."
    ?
    ? " ConsoleInit works by updating PBCC's internal structure with proper data so"
    ? " that intrinsic PBCC functions would continue to work normally with an"
    ? " API-instantiated or attached console."
    ?

    IF AnyKey (BYVAL "Press any key to continue (X to exit)...") = "x" THEN GOTO ByeBye
    ?
    ? " --------"
    ? " | Demo |"
    ? " --------"
    ?
    ? " This program demonstrates implementing a new console instance using API &"
    ? " ConsoleInit."
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    ?
    IF AnyKey (BYVAL "Press any key to begin (X to exit)...") = "x" THEN GOTO ByeBye

    Stage1 ()

ByeBye:
    ?
    ? " Thank you for trying this demo, I'd appreciate any comments or suggestions!"
    ?
    WAITKEY$
    CURSOR ON
END FUNCTION
'------------------------------------------------------------------------------
Attached to this post is a RAR archive which contains all the code you see here plus the PBCC 5 & PBCC 6-compiled EXE's for both demo programs.
Attached Files
File Type: rar ConsoleInit.rar (46.4 KB, 27 views)
__________________
Hobbyist progammer

Last edited by Yuzree Esmera; Apr 13th, 2012 at 07:09 PM.
Reply With Quote
  #2  
Old Apr 13th, 2012, 09:30 PM
Mel Bishop Mel Bishop is online now
Member
 
Join Date: May 1999
Location: Portales, New Mexico
Posts: 3,365
Besides CON.NEW check out CON.END. Great for a temporary window.
__________________
There are no atheists in a fox hole or the morning of a math test.
Guns don't kill people. Abortions do.
When seconds count, the police are just minutes away.
If it doesn't fit, you're not using a big enough hammer.
The 2nd amendment: The original home land security bill.
If babies could speak, they'd be the most intelligent people on earth. (Heard on the Rush show).
Statistics are great until you become one of them.
What would happen if a vampire infected a werewolf or visa-a-vis.
Reply With Quote
  #3  
Old Apr 14th, 2012, 01:08 AM
Yuzree Esmera Yuzree Esmera is offline
Member
 
Join Date: Sep 2004
Location: Kuala Lumpur, Malaysia
Posts: 48
CON.END is really just FreeConsole() wrapped in PBCC
__________________
Hobbyist progammer
Reply With Quote
  #4  
Old Apr 16th, 2012, 10:34 AM
Mel Bishop Mel Bishop is online now
Member
 
Join Date: May 1999
Location: Portales, New Mexico
Posts: 3,365
Quote:
Originally Posted by Yuzree Esmera View Post
CON.END is really just FreeConsole() wrapped in PBCC
Still works.
__________________
There are no atheists in a fox hole or the morning of a math test.
Guns don't kill people. Abortions do.
When seconds count, the police are just minutes away.
If it doesn't fit, you're not using a big enough hammer.
The 2nd amendment: The original home land security bill.
If babies could speak, they'd be the most intelligent people on earth. (Heard on the Rush show).
Statistics are great until you become one of them.
What would happen if a vampire infected a werewolf or visa-a-vis.
Reply With Quote
Reply

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump


All times are GMT -4. The time now is 05:17 PM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.
Copyright 1999-2011 PowerBASIC, Inc. All Rights Reserved.
Error in my_thread_global_end(): 1 threads didn't exit