2002-09-06 22:45

' COMPort.BAS - John White (danilo_yoingco@yahoo.co.uk). This code is
' based on previous RapidQ COMPort codes and various Internet codes I
' have looked at.

' There are still 2 functions left to do. But the rest are here.
'
' DeviceControl() - I still need to find out the value of
'                   IOCTL_SERIAL_LSRMST_INSERT.
'
' ConfigDialog()  - I still need to verify how its data is correctly
'                   contructed.

' mem_Default:  0 - 79     DCB Structure
'               100        1 Byte for DeviceIOControl
'               200-499    WriteFile buffer
'               500-799    ReadFile buffer
'               800-1099   COMMCONFIG Structure
'               1100-1399  COMMPROP Structure

' EV_RING is a Documented BUG. To get around it just OR another EV_
' with it so if it does not return the other EV_ will.

     $OPTIMIZE ON
     $APPTYPE CONSOLE
     $TYPECHECK ON
     $ESCAPECHARS ON

     CONST GMEM_FIXED=0
     CONST GMEM_MOVEABLE=2
     CONST GMEM_ZEROINIT=64
     CONST GMEM_INVALID_HANDLE=&H8000
     CONST INVALID_HANDLE_VALUE=-1
     CONST PURGE_TXABORT=1
     CONST PURGE_RXABORT=2
     CONST PURGE_TXCLEAR=4
     CONST PURGE_RXCLEAR=8
     CONST LPTx=&H80
     CONST MAXDWORD=&HFFFF
     CONST CREATE_NEW=1
     CONST CREATE_ALWAYS=2
     CONST OPEN_EXISTING=3
     CONST OPEN_ALWAYS=4
     CONST TRUNCATE_EXISTING=5
     CONST GENERIC_READ=&H80000000
     CONST GENERIC_WRITE=&H40000000
     CONST FILE_SHARE_READ=1
     CONST FILE_SHARE_WRITE=2
     CONST FILE_ATTRIBUTE_NORMAL=&H80
     CONST FILE_FLAG_OVERLAPPED=&H40000000
     CONST CBR_110=110
     CONST CBR_300=300
     CONST CBR_600=600
     CONST CBR_1200=1200
     CONST CBR_2400=2400
     CONST CBR_4800=4800
     CONST CBR_9600=9600
     CONST CBR_14400=14400
     CONST CBR_19200=19200
     CONST CBR_38400=38400
     CONST CBR_56000=56000
     CONST CBR_57600=57600
     CONST CBR_115200=115200
     CONST CBR_128000=128000
     CONST CBR_256000=256000
     CONST EV_RXCHAR=1
     CONST EV_RXFLAG=2
     CONST EV_TXEMPTY=4
     CONST EV_CTS=8
     CONST EV_DSR=16
     CONST EV_RLSD=32
     CONST EV_BREAK=64
     CONST EV_ERR=128
     CONST EV_RING=256
     CONST EV_PERR=512
     CONST EV_RX80FULL=1024
     CONST EV_EVENT1=2048
     CONST EV_EVENT2=4096
     CONST DTR_CONTROL_DISABLE=0
     CONST DTR_CONTROL_ENABLE=1
     CONST DTR_CONTROL_HANDSHAKE=2
     CONST RTS_CONTROL_DISABLE=0
     CONST RTS_CONTROL_ENABLE=1
     CONST RTS_CONTROL_HANDSHAKE=2
     CONST RTS_CONTROL_TOGGLE=3
     CONST NOPARITY=0
     CONST ODDPARITY=1
     CONST EVENPARITY=2
     CONST MARKPARITY=3
     CONST SPACEPARITY=4
     CONST ONESTOPBIT=0
     CONST ONE5STOPBITS=1
     CONST TWOSTOPBITS=2
     CONST ERROR_IO_INCOMPLETE=996
     CONST ERROR_IO_PENDING=997
     CONST IGNORE_SIGNAL=0
     CONST INFINITE_TIMEOUT=&HFFFF
     CONST CE_RXOVER=1
     CONST CE_OVERRUN=2
     CONST CE_RXPARITY=4
     CONST CE_FRAME=8
     CONST CE_BREAK=16
     CONST CE_TXFULL=&H100
     CONST CE_PTO=&H200
     CONST CE_IOE=&H400
     CONST CE_DNS=&H800
     CONST CE_OOP=&H1000
     CONST CE_MODE=&H8000
     CONST PST_UNSPECIFIED=0
     CONST PST_RS232=1
     CONST PST_PARALLELPORT=2
     CONST PST_RS422=3
     CONST PST_RS423=4
     CONST PST_RS449=5
     CONST PST_MODEM=6
     CONST PST_FAX=&H21
     CONST PST_SCANNER=&H22
     CONST PST_NETWORK_BRIDGE=&H100
     CONST PST_LAT=&H101
     CONST PST_TCPIP_TELNET=&H102
     CONST PST_X25=&H103
     CONST PCF_DTRDSR=1
     CONST PCF_RTSCTS=2
     CONST PCF_RLSD=4
     CONST PCF_PARITY_CHECK=8
     CONST PCF_XONXOFF=16
     CONST PCF_SETXCHAR=32
     CONST PCF_TOTALTIMEOUTS=64
     CONST PCF_INTTIMEOUTS=128
     CONST PCF_SPECIALCHARS=256
     CONST PCF_16BITMODE=512
     CONST SP_PARITY=1
     CONST SP_BAUD=2
     CONST SP_DATABITS=4
     CONST SP_STOPBITS=8
     CONST SP_HANDSHAKING=16
     CONST SP_PARITY_CHECK=32
     CONST SP_RLSD=64
     CONST SP_SERIALCOMM=1
     CONST DATABITS_5=1
     CONST DATABITS_6=2
     CONST DATABITS_7=4
     CONST DATABITS_8=8
     CONST DATABITS_16=16
     CONST DATABITS_16X=32
     CONST STOPBITS_10=1
     CONST STOPBITS_15=2
     CONST STOPBITS_20=4
     CONST PARITY_NONE=&H100
     CONST PARITY_ODD=&H200
     CONST PARITY_EVEN=&H400
     CONST PARITY_MARK=&H800
     CONST PARITY_SPACE=&H1000
     CONST MS_CTS_ON=16
     CONST MS_DSR_ON=32
     CONST MS_RING_ON=64
     CONST MS_RLSD_ON=128
     CONST WAIT_OBJECT_0=0
     CONST WAIT_ABANDONED_0=128
     CONST WAIT_TIMEOUT=258
     CONST WAIT_FAILED=&HFFFFFFFF
     CONST SETXOFF=1
     CONST SETXON=2
     CONST SETRTS=3
     CONST CLRRTS=4
     CONST SETDTR=5
     CONST CLRDTR=6
     CONST RESETDEV=7
     CONST SETBREAK=8
     CONST CLRBREAK=9
     CONST BAUD_075=1
     CONST BAUD_110=2
     CONST BAUD_134_5=4
     CONST BAUD_150=8
     CONST BAUD_300=16
     CONST BAUD_600=32
     CONST BAUD_1200=64
     CONST BAUD_1800=128
     CONST BAUD_2400=256
     CONST BAUD_4800=512
     CONST BAUD_7200=1024
     CONST BAUD_9600=2048
     CONST BAUD_14400=4096
     CONST BAUD_19200 = &H2000&
     CONST BAUD_38400 = &H4000&
     CONST BAUD_56K = &H8000&
     CONST BAUD_128K = &H10000
     CONST BAUD_115200 = &H20000
     CONST BAUD_57600 = &H40000
     CONST BAUD_USER = &H10000000
     CONST IOCTL_SERIAL_LSRMST_INSERT=66

     DECLARE FUNCTION BuildCommDCB LIB "kernel32.dll" ALIAS "BuildCommDCBA" (dcbString AS STRING, dcb AS LONG) AS LONG
     DECLARE FUNCTION BuildCommDCBAndTimeouts LIB "kernel32.dll" ALIAS "BuildCommDCBAndTimeoutsA" (dcbString AS STRING, dcb AS LONG, timeouts AS LONG) AS LONG
     DECLARE FUNCTION ClearCommBreak LIB "kernel32.dll" ALIAS "ClearCommBreak" (handle AS LONG) AS LONG
     DECLARE FUNCTION ClearCommError LIB "kernel32.dll" ALIAS "ClearCommError" (handle AS LONG, errors AS LONG, status AS LONG) AS LONG
     DECLARE FUNCTION CloseHandle LIB "kernel32.dll" ALIAS "CloseHandle" (hObject AS LONG) AS LONG
     DECLARE FUNCTION CommConfigDialog LIB "kernel32.dll" ALIAS "CommConfigDialogA" (name AS STRING, hWnd AS LONG, config AS LONG) AS LONG
     DECLARE SUB CopyMemory LIB "kernel32.dll" ALIAS "RtlMoveMemory" (BYVAL dest AS LONG, BYVAL source AS LONG, BYVAL numBytes AS LONG)
     DECLARE FUNCTION CreateEvent LIB "kernel32.dll" ALIAS "CreateEventA" (security AS LONG, manualReset AS LONG, initialState AS LONG, name AS STRING) AS LONG
     DECLARE FUNCTION CreateFile LIB "kernel32.dll" ALIAS "CreateFileA" (fileName AS STRING, access AS LONG, shareMode AS LONG, security AS LONG, creation AS LONG, flags AS LONG, template AS LONG) AS LONG
     DECLARE FUNCTION DeviceIoControl LIB "kernel32.dll" ALIAS "DeviceIoControl" (hDevice AS LONG, controlCode AS LONG, inBuffer AS LONG, inBufSize AS LONG, outBuffer AS LONG, outBufSize AS LONG, returned AS LONG, overlapped AS LONG) AS LONG
     DECLARE FUNCTION EscapeCommFunction LIB "kernel32.dll" ALIAS "EscapeCommFunction" (handle AS LONG, fcode AS LONG) AS LONG
     DECLARE FUNCTION GetCommConfig LIB "kernel32.dll" ALIAS "GetCommConfig" (handle AS LONG, config AS LONG, configSize AS LONG) AS LONG
     DECLARE FUNCTION GetCommMask LIB "kernel32.dll" ALIAS "GetCommMask" (handle AS LONG, mask AS LONG) AS LONG
     DECLARE FUNCTION GetCommModemStatus LIB "kernel32.dll" ALIAS "GetCommModemStatus" (handle AS LONG, modemStatus AS LONG) AS LONG
     DECLARE FUNCTION GetCommProperties LIB "kernel32.dll" ALIAS "GetCommProperties" (handle AS LONG, properties AS LONG) AS LONG
     DECLARE FUNCTION GetCommState LIB "kernel32.dll" ALIAS "GetCommState" (handle AS LONG, dcbBuf AS LONG) AS LONG
     DECLARE FUNCTION GetCommTimeouts LIB "kernel32.dll" ALIAS "GetCommTimeouts" (handle AS LONG, timeouts AS LONG) AS LONG
     DECLARE FUNCTION GetLastError LIB "kernel32.dll" ALIAS "GetLastError" () AS LONG
     DECLARE FUNCTION GetOverlappedResult LIB "kernel32.dll" ALIAS "GetOverlappedResult" (handle AS LONG, overlapped AS LONG, bytesTrans AS LONG, waitFlag AS LONG) AS LONG
     DECLARE FUNCTION GlobalAlloc LIB "kernel32.dll" ALIAS "GlobalAlloc" (flags AS LONG, numBytes AS LONG) AS LONG
     DECLARE FUNCTION GlobalFree LIB "kernel32.dll" ALIAS "GlobalFree" (hMem AS LONG) AS LONG
     DECLARE FUNCTION GlobalLock LIB "kernel32.dll" ALIAS "GlobalLock" (hMem AS LONG) AS LONG
     DECLARE FUNCTION GlobalUnlock LIB "kernel32.dll" ALIAS "GlobalUnlock" (hMem AS LONG) AS LONG
     DECLARE FUNCTION PurgeComm LIB "kernel32.dll" ALIAS "PurgeComm" (handle AS LONG, action AS LONG) AS LONG
     DECLARE FUNCTION ReadFile LIB "kernel32.dll" ALIAS "ReadFile" (hFile AS LONG, buffer AS LONG, bytesToRead AS LONG, bytesRead AS LONG, overlapped AS LONG) AS LONG
     DECLARE FUNCTION ResetEvent LIB "kernel32.dll" ALIAS "ResetEvent" (hEvent AS LONG) AS LONG
     DECLARE FUNCTION SetCommBreak LIB "kernel32.dll" ALIAS "SetCommBreak" (handle AS LONG) AS LONG
     DECLARE FUNCTION SetCommConfig LIB "kernel32.dll" ALIAS "SetCommConfig" (handle AS LONG, config AS LONG, configSize AS LONG) AS LONG
     DECLARE FUNCTION SetCommMask LIB "kernel32.dll" ALIAS "SetCommMask" (handle AS LONG, mask AS LONG) AS LONG
     DECLARE FUNCTION SetCommState LIB "kernel32.dll" ALIAS "SetCommState" (hCommDev AS LONG, dcbBuf AS LONG) AS LONG
     DECLARE FUNCTION SetCommTimeouts LIB "kernel32.dll" ALIAS "SetCommTimeouts" (handle AS LONG, timeouts AS LONG) AS LONG
     DECLARE FUNCTION SetEvent LIB "kernel32.dll" ALIAS "SetEvent" (hEvent AS LONG) AS LONG
     DECLARE FUNCTION SetupComm LIB "kernel32.dll" ALIAS "SetupComm" (handle AS LONG, inSize AS LONG, outSize AS LONG) AS LONG
     DECLARE FUNCTION TransmitCommChar LIB "kernel32.dll" ALIAS "TransmitCommChar" (handle AS LONG, character AS BYTE) AS LONG
     DECLARE FUNCTION WaitCommEvent LIB "kernel32.dll" ALIAS "WaitCommEvent" (handle AS LONG, eventMask AS LONG, overlapped AS LONG) AS LONG
     DECLARE FUNCTION WaitForSingleObject LIB "kernel32.dll" ALIAS "WaitForSingleObject" (hObject AS LONG, timeout AS LONG) AS LONG
     DECLARE FUNCTION WriteFile LIB "kernel32.dll" ALIAS "WriteFile" (hFile AS LONG, buffer AS LONG, bytesToWrite AS LONG, bytesWritten AS LONG, overlapped AS LONG) AS LONG

' COMPort Variables.
     DIM COMPort_Handle AS LONG, comMask AS LONG, modemStatus AS LONG
     DIM mem_Lock AS LONG, mem_Memory AS LONG, mem_Default AS LONG
     DIM mem_Offset AS LONG

' COMPort Memory Structures/Buffers.
     DIM timeouts(0 TO 4) AS LONG, overlap(0 TO 4) AS LONG
     DIM comStatus(0 TO 9) AS LONG

' Generic Variables.
     DIM rtn AS LONG, rtnval AS LONG, stg$ AS STRING, count AS LONG
     DIM FLong AS LONG, FWord AS WORD, FByte AS BYTE, FDWord AS LONG
     DIM form AS QFORM

     SUB UnLock_DefaultMemory
      IF mem_Lock<>0 THEN
       rtn=GlobalUnlock(mem_Lock)
       IF ((rtn=0) AND (GetLastError()=0)) THEN
'MEM UNLOCKED
       ELSE
'MEM NOT UNLOCK
       END IF
      END IF
     END SUB

     SUB Free_DefaultMemory
      IF mem_Memory<>0 THEN
       rtn=GlobalFree(mem_Memory)
       IF rtn=0 THEN
'MEM FREED
       ELSE
'MEM NOT FREED
       END IF
      END IF
     END SUB

     SUB Alloc_DefaultMemory(bufsize AS LONG)
      mem_Lock=0
      mem_Memory=0
      mem_Default=0
      mem_Memory=GlobalAlloc(GMEM_MOVEABLE OR GMEM_ZEROINIT, bufsize)
      IF mem_Memory<>0 THEN
       mem_Lock=GlobalLock(mem_Memory)
       IF mem_Lock<>0 THEN
        mem_Default=mem_Lock

       END IF
      END IF
     END SUB

     SUB Close_Handle(handle AS LONG)
      IF handle<>0 THEN
       rtn=CloseHandle(handle)
       IF rtn<>0 THEN
        PRINT "Handle - Closed"
       ELSE
        PRINT "Handle - NOT Closed"
       END IF
      END IF
     END SUB

     SUB Configuration_Dialog(dname$ AS STRING)
      rtn=CommConfigDialog(dname$, 0, mem_Default+800)
      IF rtn<>0 THEN

      ELSE
       PRINT "Dialog Error"+STR$(getlasterror())
      END IF
     END SUB

     SUB Escape_Function(handle AS LONG, fcode AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=EscapeCommFunction(handle, fcode)
       IF rtn<>0 THEN
        PRINT "Escape Function - Okay"
       ELSE
        PRINT "Escape Function - Error"
       END IF
      END IF
     END SUB

     SUB Device_IOControl(handle AS LONG, useOverlap AS BYTE)
      IF handle<>INVALID_HANDLE_VALUE THEN
       IF useOverlap=1 THEN
        rtn=DeviceIOControl(handle, IOCTL_SERIAL_LSRMST_INSERT, mem_Default+100, 1, 0, 0, VARPTR(rtnval), @overlap(0))
       ELSE
        rtn=DeviceIOControl(handle, IOCTL_SERIAL_LSRMST_INSERT, mem_Default+100, 1, 0, 0, VARPTR(rtnval), 0)
       END IF
       IF rtn<>0 THEN

       ELSE
        PRINT "DeviceIOControl - Error"+STR$(getlasterror())
       END IF
      END IF
     END SUB

     SUB Get_ModemStatus(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=GetCommModemStatus(handle, VARPTR(modemStatus))
       IF rtn<>0 THEN
        PRINT "Modem Status - Got"
       ELSE
        PRINT "Modem Status - NOT Gotten"
       END IF
      END IF
     END SUB

     SUB Show_DriverProperties
      PRINT
      PRINT "*** PROPERTIES ***"
      CopyMemory VARPTR(FWord), mem_Default+1100, 2
      PRINT "Packet Length: ";HEX$(FWord)
      CopyMemory VARPTR(FWord), mem_Default+1102, 2
      PRINT "Packet Version: ";HEX$(FWord)
      CopyMemory VARPTR(FLong), mem_Default+1104, 4
      PRINT "Services Mask";HEX$(FLong)
      CopyMemory VARPTR(FLong), mem_Default+1112, 4
      PRINT "MAX. Internal Output-Buffer Size (0 = No Limit): ";HEX$(FLong)
      CopyMemory VARPTR(FLong), mem_Default+1116, 4
      PRINT "MAX. Internal Input-Buffer Size (0 = No Limit): ";HEX$(FLong)
      CopyMemory VARPTR(FLong), mem_Default+1120, 4
      PRINT "MAX. Baud Rate (&H10000000 = User Defineable): ";HEX$(FLong)
      CopyMemory VARPTR(FLong), mem_Default+1124, 4
      PRINT "Provider Type: ";HEX$(FLong)
      CopyMemory VARPTR(FLong), mem_Default+1128, 4
      PRINT "Capabilities: ";HEX$(FLong)
      CopyMemory VARPTR(FLong), mem_Default+1132, 4
      PRINT "Settable Parameters: ";HEX$(FLong)
      CopyMemory VARPTR(FLong), mem_Default+1136, 4
      PRINT "Allowable Baud Rates: ";HEX$(FLong)
      CopyMemory VARPTR(FWord), mem_Default+1140, 2
      PRINT "Number of Data Bits that can be Set: ";HEX$(FWord)
      CopyMemory VARPTR(FWord), mem_Default+1142, 2
      PRINT "Stop Bits and Parity that can be Selected: ";HEX$(FWord)
      CopyMemory VARPTR(FLong), mem_Default+1144, 4
      PRINT "Current Internal Output Buffer Size (0 = Unavailable): ";HEX$(FLong)
      CopyMemory VARPTR(FLong), mem_Default+1148, 4
      PRINT "Current Internal Input Buffer Size (0 = Unavailable): ";HEX$(FLong)
      PRINT
      PRINT
     END SUB

     SUB Get_DriverProperties(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=GetCommProperties(handle, mem_Default+1100)
       IF rtn<>0 THEN
        PRINT "Properties - Got"
       ELSE
        PRINT "Properties - NOT Gotten"
       END IF
      END IF
     END SUB

     SUB Set_Configuration(handle AS LONG, bufSize AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=SetCommConfig(handle, mem_Default+800, bufSize)
       IF rtn<>0 THEN
        PRINT "Config - Set"
       ELSE
        PRINT "Config - NOT Set"
       END IF
      END IF
     END SUB

     SUB Get_Configuration(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=GetCommConfig(handle, mem_Default+800, VARPTR(rtnval))
       IF rtn<>0 THEN
        PRINT "Config - Got"
       ELSE
        PRINT "Config - NOT Gotten"
       END IF
      END IF
     END SUB

     SUB Clear_Error(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=ClearCommError(handle, VARPTR(rtnval), @comStatus(0))
       IF rtn<>0 THEN
        PRINT "Error - Cleared"
       ELSE
        PRINT "Error - NOT Cleared"
       END IF
      END IF
     END SUB

     SUB Clear_TransmissionBreak(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=ClearCommBreak(handle)
       IF rtn<>0 THEN
        PRINT "Break - Cleared"
       ELSE
        PRINT "Break - NOT Cleared"
       END IF
      END IF
     END SUB

     SUB Set_TransmissionBreak(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=SetCommBreak(handle)
       IF rtn<>0 THEN
        PRINT "Break - Set"
       ELSE
        PRINT "Break - NOT Set"
       END IF
      END IF
     END SUB

     SUB Build_DCBAndTimeouts(dcbString AS STRING)
      rtn=BuildCommDCBAndTimeouts(dcbString, mem_Default, @timeouts(0))
      IF rtn<>0 THEN
       PRINT "DCBAndTimeouts - Built"
      ELSE
       PRINT "DCBAndTimeouts - NOT Built"
      END IF
     END SUB

     SUB Build_DCB(dcbString AS STRING)
      rtn=BuildCommDCB(dcbString, mem_Default)
      IF rtn<>0 THEN
       PRINT "DCB - Built"
      ELSE
       PRINT "DCB - NOT Built"
      END IF
     END SUB

     SUB Read_COMPort(handle AS LONG, bufSize AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=ReadFile(handle, mem_Default+500, bufSize, VARPTR(rtnval), 0)
       IF rtn<>0 THEN
        PRINT "read"
       ELSE
        PRINT STR$(getlasterror())
       END IF
      END IF
     END SUB

     SUB Write_COMPort(handle AS LONG, bufSize AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=WriteFile(handle, mem_Default+200, bufSize, VARPTR(rtnval), 0)
       IF rtn<>0 THEN
        PRINT "written"
       ELSE
        PRINT STR$(getlasterror())
       END IF
      END IF
     END SUB

     SUB Get_OverlapResult(handle AS LONG, waitFlag AS LONG, signalState AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       IF signalState=1 THEN
        rtn=ResetEvent(@overlap(4))
        IF rtn<>0 THEN
         PRINT "ResetEvent - Okay"
        ELSE
         PRINT "ResetEvent - Failed"
        END IF
       END IF
       rtn=GetOverlappedResult(handle, @overlap(0), VARPTR(rtnval), waitFlag)
       IF rtn<>0 THEN
        PRINT "Pending Event - Finished"
       ELSE
        PRINT "Pending Event - NOT Finished"
       END IF
      END IF
     END SUB

     SUB Wait_OverlappedEvent(handle AS LONG, waitFlag AS LONG, signalState AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=WaitCommEvent(handle, VARPTR(rtnval), @overlap(0))
       IF rtn<>0 THEN
        PRINT "WaitEvent - Finished: "

        IF (rtnval AND EV_CTS)=EV_CTS THEN
         PRINT "EV_CTS - Received"
        END IF
        IF (rtnval AND EV_DSR)=EV_DSR THEN
         PRINT "EV_DSR - Received"
        END IF

       ELSE
        IF getlasterror()=ERROR_IO_PENDING THEN
         Get_OverlapResult(handle, waitFlag, signalState)
        ELSE
         PRINT "Event Error: "+STR$(getlasterror())
        END IF
       END IF
      END IF
     END SUB

     SUB Create_WaitEvent(handle AS LONG, waitFlag AS LONG, manualReset AS LONG, signalState AS LONG, objName AS STRING)
      overlap(4)=CreateEvent(0, manualReset, signalState, objName)
      IF overlap(4)<>0 THEN
       overlap(0)=0
       overlap(1)=0
       overlap(2)=0
       overlap(3)=0
       PRINT "Event - Created"
       Wait_OverlappedEvent(handle, waitFlag, signalState)
      ELSE
       PRINT "Event - NOT Created"
      END IF
     END SUB

     SUB Wait_NOEvent(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=WaitCommEvent(handle, VARPTR(rtnval), 0)
       IF rtn<>0 THEN
        PRINT "WaitEvent - Finished: "

        IF (rtnval AND EV_CTS)=EV_CTS THEN
         PRINT "EV_CTS - Received"
        END IF
        IF (rtnval AND EV_DSR)=EV_DSR THEN
         PRINT "EV_DSR - Received"
        END IF
        IF (rtnval AND EV_RING)=EV_DSR THEN
         PRINT "EV_RING - Received"
        END IF

       ELSE
        PRINT "Event Error: "+STR$(getlasterror())
       END IF
      END IF
     END SUB

     SUB Wait_ForEvent(handle AS LONG, timeout AS LONG)
      rtn=WaitForSingleObject(handle, timeout)
      IF rtn<>WAIT_FAILED THEN
       PRINT "WaitForSingleObject - Okay"
      ELSE
       PRINT "WaitForSingleObject - Failed"
      END IF
     END SUB

     SUB Create_OverlappedEvent(manualReset AS LONG, signalState AS LONG, objName AS STRING)
      overlap(4)=CreateEvent(0, manualReset, signalState, objName)
      IF overlap(4)<>0 THEN
       overlap(0)=0
       overlap(1)=0
       overlap(2)=0
       overlap(3)=0
       PRINT "Event - Created"
      ELSE
       PRINT "Event - NOT Created"
      END IF
     END SUB

     SUB TransmitCharacter(handle AS LONG, Character AS BYTE)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=TransmitCommChar(handle, Character)
       IF rtn<>0 THEN
        PRINT "Character - Transmitted"
       ELSE
        PRINT "Character - NOT Transmitted"
       END IF
      END IF
     END SUB

     SUB Set_ComMask(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=SetCommMask(handle, comMask)
       IF rtn<>0 THEN
        PRINT "COMPort Mask - Set"
       ELSE
        PRINT "COMPort Mask - NOT Set"
       END IF
      END IF
     END SUB

     SUB Get_ComMask(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=GetCommMask(handle, VARPTR(comMask))
       IF rtn<>0 THEN
        PRINT "COMPort Mask - Got"
       ELSE
        PRINT "COMPort Mask - NOT Gotten"
       END IF
      END IF
     END SUB

     SUB Get_EventChar
      CopyMemory VARPTR(FByte), mem_Default+77, 1
     END SUB

     SUB Get_EODChar
      CopyMemory VARPTR(FByte), mem_Default+76, 1
     END SUB

     SUB Get_ParityErrorChar
      CopyMemory VARPTR(FByte), mem_Default+75, 1
     END SUB

     SUB Get_XOffChar
      CopyMemory VARPTR(FByte), mem_Default+74, 1
     END SUB

     SUB Get_XOnChar
      CopyMemory VARPTR(FByte), mem_Default+73, 1
     END SUB

     SUB Get_StopBits
      CopyMemory VARPTR(FByte), mem_Default+72, 1
     END SUB

     SUB Get_ParityBits
      CopyMemory VARPTR(FByte), mem_Default+71, 1
     END SUB

     SUB Get_ByteSize
      CopyMemory VARPTR(FByte), mem_Default+70, 1
     END SUB

     SUB Get_XOffLimit
      CopyMemory VARPTR(FWord), mem_Default+68, 2
     END SUB

     SUB Get_XOnLimit
      CopyMemory VARPTR(FWord), mem_Default+66, 2
     END SUB

     SUB Get_AbortOnError
      CopyMemory VARPTR(FLong), mem_Default+56, 4
     END SUB

     SUB Get_RTSControl
      CopyMemory VARPTR(FLong), mem_Default+52, 4
     END SUB

     SUB Get_NullMode
      CopyMemory VARPTR(FLong), mem_Default+48, 4
     END SUB

     SUB Get_ErrorCharMode
      CopyMemory VARPTR(FLong), mem_Default+44, 4
     END SUB

     SUB Get_InXControl
      CopyMemory VARPTR(FLong), mem_Default+40, 4
     END SUB

     SUB Get_OutXControl
      CopyMemory VARPTR(FLong), mem_Default+36, 4
     END SUB

     SUB Get_TXContinue
      CopyMemory VARPTR(FLong), mem_Default+32, 4
     END SUB

     SUB Get_DSRSensitivity
      CopyMemory VARPTR(FLong), mem_Default+28, 4
     END SUB

     SUB Get_DTRControlFlow
      CopyMemory VARPTR(FLong), mem_Default+24, 4
     END SUB

     SUB Get_DSROutputFlow
      CopyMemory VARPTR(FLong), mem_Default+20, 4
     END SUB

     SUB Get_CTSOutputFlow
      CopyMemory VARPTR(FLong), mem_Default+16, 4
     END SUB

     SUB Get_ParityChecking
      CopyMemory VARPTR(FLong), mem_Default+12, 4
     END SUB

     SUB Get_BinaryMode
      CopyMemory VARPTR(FLong), mem_Default+8, 4
     END SUB

     SUB Get_BaudRate
      CopyMemory VARPTR(FLong), mem_Default+4, 4
     END SUB

     SUB Get_DCBSize
      CopyMemory VARPTR(FLong), mem_Default, 4
     END SUB

     SUB Set_ComState(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=SetCommState(handle, mem_Default)
       IF rtn<>0 THEN
        PRINT "COMPort State - Set"
       ELSE
        PRINT "COMPort State - NOT Set"
       END IF
      END IF
     END SUB

     SUB Set_EventChar(value AS BYTE)
      FByte=value
      CopyMemory mem_Default+77, VARPTR(FByte), 1
     END SUB

     SUB Set_EODChar(value AS BYTE)
      FByte=value
      CopyMemory mem_Default+76, VARPTR(FByte), 1
     END SUB

     SUB Set_ParityErrorChar(value AS BYTE)
      FByte=value
      CopyMemory mem_Default+75, VARPTR(FByte), 1
     END SUB

     SUB Set_XOffChar(value AS BYTE)
      FByte=value
      CopyMemory mem_Default+74, VARPTR(FByte), 1
     END SUB

     SUB Set_XOnChar(value AS BYTE)
      FByte=value
      CopyMemory mem_Default+73, VARPTR(FByte), 1
     END SUB

     SUB Set_StopBits(bits AS BYTE)
      FByte=bits
      CopyMemory mem_Default+72, VARPTR(FByte), 1
     END SUB

     SUB Set_ParityBits(bits AS BYTE)
      FByte=bits
      CopyMemory mem_Default+71, VARPTR(FByte), 1
     END SUB

     SUB Set_ByteSize(byteSize AS BYTE)
      FByte=byteSize
      CopyMemory mem_Default+70, VARPTR(FByte), 1
     END SUB

     SUB Set_XOffLimit(mode AS LONG)
      FWord=mode
      CopyMemory mem_Default+68, VARPTR(FWord), 2
     END SUB

     SUB Set_XOnLimit(mode AS LONG)
      FWord=mode
      CopyMemory mem_Default+66, VARPTR(FWord), 2
     END SUB

     SUB Set_AbortOnError(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+56, VARPTR(FLong), 4
     END SUB

     SUB Set_RTSControl(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+52, VARPTR(FLong), 4
     END SUB

     SUB Set_NullMode(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+48, VARPTR(FLong), 4
     END SUB

     SUB Set_ErrorCharMode(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+44, VARPTR(FLong), 4
     END SUB

     SUB Set_InXControl(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+40, VARPTR(FLong), 4
     END SUB

     SUB Set_OutXControl(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+36, VARPTR(FLong), 4
     END SUB

     SUB Set_TXContinue(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+32, VARPTR(FLong), 4
     END SUB

     SUB Set_DSRSensitivity(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+28, VARPTR(FLong), 4
     END SUB

     SUB Set_DTRControlFlow(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+24, VARPTR(FLong), 4
     END SUB

     SUB Set_DSROutputFlow(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+20, VARPTR(FLong), 4
     END SUB

     SUB Set_CTSOutputFlow(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+16, VARPTR(FLong), 4
     END SUB

     SUB Set_ParityChecking(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+12, VARPTR(FLong), 4
     END SUB

     SUB Set_BinaryMode(mode AS LONG)
      FLong=mode
      CopyMemory mem_Default+8, VARPTR(FLong), 4
     END SUB

     SUB Set_BaudRate(rate AS LONG)
      FLong=rate
      CopyMemory mem_Default+4, VARPTR(FLong), 4
     END SUB

     SUB Set_DCBSize(dcbSize AS LONG)
      FLong=dcbSize
      CopyMemory mem_Default, VARPTR(FLong), 4
     END SUB

     SUB Get_ComState(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=GetCommState(handle, mem_Default)
       IF rtn<>0 THEN
        PRINT "COMPort State - Get"
       ELSE
        PRINT "COMPort State - NOT Get"
       END IF
      END IF
     END SUB

     SUB Set_ComTimeouts(handle AS LONG, readIntervalTimeout AS LONG, readTotalMultiplier AS LONG, readTotalConstant AS LONG, writeTotalMultiplier AS LONG, writeTotalConstant AS LONG)
      timeouts(0)=readIntervalTimeout
      timeouts(1)=readTotalMultiplier
      timeouts(2)=readTotalConstant
      timeouts(3)=writeTotalMultiplier
      timeouts(4)=writeTotalConstant
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=SetCommTimeouts(handle, @timeouts(0))
       IF rtn<>0 THEN
        PRINT "COMPort Timeouts - Set"
       ELSE
        PRINT "COMPort Timeouts - NOT Set"
       END IF
      END IF
     END SUB

     SUB Get_ComTimeouts(handle AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=GetCommTimeouts(handle, @timeouts(0))
       IF rtn<>0 THEN
        PRINT "COMPort Timeouts - Got"
       ELSE
        PRINT "COMPort Timeouts - NOT Gotten"
       END IF
      END IF
     END SUB

     SUB Clear_ComBuffers(handle AS LONG, action AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=PurgeComm(handle, action)
       IF rtn<>0 THEN
        PRINT "COMPort Buffers - Cleared"
       ELSE
        PRINT "COMPort Buffers - NOT Cleared"
       END IF
      END IF
     END SUB

     SUB Create_ComBuffers(handle AS LONG, inSize AS LONG, outSize AS LONG)
      IF handle<>INVALID_HANDLE_VALUE THEN
       rtn=SetupComm(handle, inSize, outSize)
       IF rtn<>0 THEN
        PRINT "COMPort Buffers - Created"
       ELSE
        PRINT "COMPort Buffers - NOT Created"
       END IF
      END IF
     END SUB

     SUB Create_COMPort(portName$ AS STRING, access AS LONG, shareMode AS LONG, fileAttrs AS LONG)
      COMPort_Handle=CreateFile(portName$, access, shareMode, 0, OPEN_EXISTING, fileAttrs, 0)
      IF COMPort_Handle<>INVALID_HANDLE_VALUE THEN
       PRINT "COMPort - Open"
      ELSE
       PRINT "COMPort - NOT Open"
      END IF
     END SUB

' Allocate a default buffer for General Use.
     Alloc_DefaultMemory(3000)


' --------------------- An Overlapped WaitEvent() ----------------------

' Create the Communication Port (File).
     Create_COMPort("COM4", GENERIC_READ OR GENERIC_WRITE, 0, FILE_FLAG_OVERLAPPED)

' Create the Communication Device`s Buffers.
     Create_ComBuffers(COMPort_Handle, 2000, 2000)

' Clear all the Old Data from the Input and Output Buffers of the
' Communication Device.
     Clear_ComBuffers(COMPort_Handle, PURGE_TXABORT OR PURGE_RXABORT OR PURGE_TXCLEAR OR PURGE_RXCLEAR)

' Get the Communication Device`s control settings (DCB Structure).
     Get_ComState(COMPort_Handle)

' Set the Communication Device`s control settings. Set the individual
' values of the DCB Structure and then call Set_CommState().
     Set_BaudRate(CBR_9600)
     Set_ComState(COMPort_Handle)

' Set the Timeouts for the Communication Device.
     Set_ComTimeouts(COMPort_Handle, MAXDWORD, 0, 1000, 0, 1000)

' Get the Properties of the Communication Device.
     Get_DriverProperties(COMPort_Handle)

'Show_DriverProperties

' Get the Mask of Events the Communication Device may be monitoring.
     Get_ComMask(COMPort_Handle)
     PRINT "Mask: ";HEX$(comMask)

' Set the Mask of Events for the Communication Device to monitor.
     comMask=EV_CTS OR EV_DSR
     Set_ComMask(COMPort_Handle)

' Do the Event for WaitCommEvent() to monitor. Note. You could use
' WaitForSingleObject() for the signalled event but I have used the
' proper WIN32API rules and gone fully with the GetOverlappedResult()
' method, which is long but worth it in the end.
     Create_WaitEvent(COMPort_Handle, 1, 1, 0, "")

' Get the Modem Status. Check modemStatus by ANDing it with the MS_
' values/bits.
     Get_ModemStatus(COMPort_Handle)
     PRINT "Modem Status: ";HEX$(modemStatus)

' Close the COMPort Handle.
     Close_Handle(COMPort_Handle)

     PRINT "Press ANY key to continue...."
     DO
     LOOP UNTIL INKEY$<>""


' ------------- Read/Write to the ADR 2000 (Serial Port) -------------

' Create the Communication Port (File).
     Create_COMPort("COM1", GENERIC_READ OR GENERIC_WRITE, 0, 0)

' Create the Communication Device`s Buffers.
     Create_ComBuffers(COMPort_Handle, 128, 128)

' Clear all the Old Data from the Input and Output Buffers of the
' Communication Device.
     Clear_ComBuffers(COMPort_Handle, PURGE_TXABORT OR PURGE_RXABORT OR PURGE_TXCLEAR OR PURGE_RXCLEAR)

' Get the Communication Device`s control settings.
     Get_ComState(COMPort_Handle)

' Set the Communication Device`s control settings. Set the individual
' values of the DCB Structure and then call Set_CommState().
     Set_BaudRate(CBR_9600)
     Set_ByteSize(8)
     Set_ParityBits(NOPARITY)
     Set_StopBits(ONESTOPBIT)
     Set_AbortOnError(1)
     Set_ComState(COMPort_Handle)

' Set the Timeouts for the Communication Device.
     Set_ComTimeouts(COMPort_Handle, 50, 50, 10, 50, 10)

' Sends a RE (read event counter) command. The ADR2000 uses the carriage
' return to recognize a command.
     stg$="RE\r"+CHR$(0)
     CopyMemory mem_Default+200, VARPTR(stg$), LEN(stg$)
     Write_COMPort(COMPort_Handle, LEN(stg$))

' The variable "rtnval" tells you how many bytes were read. Use
' Copymem() to read any data.
     Read_COMPort(COMPort_Handle, 6)

' Close the COMPort Handle.
     Close_Handle(COMPort_Handle)

     SLEEP 4
     CLS


' ---------------------- Wait for a NON-Overlapped Event ---------------

' Create the Communication Port (File).
     Create_COMPort("COM4", GENERIC_READ OR GENERIC_WRITE, 0, 0)

' Set the Mask of Events for the Communication Device to monitor.
     comMask=EV_CTS OR EV_DSR
     Set_ComMask(COMPort_Handle)

' Wait for a NON-Overlapped Event.
     Wait_NOEvent(COMPort_Handle)

' Close the COMPort Handle.
     Close_Handle(COMPort_Handle)

     SLEEP 4
     CLS


' ---------------- Wait for a WriteFile Overlapped Event ---------------

' Create the Communication Port (File).
     Create_COMPort("COM4", GENERIC_READ OR GENERIC_WRITE, 0, FILE_FLAG_OVERLAPPED)

' Create an Overlapped Event.
     Create_OverlappedEvent(1, 0, "")

' Write to the Communication Device.
     stg$="JOHN"+CHR$(0)
     CopyMemory mem_Default+200, VARPTR(stg$), LEN(stg$)
     Write_COMPort(COMPort_Handle, LEN(stg$))

     IF rtn=0 THEN
      IF GetLastError()=ERROR_IO_PENDING THEN
       Wait_ForEvent(overlap(4), INFINITE_TIMEOUT)
       IF rtn=WAIT_OBJECT_0 THEN
        Get_OverlapResult(COMPort_Handle, 0, 0)
       END IF
      END IF
     END IF

' Close the COMPort Handle.
     Close_Handle(COMPort_Handle)

     SLEEP 4
     CLS


' ---------------- Display a Communication Dialog ---------------------

' Create the Communication Port (File).
     Create_COMPort("COM4", GENERIC_READ OR GENERIC_WRITE, 0, 0)

' Get the Communication Device`s control settings.
     Get_ComState(COMPort_Handle)

' Create a Dialog/Requester, by initializing its data.
     FLong=101
     CopyMemory mem_Default+800, VARPTR(FLong), 4
     FLong=256
     CopyMemory mem_Default+804, VARPTR(FLong), 4
' Copy the DCB Structure data.
     CopyMemory mem_Default+808, mem_Default, 80
' Copy the Provider Type from the COMPROP Structure to this COMCONFIG
' Structure.
     CopyMemory mem_Default+888, mem_Default+1124, 4

' Display the Dialog/Requester.
     Configuration_Dialog("COM4")

     CopyMemory VARPTR(FLong), mem_Default+892, 4
     PRINT "offset: ";HEX$(FLong)
     CopyMemory VARPTR(FLong), mem_Default+896, 4
     PRINT "offset: ";HEX$(FLong)

' Close the COMPort Handle.
     Close_Handle(COMPort_Handle)

     SLEEP 4
     CLS


' ---------------------- Miscellaneous Calls --------------------------

' Create the Communication Port (File).
     Create_COMPort("COM4", GENERIC_READ OR GENERIC_WRITE, 0, 0)

' Set the Communication Device`s control settings. Set the individual
' values of the DCB Structure with BuildCommDCB() and then call
' SetCommState().
     Build_DCB("COM1: baud=1200 parity=N data=8 stop=1")
     Set_ComState(COMPort_Handle)

' Set the Communication Device`s control settings and/or the Timeouts.
' Set the individual values of the DCB Structure and/or the Timeouts
' with BuildCommDCBAndTimeouts() and then call Set_CommState().
     Build_DCBAndTimeouts("COM1: baud=1200 parity=N data=8 stop=1 TO=ON")
     Set_ComState(COMPort_Handle)

' Suspend Character Transmission.
     Set_TransmissionBreak(COMPort_Handle)

' Restore Character Transmission.
     Clear_TransmissionBreak(COMPort_Handle)

' Get the Timeouts for the Communication Device.
     Get_ComTimeouts(COMPort_Handle)
     PRINT timeouts(0)
     PRINT timeouts(1)
     PRINT timeouts(2)
     PRINT timeouts(3)

' Get the Communication Device`s Configuration. rtnval specifies the
' size of the COMMCONFIG Structure.
     rtnval=300
     Get_Configuration(COMPort_Handle)
     CopyMemory VARPTR(rtnval), mem_Default+800, 4
     PRINT "Config Size: ";rtnval
     CopyMemory VARPTR(FWord), mem_Default+804, 2
     PRINT "Config Version: ";FWord
     CopyMemory VARPTR(Flong), mem_Default+812, 4
     PRINT "DCB Baud Rate: ";HEX$(FLong)
     CopyMemory VARPTR(Flong), mem_Default+808, 4
     PRINT "DCB Size: ";HEX$(FLong)
     CopyMemory VARPTR(Flong), mem_Default+808+FLong, 4
     PRINT "Config Provider Sub-Type: ";HEX$(FLong)

' Set the Communication Device`s Configuration. rtnval specifies the
' size of the COMMCONFIG Structure.
     Set_Configuration(COMPort_Handle, rtnval)

     Escape_Function(COMPort_Handle, CLRRTS)

' Close the COMPort Handle.
     Close_Handle(COMPort_Handle)


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


     UnLock_DefaultMemory
     Free_DefaultMemory

     SLEEP 44444

2002-09-06 22:45