home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code2 / vb_term2 / serial.bas < prev    next >
BASIC Source File  |  1991-08-20  |  8KB  |  202 lines
  1. '----------------------------------------------------------------------------
  2. '    Serial Communications Module for VB
  3. '----------------------------------------------------------------------------
  4. '
  5. '  COMM declarations
  6. '
  7. '----------------------------------------------------------------------------
  8. Const NOPARITY = 0
  9. Const ODDPARITY = 1
  10. Const EVENPARITY = 2
  11. Const MARKPARITY = 3
  12. Const SPACEPARITY = 4
  13.  
  14. Const ONESTOPBIT = 0
  15. Const ONE5STOPBITS = 1
  16. Const TWOSTOPBITS = 2
  17.  
  18. Const IGNORE = 0 '  Ignore signal
  19. Const INFINITE = &HFFFF  '  Infinite timeout
  20.  
  21. '----------------------------------------------------------------------------
  22. '  Error Flags
  23. '----------------------------------------------------------------------------
  24. Const CE_RXOVER = &H1    '  Receive Queue overflow
  25. Const CE_OVERRUN = &H2   '  Receive Overrun Error
  26. Const CE_RXPARITY = &H4  '  Receive Parity Error
  27. Const CE_FRAME = &H8     '  Receive Framing error
  28. Const CE_BREAK = &H10    '  Break Detected
  29. Const CE_CTSTO = &H20    '  CTS Timeout
  30. Const CE_DSRTO = &H40    '  DSR Timeout
  31. Const CE_RLSDTO = &H80   '  RLSD Timeout
  32. Const CE_TXFULL = &H100  '  TX Queue is full
  33. Const CE_PTO = &H200     '  LPTx Timeout
  34. Const CE_IOE = &H400     '  LPTx I/O Error
  35. Const CE_DNS = &H800     '  LPTx Device not selected
  36. Const CE_OOP = &H1000    '  LPTx Out-Of-Paper
  37. Const CE_MODE = &H8000   '  Requested mode unsupported
  38.  
  39. Const IE_BADID = (-1)    '  Invalid or unsupported id
  40. Const IE_OPEN = (-2)     '  Device Already Open
  41. Const IE_NOPEN = (-3)    '  Device Not Open
  42. Const IE_MEMORY = (-4)   '  Unable to allocate queues
  43. Const IE_DEFAULT = (-5)  '  Error in default parameters
  44. Const IE_HARDWARE = (-10)        '  Hardware Not Present
  45. Const IE_BYTESIZE = (-11)        '  Illegal Byte Size
  46. Const IE_BAUDRATE = (-12)        '  Unsupported BaudRate
  47.  
  48. '----------------------------------------------------------------------------
  49. '  Events
  50. '----------------------------------------------------------------------------
  51. Const EV_RXCHAR = &H1    '  Any Character received
  52. Const EV_RXFLAG = &H2    '  Received certain character
  53. Const EV_TXEMPTY = &H4   '  Transmitt Queue Empty
  54. Const EV_CTS = &H8       '  CTS changed state
  55. Const EV_DSR = &H10      '  DSR changed state
  56. Const EV_RLSD = &H20     '  RLSD changed state
  57. Const EV_BREAK = &H40    '  BREAK received
  58. Const EV_ERR = &H80      '  Line status error occurred
  59. Const EV_RING = &H100    '  Ring signal detected
  60. Const EV_PERR = &H200    '  Printer error occured
  61.  
  62. '----------------------------------------------------------------------------
  63. '  Escape Functions
  64. '----------------------------------------------------------------------------
  65. Const SETXOFF = 1        '  Simulate XOFF received
  66. Const SETXON = 2 '  Simulate XON received
  67. Const SETRTS = 3 '  Set RTS high
  68. Const CLRRTS = 4 '  Set RTS low
  69. Const SETDTR = 5 '  Set DTR high
  70. Const CLRDTR = 6 '  Set DTR low
  71. Const RESETDEV = 7       '  Reset device if possible
  72.  
  73. Const LPTx = &H80        '  Set if ID is for LPT device
  74.  
  75.  
  76. '----------------------------------------------------------------------------
  77. '   Function Definitions
  78. '----------------------------------------------------------------------------
  79. Declare Function OpenComm Lib "User" (ByVal lpComName As String, ByVal wInQueue As Integer, ByVal wOutQueue As Integer) As Integer
  80. Declare Function SetCommState Lib "User" (lpdcb As DCB) As Integer
  81. Declare Function GetCommState Lib "User" (ByVal nCid As Integer, lpdcb As DCB) As Integer
  82. Declare Function ReadComm Lib "User" (ByVal nCid As Integer, ByVal lpBuf As String, ByVal nSize As Integer) As Integer
  83. Declare Function UngetCommChar Lib "User" (ByVal nCid As Integer, ByVal cChar As Integer) As Integer
  84. Declare Function WriteComm Lib "User" (ByVal nCid As Integer, ByVal lpBuf As String, ByVal nSize As Integer) As Integer
  85. Declare Function CloseComm Lib "User" (ByVal nCid As Integer) As Integer
  86. Declare Function BuildCommDCB Lib "User" (ByVal lpDef As String, lpdcb As DCB) As Integer
  87. Declare Function TransmitCommChar Lib "User" (ByVal nCid As Integer, ByVal cChar As Integer) As Integer
  88. Declare Function SetCommEventMask Lib "User" (ByVal nCid As Integer, nEvtMask As Integer) As Long
  89. Declare Function GetCommEventMask Lib "User" (ByVal nCid As Integer, ByVal nEvtMask As Integer) As Integer
  90. Declare Function SetCommBreak Lib "User" (ByVal nCid As Integer) As Integer
  91. Declare Function ClearCommBreak Lib "User" (ByVal nCid As Integer) As Integer
  92. Declare Function FlushComm Lib "User" (ByVal nCid As Integer, ByVal nQueue As Integer) As Integer
  93. Declare Function EscapeCommFunction Lib "User" (ByVal nCid As Integer, ByVal nFunc As Integer) As Integer
  94. Declare Function GetCommError Lib "User" (ByVal nCid As Integer, lpStat As COMSTAT) As Integer
  95.  
  96. '----------------------------------------------------------------------------
  97. '   Bits  for bits1 and bits2
  98. '----------------------------------------------------------------------------
  99. '   Bits1
  100. '----------------------------------------------------------------------------
  101. Const fbinary = &H1
  102. Const frtsdiable = &H2
  103. Const fparity = &H4
  104. Const foutxctsflow = &H8
  105. Const foutxdsrflow = &H10
  106. Const fdtrdisable = &H80
  107.  
  108. '----------------------------------------------------------------------------
  109. '   Bits2
  110. '----------------------------------------------------------------------------
  111. Const foutx = &H1
  112. Const finx = &H2
  113. Const fpechar = &H4
  114. Const fnull = &H8
  115. Const fchevt = &H10
  116. Const fdtrflow = &H20
  117. Const frtsflow = &H40
  118.  
  119. '----------------------------------------------------------------------------
  120. '   Definitions of our open port
  121. '----------------------------------------------------------------------------
  122. Dim nCid     As Integer
  123. Dim PortName    As String
  124.  
  125. Function SerialOpen (ComPort As Integer) As Integer
  126. '
  127. '    Open the serial port. Expects the com port number as the argument
  128. '    and returns either zero for success, or non-zero on error
  129. '
  130.     PortName = "COM" + Format$(ComPort, "#")
  131.     nCid = OpenComm(PortName, 2048, 128)
  132.     If (nCid < 0) Then
  133.         SerialOpen = nCid
  134.     Else
  135.         SerialOpen = 0
  136.     End If
  137. End Function
  138.  
  139. Function SerialClose () As Integer
  140. '
  141. '    Closes the serial port.  Zero return on OK
  142. '
  143.     x% = CloseComm(nCid)
  144.     If (x% < 0) Then
  145.         SerialClose = x%
  146.     Else
  147.         SerialClose = 0
  148.     End If
  149. End Function
  150.  
  151. Function SerialConfig (baud%, bits%, Parity$) As Integer
  152. '
  153. '    Configure the open serial port
  154. '
  155.     Dim lpdcb As DCB
  156.     Dim ConfigString As String
  157.  
  158.     ConfigString = PortName + ":"
  159.     ConfigString = ConfigString + Format$(baud%) + ","
  160.     ConfigString = ConfigString + Left$(UCase$(Parity$), 1) + ","
  161.     ConfigString = ConfigString + Format$(bits%, "#") + ",1"
  162.     i% = BuildCommDCB(ConfigString, lpdcb)
  163.  
  164.     lpdcb.id = Chr$(nCid)
  165.     lpdcb.bits2 = Chr$(Asc(lpdcb.bits2) Or finx)
  166.     lpdcb.XonChar = Chr$(Asc("Q") - 64)
  167.     lpdcb.XoffChar = Chr$(Asc("S") - 64)
  168.     lpdcb.XonLim = 256
  169.     lpdcb.XoffLim = 256
  170.  
  171.     SerialConfig = SetCommState(lpdcb)
  172.  
  173. End Function
  174.  
  175. Function SerialWrite (t$) As Integer
  176.  
  177.     Dim st As COMSTAT
  178.  
  179.     status% = GetCommError(nCid, st)
  180.     status% = WriteComm(nCid, t$, Len(t$))
  181.     If status% < 0 Then status% = GetCommError(nCid, st)
  182.     SerialWrite = status%
  183.  
  184. End Function
  185.  
  186. Function SerialRead (buf$, ByVal max%) As Integer
  187.  
  188.     Dim st As COMSTAT
  189.  
  190.     buf$ = Space$(max%)
  191.     i% = ReadComm(nCid, buf$, max%)
  192.  
  193.     If (i% > 0) Then
  194.         SerialRead = i%
  195.     Else
  196.         SerialRead = Abs(i%)
  197.         i% = GetCommError(nCid, st)
  198.     End If
  199.  
  200. End Function
  201.  
  202.