'****************************************************************************
'
'   PowerBASIC 3.0/3.2 Sourcen zur Nutzung des XMS-Speichers
'
'   entwickelt von / developed by   :  Thomas Gohel
'
'                           Fido    :  Thomas Gohel@2:2410/330.1
'                           InterNet:  author@pbsound.snafu.de
'                           Homepage:  http://www.snafu.de/~pbsound/
'
'****************************************************************************

$COMPILE EXE

TYPE EMBStruktur
        BlockLen     AS DWORD
        QuellHandle  AS WORD
        QuellOffset  AS WORD
        QuellSegment AS WORD
        ZielHandle   AS WORD
        ZielOffset   AS WORD
        ZielSegment  AS WORD
END TYPE

DIM HimemTreiber AS SHARED LONG
DIM XMS AS SHARED EMBStruktur

SHARED HimemCode%, ErrorCode%, Handle??
SHARED XMSSegment??, XMSOffset??, XMSBlockLen???
SHARED HimemHighVersion%, HimemLowVersion%, HimemHighRevision%, HimemLowRevision%

PUBLIC HimemCode%, HimemVersion%, HimemRevision%, HMAStatus%
PUBLIC EMBMaxBlock??, EMBGesamt??

CLS
PRINT
PRINT "**********************************************************************"
PRINT
PRINT " Diverse HIMEM.SYS Routinen in PowerBASIC 3.x
PRINT
PRINT "**********************************************************************"
PRINT

XMSCheck
XMSVersion
XMSGesamtFree
XMSGetBlock
DELAY 1
RAM2XMS
XMS2RAM
XMSFreeBlock
XMSGesamtFree
END

FUNCTION XMSCheck
        'Anfrage ob installiert
        ! mov ax, &h4300
        ! int &h2f
        ! mov HimemCode%, al
        IF HimemCode% = 128 THEN
            PRINT "XMS-Speicher installiert"
        ELSE
            PRINT "XMS-Speicher nicht installiert":END
        END IF

        ' Einsprungadresse holen
        ! mov ax, &h4310
        ! int &h2f
        ! mov HimemTreiber[02], es
        ! mov HimemTreiber[00], bx
END FUNCTION

FUNCTION XMSVersion
        'Version abfragen
        PRINT " ----------------------------------"
        ! mov ah,&h00
        ! call dword HimemTreiber
        ! mov HimemHighVersion%, ah
        ! mov HimemLowVersion%,  al
        ! mov HimemHighRevision%, bh
        ! mov HimemLowRevision%,  bl
        ! mov HMAStatus%, dx
        PRINT "Version             : "; HEX$(HimemHighVersion%);"."; HEX$(HimemLowVersion%)
        PRINT "Revision            : "; HEX$(HimemHighRevision%);"."; HEX$(HimemLowRevision%)
        PRINT "HMA-Status          : "; HMAStatus%; "   'fr verfgbar=1'"
END FUNCTION

FUNCTION XMSGesamtFree
        'frei EMB's abfragen
        ! mov ah,&h08
        ! call dword HimemTreiber
        ! mov EMBMaxBlock??, ax
        ! mov EMBGesamt??, dx
        PRINT "maximal freie Bl”cke:";EMBMaxBlock??;"* 1024 Byte"
        PRINT "gesamt freie Bl”cke :";EMBGesamt??;"* 1024 Byte"
END FUNCTION

FUNCTION XMSGetBlock
        ' einen EMB anfordern
        ! mov ah, &h09
        ! mov dx, 2
        ! call dword HimemTreiber
        ! mov HimemCode%, ax
        ! mov Handle??, dx
        IF HimemCode% = 1 THEN
            PRINT "EMB Handle          :"; Handle??
        ELSE
            PRINT "Fehler beim Anfordern"
        END IF
END FUNCTION

FUNCTION XMSFreeBlock
        'einen EMB wieder freigeben
        PRINT " ----------------------------------"
        ! mov ah, &h0A
        ! mov dx, Handle??
        ! call dword HimemTreiber
        ! mov HimemCode%, ax
        IF HimemCode% = 1 THEN
            PRINT "Ok, EMB wieder freigegeben"
        ELSE
            PRINT "Fehler beim freigeben"
        END IF
END FUNCTION

FUNCTION RAM2XMS
        'Kopiere vom RAM in den XMS Speicher
        PRINT "-----------------------------------"
        PRINT "--> Kopiere RAM in XMS Speicher <--"
        Test$ = "Dieser Text wurde von und in den XMS-Speicher kopiert!"
        XMSBlockLen??? = LEN(Test$)
        XMS.Blocklen     = XMSBlockLen???
        XMS.QuellHandle  = 0
        XMS.QuellSegment = STRSEG(Test$)
        XMS.QuellOffset  = STRPTR(Test$)
        XMS.ZielHandle   = Handle??
        XMS.ZielSegment  = 0
        XMS.ZielOffset   = 0
        XMSSegment?? = VARSEG(XMS.BlockLen)
        XMSOffset??  = VARPTR(XMS.BlockLen)
        PRINT "Adresse der Ext-Move-Struktur: ";HEX$(XMSSegment??); ":"; HEX$(XMSOffset??)
        ! push ds
        ! mov ah, &h0b
        ! mov si, XMSOffset??
        ! mov ds, XMSSegment??
        ! call dword HimemTreiber
        ! pop ds
        ! mov HimemCode%, ax
        ! mov ErrorCode%, bl
        PRINT "Fehler :" ; HimemCode%; " '1 fr OK (ist zwar komisch, aber eben MS)'"
        PRINT "ErrCode: "; HEX$(ErrorCode%)
END FUNCTION

FUNCTION XMS2RAM
        'Kopiere vom XMS Speicher in den RAM
        PRINT " ----------------------------------"
        PRINT "--> Kopiere XMS Speicher in RAM <--"
        Dest$ = SPACE$(XMSBlockLen???)       'L”schen des Strings und
                                             'reservieren des Speichers
        XMS.Blocklen     = XMSBlockLen???
        XMS.QuellHandle  = Handle??
        XMS.QuellSegment = 0
        XMS.QuellOffset  = 0
        XMS.ZielHandle   = 0
        XMS.ZielSegment  = STRSEG(Dest$)
        XMS.ZielOffset   = STRPTR(Dest$)
        XMSSegment?? = VARSEG(XMS.BlockLen)
        XMSOffset??  = VARPTR(XMS.BlockLen)
        PRINT "Adresse der Ext-Move-Struktur: ";HEX$(XMSSegment??); ":"; HEX$(XMSOffset??)
        ! push ds
        ! mov ah, &h0b
        ! mov si, XMSOffset??
        ! mov ds, XMSSegment??
        ! call dword HimemTreiber
        ! pop ds
        ! mov HimemCode%, ax
        ! mov ErrorCode%, bl
        PRINT "Fehler :" ; HimemCode%; " '1 fr OK (ist zwar komisch, aber eben MS)'"
        PRINT "ErrCode: "; HEX$(ErrorCode%)
        PRINT "Aus dem XMS kopierter String:
        COLOR 11, 0
        PRINT Dest$
        COLOR 7, 0
END FUNCTION