XProfan

def createfile(7)  !"kernel32.dll","CreateFileA"
def getlasterror(0)  !"kernel32.dll","GetLastError"
def FormatMessage(7) !"Kernel32.dll","FormatMessageA"
def EscapeCommFunction(2)  !"kernel32.dll","EscapeCommFunction"
def GetCommModemStatus(2)  !"kernel32.dll","GetCommModemStatus"
def &clrbreak 0
def &clrdtr 6
def &clrrts 4
def &setbreak 8
def &setdtr 5
def &setrts 3
def &setxoff 1
def &setxon 2
def &cts_on $10
def &dsr_on $20
def &ring_on $40
def &rlsd_on $80
declare hport&    porthandle
declare modemstatus&  Modemstatus
declare ret&, message#

Proc lasterrorstring   nur um den Text des letzten Fehlers von GetLastError zu bekommen

    dim message#,1029
    declare buffer&, flags&,source&,language&,arguments&, errorstring$
    buffer& = 1024
    flags& = $1000
    language& =  0 ~lang_neutral
    clear message#
    FormatMessage((flags&),addr(source&),GetLastError(),(language&),message#,addr(buffer&),addr(arguments&))
    errorstring$ = trim$(string$(message#,0))
    dispose message#
    return errorstring$

endproc

hport& = createfile("COM1",0,0,0,3,0,0)opencom("COM1",1024,1024)
print "Porthandle :",hport&
print
ret& = EscapeCommFunction(hport&,&setdtr)
print "DTR setzen"
case ret& = 0 : print "Fehler"
print lasterrorstring()
-----am besten einen Schalter zwischen DTR und z.B. CTS setzen
ret& = GetCommModemStatus(hport&,addr(modemstatus&))
print
print "Status der Eingänge ermitteln"
case ret& = 0 : print "Fehler"
print lasterrorstring()
-----Maskierung um an die einzelnen Bits zu kommen

if ret&

    casenot modemstatus& & $FF : print "alles auf LOW"
    case modemstatus& & &cts_on  : print "CTS ON"
    case modemstatus& & &dsr_on  : print "DSR ON"
    case modemstatus& & &ring_on : print "Ring ON"
    case modemstatus& & &rlsd_on : print "RLSD ON"

endif

waitinput
print "Start"
declare zeit&,stop&,count&
zeit& = &gettickcount

whilenot stop&

    whileloop 10

        ret& = GetCommModemStatus(hport&,addr(modemstatus&))
        print modemstatus&,"";
        inc count&

    endwhile

    sleep 1
    case &gettickcount - zeit& > 50 : stop& = 1

endwhile

print ""
print &gettickcount - zeit&
print "durchläufe :",count&
closecom(hport&)waitinput

decimals 0
Def QPF(1 )!"KERNEL32","QueryPerformanceFrequency"   rückgabe als LARGE_INTEGER
Def QPC(1 )!"KERNEL32","QueryPerformanceCounter"     rückgabe als LARGE_INTEGER
Declare time#
dim time#,8
declare cpu!

proc laint2float   wandelt einen longintiger in einen fload um / leider recht zeitintensiv

    parameters t&
    declare t#,ta&
    dim t#,8
    declare z!
    ta& = t#   adresse speichern
    t# = t&

    whileloop 8

        z! = z! + byte(t#,&loop-1)*(Pow(256,&loop-1))

    endwhile

    t# = ta&   wieder die alte adresse zuweisen
    dispose t#
    return z!

endproc

if qpf(time#)

    print "es gibt einen QueryPerformanceCounter"
    cpu! = laint2float(time#)

else

    print "es gibt keinen QueryPerformanceCounter !"
    waitinput
    end

endif

print "HiPerfFreq.: ",cpu!
settimer 1

WhileLoop 20

    qpc(time#)
    AddString str$(laint2float(time#))+"  wert in ms: "+str$(laint2float(time#)/cpu!*1000)
    waitinput  bedarfsweise auskommentieren dann dauert ein schleifendurchlauf 1-2 ms

Wend

ListBox$("QueryPerformanceCounter"2)