2009-07-25 17:30

'**************************************************************
'**************************************************************
'***
'***  'Win32 Communications User Defined Types       **********
'***  'use for COMPORT extension                     **********
'**************************************************************
'**************************************************************

'Structure containing time-out parameters for a communications device
     TYPE COMMTIMEOUTS
      ReadIntervalTimeout AS DWORD
      ReadTotalTimeoutMultiplier AS DWORD
      ReadTotalTimeoutConstant AS DWORD
      WriteTotalTimeoutMultiplier AS DWORD
      WriteTotalTimeoutConstant AS DWORD
     END TYPE

'Device Control Block
'Structure that defines the control settings for a serial communications device
     TYPE DCB
      DCBlength AS DWORD        'sizeof DCB
      BaudRate AS DWORD         'current baud rate
      DCBflags AS DWORD         'fBinary            1 bit binary mode, no EOF check
                                  'fParity            1 bit enable parity checking
                                  'fOutxCtsFlow       1 bit CTS output flow control (hardware flow control setting)
                                  'fOutxDsrFlow       1 bit DSR output flow control (hardware flow control setting)
                                  'fDtrControl        2 bit DTR flow control type (hardware flow control setting)
                                  'fDsrSensitivity    1 bit DSR sensitivity (hardware flow control setting)
                                  'fTXContinueOnXoff  1 bit XOFF continues Tx (software flow control setting)
                                  'fOutX              1 bit XON/XOFF out flow control (software flow control setting)
                                  'fInX               1 bit XON/XOFF in flow control (software flow control setting)
                                  'fErrorChar         1 bit enable error replacement
                                  'fNull              1 bit enable null stripping
                                  'fRtsControl        2 bit RTS flow control (hardware flow control setting)
                                  'fAbortOnError      1 bit abort on error (hardware flow control setting)
                                  'fDummy2           17 bit reserved
      wReserved AS WORD         'reserved
      XonLim AS WORD            'transmit XON threshold (software flow control setting)
      XoffLim AS WORD           'transmit XOFF threshold (software flow control setting)
      ByteSize AS BYTE          'number of bits/byte, 4-8
      Parity AS BYTE            '0-4=no,odd,even,mark,space
      StopBits AS BYTE          '0,1,2=1,1.5,2
      XonChar AS BYTE           'Tx and Rx XON character (software flow control setting)
      XoffChar AS BYTE          'Tx and Rx XOFF character (software flow control setting)
      ErrorChar AS BYTE         'error replacement character
      EofChar AS BYTE           'end of input character
      EvtChar AS BYTE           'received event character
      wReserved1 AS WORD        'reserved; do not use
     END TYPE

'Structure containing current Comm Port State
     TYPE COMSTAT
      COMSTATflags AS DWORD     'fCtsHold           1 bit Specifies whether waiting for CTS signal
                                  'fDsrHold           1 bit Specifies whether waiting for DSR signal
                                  'fRlsHold           1 bit Specifies whether waiting for RLSD signal
                                  'fXoffHold          1 bit Specifies whether waiting because XOFF character was received
                                  'fXoffSent          1 bit Specifies whether waiting because XOFF character was transmitted
                                  'fEof               1 bit Specifies whether EOF char has been received
                                  'fTxim              1 bit character queued for transmission because of TransmitCommChar
                                  'fReserved         25 bit Reserved
      cbInQue AS DWORD          'number of bytes received but not yet read
      cbOutQue AS DWORD         'number of bytes remaining to be transmitted
     END TYPE

'Win32 File Handling User Defined Types

'Structure that contains the security descriptor for an object
'not currently used by us
     TYPE SECURITYATTRIBUTES
      nLength AS DWORD
      lpSecurityDescriptor AS LONG
      bInheritHandle AS LONG
     END TYPE

'Structure containing info used in Overlapped (asynchronous) I/O
'not currently used by us
     TYPE OVERLAPPED
      Internal AS LONG
      InternalHigh AS LONG
      offset AS DWORD
      OffsetHigh AS DWORD
      hEvent AS LONG
     END TYPE

'DCB Constants
'Parity
     CONST NOPARITY              = 0
     CONST ODDPARITY             = 1
     CONST EVENPARITY            = 2
     CONST MARKPARITY            = 3
     CONST SPACEPARITY           = 4
'StopBits
     CONST ONESTOPBIT            = 0
     CONST ONE5STOPBITS          = 1
     CONST TWOSTOPBITS           = 2

'PurgeCOM constants
'dwFlags
     CONST PURGE_RXABORT         = &H2
     CONST PURGE_RXCLEAR         = &H8
     CONST PURGE_TXABORT         = &H1
     CONST PURGE_TXCLEAR         = &H4

'Win32 File Handling Constants

'dwDesired Access Constants
     CONST GENERIC_READ          = &H80000000
     CONST GENERIC_WRITE         = &H40000000
'dwShareMode Constants
     CONST FILE_SHARE_READ       = &H1
     CONST FILE_SHARE_WRITE      = &H2
'dwCreationDisposition Constants
     CONST CREATE_NEW            = 1
     CONST CREATE_ALWAYS         = 2
     CONST OPEN_EXISTING         = 3
     CONST OPEN_ALWAYS           = 4
     CONST TRUNCATE_EXISTING     = 5
'dwFlagsAndAttributes
     CONST FILE_ATTRIBUTE_NORMAL = &H80

'Win32 Error Constants
     CONST FORMAT_MESSAGE_ALLOCATE_BUFFER  = &H100
     CONST FORMAT_MESSAGE_FROM_SYSTEM      = &H1000
     CONST LANG_NEUTRAL                    = &H0
     CONST SUBLANG_DEFAULT                 = &H1
     CONST ERROR_BAD_USERNAME              = 2202&

'Error Message Constants
     CONST ERROR_OPEN_PORT                 = "There was an error opening the Comm Port.  "
     CONST ERROR_PORT_BUFFERS              = "There was an error creating the Comm Port Buffers.  "
     CONST ERROR_PURGE_BUFFERS             = "There was an error purging old data from the Comm Port Buffers.  "
     CONST ERROR_TIMEOUTS                  = "There was an error setting the Comm Port timeouts.  "
     CONST ERROR_RETRIEVE_PORTSETTINGS     = "There was an error retrieving the existing Comm Port settings.  "
     CONST ERROR_CHANGING_PORTSETTINGS     = "There was an error changing the Comm Port settings.  "
     CONST ERROR_CLOSING_PORT              = "There was an error closing the Comm Port.  "
     CONST ERROR_WRITING_PORT              = "There was an error writing data to the Comm Port.  "
     CONST ERROR_SENDING_DATA              = "Could not send all the data in time specified.  Try increasing your wait time."
     CONST ERROR_GETTING_PORT_STATUS       = "There was an error getting the Comm Ports current status.  "
     CONST ERROR_READING_PORT              = "There was an error reading data from the Comm Port.  "

'Win32 Function Declarations

'Suspends the execution of the current thread for the specified interval.
     DECLARE SUB SLEEP.ms LIB "kernel32" ALIAS "Sleep" (dwMilliseconds AS DWORD)

'Win32 Error Messages
'for setting null value for Qdebug
     DECLARE SUB SetLastError LIB "kernel32" ALIAS "SetLastError" (BYVAL dwErrCode AS LONG)
     DECLARE FUNCTION WSAGetLastError LIB "WSOCK32" ALIAS "WSAGetLastError" () AS LONG

'Several Win32 functions set an error code if they fail.  This retrieves them.
'Note, If a function succeeds, it may not set this code.  If you retrieve it
'after a function succeeds, it may return an error code for a previous function that failed.
     DECLARE FUNCTION GetLastError LIB "kernel32" ALIAS "GetLastError" () AS DWORD
                                                    'Returns last error code value
                                                    'See http://msdn.microsoft.com/library/default.asp?url=/library/en-us/debug/errlist_7oz7.asp
                                                    'for what codes mean

'Converts GetLastError codes to string messages.
     DECLARE FUNCTION FormatMessage LIB "kernel32" ALIAS "FormatMessageA" _
      (dwFlags AS DWORD, _                            '[IN] Specifies aspects of the formatting process and how to interpret lpSource
      lpSource AS LONG, _                       '[IN] Specifies the location of the message definition
      dwMessageId AS DWORD, _                         '[IN] Specifies the message identifier for the requested message
      dwLanguageId AS DWORD, _                        '[IN] Specifies the language identifier for the requested message
      BYREF lpBuffer AS STRING, _                     '[OUT] Pointer to a buffer for the formatted message
      nSize AS DWORD, _                               '[IN] specifies the max number of characters that can be stored in the output buffer
      lpArguments AS LONG) _                      '[IN] Pointer to an array of values that are used as insert values in the formatted message
      AS LONG                                       ''If function succeeds, returns non-zero. If function fails, returns 0.

'Win32 Communication Functions

' Initializes the communications parameters for a specified
' communications device.
     DECLARE FUNCTION SetupComm LIB "kernel32" ALIAS "SetupComm"_
      (hFile AS LONG,_                                '[IN] Handle to open Comm device
      dwInQueue AS DWORD,_                           '[IN] specifies number of bytes of input buffer
      dwOutQueue AS DWORD) _                         '[IN] specifies number of bytes of output buffer
      AS LONG                                     'If function succeeds, returns non-zero. If function fails, returns 0.

' Discards all characters from the output or input buffer of a
' specified communications resource. It can also terminate
' pending read or write operations on the resource.
     DECLARE FUNCTION PurgeComm LIB "kernel32" ALIAS "PurgeComm"_
      (hFile AS LONG, _                               '[IN] Handle to open Comm device
      dwFlags AS DWORD) _                            '[IN] Action to perform flag
      AS LONG                                     'If function succeeds, returns non-zero. If function fails, returns 0.

' Sets the time-out parameters for all read and write operations on a
' specified communications device.
     DECLARE FUNCTION SetCommTimeouts LIB "kernel32" ALIAS "SetCommTimeouts"_
      (hFile AS LONG,_                                '[IN] Handle to open Comm device
      lpCommTimeouts AS COMMTIMEOUTS) _              '[IN] Structure containing timeout values
      AS LONG                                     'If function succeeds, returns non-zero. If function fails, returns 0.

'Retrieves current Device Control Block (DCB)
     DECLARE FUNCTION GetCommState LIB "kernel32" ALIAS "GetCommState" _
      (hFile AS LONG, _                               '[IN] Handle to open Comm device
      lpDCB AS DCB) _                                 '[OUT] Pointer to structure containing config info
      AS LONG                                     'If function succeeds, returns non-zero. If function fails, returns 0.

'Sets Device Control Block (DCB)
     DECLARE FUNCTION SetCommState LIB "kernel32" ALIAS "SetCommState" _
      (hFile AS LONG, _                               '[IN] Handle to open Comm device
      lpDCB AS DCB) _                                 '[IN] Pointer to structure containing config info
      AS LONG                                     'If function succeeds, returns non-zero. If function fails, returns 0.

' Retrieves information about a communications error and reports
' the current status of a communications device. Clears the
' device's error flag to enable additional input and output
' (I/O) operations.
     DECLARE FUNCTION ClearCommError LIB "kernel32" ALIAS "ClearCommError" _
      (hFile AS LONG,_                                '[IN] Handle to open Comm device
      BYREF lpErrors AS DWORD,_                      '[OUT] Pointer to var to be filled with a mask indicating the type of error
      lpStat AS COMSTAT) _                           '[OUT] Pointer to structure containing devices status info
      AS LONG                                     'If function succeeds, returns non-zero. If function fails, returns 0.

'Win32 File Handling Functions

'Create or open a new Comm device/file
     DECLARE FUNCTION CreateFile LIB "kernel32" ALIAS "CreateFileA"_
      (lpFileName AS STRING, _                        '[IN] String that specifies name of object to create or open
      dwDesiredAccess AS DWORD, _                     '[IN] Specifies type of access to object
      dwShareMode AS DWORD, _                         '[IN] Specifies how object is to be shared
      lpSecurityAttributes AS SECURITYATTRIBUTES, _   '[IN] Pointer to Structure that determines whether object can be inherited by child processes
      dwCreationDisposition AS DWORD, _               '[IN] Specifies which action to take on files that exist/do not exist
      dwFlagsAndAttributes AS DWORD,_                 '[IN] Specifies the file attributes and flags
      hTemplateFile AS LONG) _                        '[IN] handle to template that supplies file attributes
      AS LONG                                     'If successful, returns handle to object/file created

' Writes data to a file
' We are not using Overlapped (asynchronous) I/O
     DECLARE FUNCTION WriteFile LIB "kernel32" ALIAS "WriteFile"_
      (hFile AS LONG, _                               '[IN] Handle to open Comm device/file
      lpBuffer AS STRING, _                    '[IN] Pointer to buffer containing the data to be written to Comm device/file
      nNumberOfBytesToWrite AS DWORD, _              '[IN] Specifies number of bytes to write to file
      BYREF lpNumberOfBytesWritten AS DWORD, _       '[OUT] Pointer to var containing number of bytes written
      lpOverlapped AS OVERLAPPED) _                  '[IN] Pointer to structure containing info if Comm device/file was opened in Overlapped mode.
      AS LONG                                       'If function succeeds, returns non-zero. If function fails, returns 0.

'Alternative write file, that handles asynchronous writing, so your program can do other things while writing to Comm device
'     DECLARE FUNCTION WriteFileEx LIB "kernel32" ALIAS "WriteFileEx"_
'      (hFile AS LONG, _                             '[IN] Handle from CreateFile API (Comm device/file), must have been created with the FILE_FLAG_OVERLAPPED flag and with GENERIC_WRITE
'      BYREF lpBuffer AS STRING, _                   '[IN] Pointer to buffer containing the data to be written to Comm device/file
'      nNumberOfBytesToWrite AS DWORD, _             '[IN] Specifies number of bytes to write to file
'      lpOverlapped AS OVERLAPPED) _                 '[IN] Pointer to structure containing info if Comm device/file was opened in Overlapped mode
'      BYVAL lpCompletionRoutine AS LONG)_              '[IN] Pointer to completion routine, nested structure...
'      AS LONG                                       'If function succeeds, returns non-zero. If function fails, returns 0.


'Reads data from a file
'We are not using Overlapped (asynchronous) I/O
     DECLARE FUNCTION ReadFile LIB "kernel32" ALIAS "ReadFile"_
      (hFile AS LONG, _                               '[IN] Handle to open Comm device/file
      BYREF lpBuffer AS STRING, _                    '[OUT] Pointer to buffer that receives data from Comm device/file
      nNumberOfBytesToRead AS DWORD, _               '[IN] Specifies number of bytes to be read from file
      BYREF lpNumberOfBytesRead AS DWORD, _          '[OUT] Specifies number of bytes read from file
      lpOverlapped AS OVERLAPPED) _                  '[IN] Pointer to structure containing info if Comm device/file was opened in Overlapped mode.
      AS LONG                                     'If function succeeds, returns non-zero. If function fails, returns 0.

     DECLARE FUNCTION CloseHandle LIB "kernel32" ALIAS "CloseHandle" _
      (hObject AS LONG) _                             '[IN/OUT] Handle to open Comm device/file
      AS LONG                                     'If function succeeds, returns non-zero. If function fails, returns 0.
                                       'If function succeeds, returns non-zero. If function fails, returns 0.

'alternate API allows asynch I/O but lets an application perform other processing during a file read operation.
     DECLARE FUNCTION ReadFileEx LIB "kernel32" ALIAS "ReadFileEx"_
      (BYVAL hFile AS LONG, _                         '[IN] Handle to open Comm device/file
      BYREF lpBuffer AS STRING, _                    '[OUT] Pointer to buffer that receives data from Comm device/file, not use this buffer until the read operation is completed.
      BYVAL nNumberOfBytesToRead AS DWORD, _         '[IN] Specifies number of bytes to be read from file
      lpOverlapped AS OVERLAPPED,_                   '[IN] Pointer to structure containing info if Comm device/file was opened in Overlapped mode.
      BYVAL lpCompletionRoutine AS LONG)_            '[IN] address of the routine for after completion
      AS LONG                                         'If function succeeds, returns non-zero. If function fails, returns 0.

'==============================================================================================
'COMPORT component, based on  ComPort.cmp by Pete Kleinschmidt,
'  and on VB code by David M. Hitchner, 'http://www.thescarms.com/vbasic/CommIO.asp
'Version 1.0, December 13, 2004   by JohnK

'==============================================================================================

'Forward Internal Declarations for events
     DECLARE SUB OnComError_EventTemplate (strErrorMessage AS STRING)
     DECLARE SUB OnOpen_EventTemplate
     DECLARE SUB OnClose_EventTemplate
     DECLARE SUB OnWriteString_EventTemplate
     DECLARE SUB OnReadString_EventTemplate



     TYPE COMPORT EXTENDS QOBJECT

  'EVENTS
      OnComError    AS EVENT (OnComError_EventTemplate)
      OnOpen        AS EVENT (OnOpen_EventTemplate)
      OnClose       AS EVENT (OnClose_EventTemplate)
      OnWriteString AS EVENT (OnWriteString_EventTemplate)
      OnReadString  AS EVENT (OnReadString_EventTemplate)

    'Events not inherited, because COMPORT is blocking don't need these
'            OnBreak VOID A line break is detected, input and output is suspended until break is cleared
'            OnError -->onComError
'            OnRing VOID A ring signal is detected, used only with modems.
'            OnRxChar SUB (InQue AS INTEGER) A character(s) arrives in the input buffer.
'            OnTxEmpty VOID Output buffer is flushed


  'PROPERTIES
      Handle            AS LONG
      Port              AS STRING
      BaudRate          AS DWORD
      DataBits          AS BYTE
      Parity            AS BYTE
      StopBits          AS BYTE
      ReadBufSize       AS DWORD
      WriteBufSize      AS DWORD
      BytesNotRead      AS DWORD'same as InQue --number of bytes received but not yet read
      BytesNotWritten   AS DWORD'same as OutQue -- number of bytes remaining to be transmitted
      InQue AS DWORD PROPERTY SET GetInQue 'add for compatibility
      OutQue AS DWORD PROPERTY SET GetOutQue 'and if user wants to check current status
      Connected         AS BYTE
         'properties not inherited
         'PendingIO INTEGER R


  'Default property values
      CONSTRUCTOR
       Port            = "COM1"
       BaudRate        = 9600
       DataBits        = 8
       Parity          = NOPARITY
       StopBits        = 1
       ReadBufSize     = 1024
       WriteBufSize    = 1024
       BytesNotRead    = 0
       BytesNotWritten = 0
       Connected       = 0
      END CONSTRUCTOR


  'METHODS
        'not inherited are:
'                AbortAllIO SUB Aborts all asynchronous read/write operations
'                Read SUB Read(QFile/QMemoryStream, Count%, Wait%) Reads stream data from com port, Count% < 32000
'                WaitForLastIO SUB Blocks until last IO is completed
'                Write SUB Write(QFile/QMemoryStream, Count%, Wait%) Writes stream to com port, Count% < 32000
'

  'Method FormatError (Convert GetLastError codes to String messages)
PRIVATE:
      FUNCTION FormatError AS STRING
       DIM Buffer        AS STRING
       DIM lngRet        AS LONG

       Buffer=SPACE$(1024)

       lngRet=FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, _
        0, _
        GetLastError(), _
        LANG_NEUTRAL, _
        Buffer, _
        LEN(Buffer), _
        0)
       Result=LEFT$(Buffer,lngRet)
      END FUNCTION

  'Method GetStatus
PRIVATE:
      SUB GetCommStatus
       DIM lngStatus     AS LONG
       DIM dwErrorFlags  AS DWORD
       DIM udtCommStat   AS COMSTAT

     'Clear any previous errors and get current status.
       lngStatus = ClearCommError(ComPort.Handle, _
        dwErrorFlags, _
        udtCommStat)

       IF lngStatus = 0 THEN
        IF ComPort.OnComError > 0 THEN
         CALLFUNC (ComPort.OnComError, ERROR_CHANGING_PORTSETTINGS & ComPort.FormatError)
        END IF
       ELSE
      'Set BytesNotWritten and BytesNotRead Property
        ComPort.BytesNotWritten = udtCommStat.cbOutQue
        ComPort.BytesNotRead    = udtCommStat.cbInQue
        ComPort.InQue  = udtCommStat.cbInQue
        ComPort.OutQue = udtCommStat.cbOutQue
       END IF
      END SUB

      PROPERTY SET GetInQue(myVoid AS DWORD)'Read only
       Comport.GetCommStatus
      END PROPERTY

      PROPERTY SET GetOutQue(myVoid AS DWORD)'Read only
       Comport.GetCommStatus
      END PROPERTY



  'Method Open Port
PUBLIC:
' ##############################################################################
      SUB OPEN
' ##############################################################################
       DIM udtCommTimeOuts AS COMMTIMEOUTS
       DIM udtDCB          AS DCB
       DIM lngStatus       AS LONG

    'Open the Comm Port
       ComPort.Handle = CreateFile(COMPORT.Port, _
        GENERIC_READ OR GENERIC_WRITE, _
        FILE_SHARE_READ OR FILE_SHARE_WRITE, _
        0&, _
        OPEN_EXISTING, _
        FILE_ATTRIBUTE_NORMAL, _
        0&)

       IF ComPort.Handle = -1 THEN
        IF ComPort.OnComError > 0 THEN
         CALLFUNC (ComPort.OnComError,ERROR_OPEN_PORT & ComPort.FormatError)
        END IF
        EXIT SUB
       END IF

    'Setup device buffers (1K is default).
       lngStatus = SetupComm(ComPort.Handle,_
        ComPort.ReadBufSize,_
        ComPort.WriteBufSize)

       IF lngStatus = 0 THEN
        IF ComPort.OnComError > 0 THEN
         CALLFUNC (ComPort.OnComError, ERROR_PORT_BUFFERS & ComPort.FormatError)
        END IF
        EXIT SUB
       END IF

    'Purge existing data in buffers.
       lngStatus = PurgeComm(ComPort.Handle,_
        PURGE_TXABORT OR PURGE_RXABORT OR PURGE_TXCLEAR OR PURGE_RXCLEAR)

       IF lngStatus = 0 THEN
        IF ComPort.OnComError > 0 THEN
         CALLFUNC (ComPort.OnComError, ERROR_PURGE_BUFFERS & ComPort.FormatError)
        END IF
        EXIT SUB
       END IF

    ' Set serial port timeouts values.
       udtCommTimeOuts.ReadIntervalTimeout         = -1
       udtCommTimeOuts.ReadTotalTimeoutMultiplier  = 0
       udtCommTimeOuts.ReadTotalTimeoutConstant    = 1000
       udtCommTimeOuts.WriteTotalTimeoutMultiplier = 0
       udtCommTimeOuts.WriteTotalTimeoutMultiplier = 1000


       lngStatus = SetCommTimeouts(ComPort.Handle,_
        udtCommTimeOuts)

       IF lngStatus = 0 THEN
        IF ComPort.OnComError > 0 THEN
         CALLFUNC (ComPort.OnComError, ERROR_TIMEOUTS & ComPort.FormatError)
        END IF
        EXIT SUB
       END IF

    'Get the current state (DCB) - we retain current values for
    'communication settings we don't explicitly set.
       lngStatus = GetCommState (ComPort.Handle, _
        udtDCB)

       IF lngStatus = 0 THEN
        IF ComPort.OnComError > 0 THEN
         CALLFUNC (ComPort.OnComError, ERROR_RETRIEVE_PORTSETTINGS & ComPort.FormatError)
        END IF
        EXIT SUB
       END IF

    'Set our Communications State
       udtDCB.BaudRate = ComPort.BaudRate
       udtDCB.ByteSize = ComPort.DataBits
       udtDCB.Parity   = ComPort.Parity
       udtDCB.StopBits = ComPort.StopBits

    'This changes our settings
       lngStatus = SetCommState (ComPort.Handle, _
        udtDCB)

       IF lngStatus = 0 THEN
        IF ComPort.OnComError > 0 THEN
         CALLFUNC (ComPort.OnComError, ERROR_CHANGING_PORTSETTINGS & ComPort.FormatError)
        END IF
       ELSE
      'Set Connected Property
        ComPort.Connected = 1
      'Raise OnOpen Event
        IF ComPort.OnOpen > 0 THEN
         CALLFUNC ComPort.OnOpen
        END IF
       END IF

      END SUB

PUBLIC:
' ##############################################################################
      SUB PurgeIn ()'Clears input buffer and stops all input functions
' ##############################################################################
       PurgeComm(ComPort.Handle, PURGE_RXABORT OR PURGE_RXCLEAR)
      END SUB

' ##############################################################################
      SUB PurgeOut'Clears output buffer and stops all output functions
' ##############################################################################
       PurgeComm(ComPort.Handle, PURGE_TXABORT OR PURGE_TXCLEAR)
      END SUB


  'Method     Close COM Port
PUBLIC:
' ##############################################################################
      SUB CLOSE
' ##############################################################################
       DIM lngStatus AS LONG

       lngStatus = CloseHandle (ComPort.Handle)
       IF lngStatus = 0 THEN
        IF ComPort.OnComError > 0 THEN
         CALLFUNC (ComPort.OnComError, ERROR_CLOSING_PORT & ComPort.FormatError)
        END IF
       ELSE
      'Set Connected Property
        ComPort.Connected = 0
      'Raise OnClose Event
        IF ComPort.OnClose > 0 THEN
         CALLFUNC ComPort.OnClose
        END IF
       END IF
      END SUB


  'Method Writestring
PUBLIC:
' ##############################################################################
      SUB WriteString (strData AS STRING, intWait AS INTEGER)
' ##############################################################################
       DIM lngStatus       AS LONG
       DIM dwBytesToWrite  AS DWORD
       DIM dwByesWritten   AS DWORD

    'Set number of bytes to be sent.
       dwBytesToWrite=LEN(strData)

    'Output the data.
       lngStatus = WriteFile(ComPort.Handle, _
        strData, _
        dwBytesToWrite, _
        dwByesWritten, _
        0&)

       IF lngStatus = 0 THEN
        IF ComPort.OnComError > 0 THEN
         CALLFUNC (ComPort.OnComError, ERROR_WRITING_PORT & ComPort.FormatError)
        END IF
       ELSE
        IF intWait THEN SLEEP.ms(intWait)'Wait for data to be written
        ComPort.GetCommStatus      'any bytes still waiting to be written?

        IF Comport.BytesNotWritten = 0 THEN'If all data has been sent Raise OnWriteString event
         IF ComPort.OnWriteString > 0 THEN
          CALLFUNC ComPort.OnWriteString
         END IF
        ELSE
         IF ComPort.OnComError > 0 THEN
          CALLFUNC (ComPort.OnComError, ERROR_SENDING_DATA)
         END IF
        END IF
       END IF

      END SUB


  'Method ReadString
PUBLIC:
' ##############################################################################
      FUNCTION ReadString (dwRdSize AS DWORD, intWait AS INTEGER) AS STRING
' ##############################################################################

       DIM lngStatus     AS LONG
       DIM dwBytesRead   AS DWORD
       DIM strReadBuffer AS STRING

    'Make enough space in memory for ReadFile to put data in.
       strReadBuffer=SPACE$(ComPort.ReadBufSize)

    'Read data from buffer
       lngStatus = ReadFile(Comport.Handle, _'was myport.handle, corrected
        strReadBuffer, _
        dwRdSize, _
        dwBytesRead, _
        0&)

       IF lngStatus = 0 THEN
        IF ComPort.OnComError > 0 THEN
         CALLFUNC (ComPort.OnComError, ERROR_READING_PORT & ComPort.FormatError)
        END IF
       ELSE

        Result = LEFT$(strReadBuffer, dwBytesRead)  'Set Return value for this Function
        IF intWait THEN SLEEP.ms(intWait)      	  'Wait for more data to arrive in buffer
        ComPort.GetCommStatus                       'Get number of bytes now waiting to be read
        IF ComPort.OnReadString > 0 THEN             'Raise OnReadString event
         CALLFUNC ComPort.OnReadString
        END IF

       END IF
      END FUNCTION
     END TYPE


' Just get it over, QCOMPORT does nothing
     $DEFINE QCOMPORT COMPORT


'*******************************************************
'*****  END QCOMPORT extension
'*******************************************************

2009-07-25 17:30