Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/wsc4vb24/module32.bas

BASIC Source File | 1999-06-01 | 6.1 KB | 180 lines

'
' MODULE32.BAS [WSC4VB Ver 2.4; VBA Declarations]
'
' For EXCEL97, ACCESS97, and WORD97.
'
' Create a button in your VBA application. The default name will be "CommandButton1",
' and the VBA code will contain code that looks like
'
'   Private Sub CommandButton1_Click()
'
'    End Sub
'
' Replace the generated code with this entire module. Connect port COM1 to a modem.
' When executed, this module will transmit an "AT" to the modem. The modem should
' respond with "OK".
'

Private Declare Function SioBaud Lib "WSC32.DLL" (ByVal Port As Long, ByVal BaudCode As Long) As Long
Private Declare Function SioBrkSig Lib "WSC32.DLL" (ByVal Port As Long, ByVal Cmd As Long) As Long
Private Declare Function SioCTS Lib "WSC32.DLL" (ByVal Port As Long) As Long
Private Declare Function SioDCD Lib "WSC32.DLL" (ByVal Port As Long) As Long
Private Declare Function SioDone Lib "WSC32.DLL" (ByVal Port As Long) As Long
Private Declare Function SioDSR Lib "WSC32.DLL" (ByVal Port As Long) As Long
Private Declare Function SioDTR Lib "WSC32.DLL" (ByVal Port As Long, ByVal Char As Long) As Long
Private Declare Function SioEvent Lib "WSC32.DLL" (ByVal Port As Long, ByVal Mask As Long)
Private Declare Function SioFlow Lib "WSC32.DLL" (ByVal Port As Long, ByVal Code As Long) As Long
Private Declare Function SioGetc Lib "WSC32.DLL" (ByVal Port As Long) As Long
Private Declare Function SioGets Lib "WSC32.DLL" (ByVal Port As Long, ByVal Buffer As String, ByVal StringSize As Long) As Long
Private Declare Function SioInfo Lib "WSC32.DLL" (ByVal Cmd As Long) As Long
Private Declare Function SioParms Lib "WSC32.DLL" (ByVal Port As Long, ByVal Code1 As Long, ByVal Code2 As Long, ByVal Code3 As Long) As Long
Private Declare Function SioPutc Lib "WSC32.DLL" (ByVal Port As Long, ByVal Char As Long) As Long
Private Declare Function SioPuts Lib "WSC32.DLL" (ByVal Port As Long, ByVal Buffer As String, ByVal Size As Long) As Long
Private Declare Function SioRead Lib "WSC32.DLL" (ByVal Port As Long, ByVal Reg) As Long
Private Declare Function SioReset Lib "WSC32.DLL" (ByVal Port As Long, ByVal RxQueSize As Long, ByVal TxQueSize As Long) As Long
Private Declare Function SioRI Lib "WSC32.DLL" (ByVal Port As Long) As Long
Private Declare Function SioRTS Lib "WSC32.DLL" (ByVal Port As Long, ByVal Char As Long) As Long
Private Declare Function SioRxClear Lib "WSC32.DLL" (ByVal Port As Long) As Long
Private Declare Function SioRxQue Lib "WSC32.DLL" (ByVal Port As Long) As Long
Private Declare Function SioStatus Lib "WSC32.DLL" (ByVal Port As Long, ByVal Mask As Long) As Long
Private Declare Function SioTimer Lib "WSC32.DLL" () As Long
Private Declare Function SioTxClear Lib "WSC32.DLL" (ByVal Port As Long) As Long
Private Declare Function SioTxQue Lib "WSC32.DLL" (ByVal Port As Long) As Long
Private Declare Function SioUnGetc Lib "WSC32.DLL" (ByVal Port As Long, ByVal Char As Long) As Long
Private Declare Function SioWinError Lib "WSC32.DLL" (ByVal Buffer As String, ByVal Size As Long) As Long

Rem COM port codes

 Private Const COM1 = 0
 Private Const COM2 = 1
 Private Const COM3 = 2
 Private Const COM4 = 3
 Private Const COM5 = 4
 Private Const COM6 = 5
 Private Const COM7 = 6
 Private Const COM8 = 7
 Private Const COM9 = 8
 Private Const COM10 = 9
 Private Const COM11 = 10
 Private Const COM12 = 11
 Private Const COM13 = 12
 Private Const COM14 = 13
 Private Const COM15 = 14
 Private Const COM16 = 15
 Private Const COM17 = 16
 Private Const COM18 = 17
 Private Const COM19 = 18
 Private Const COM20 = 19

Rem Parity Codes

Private Const NoParity = 0
Private Const OddParity = 1
Private Const EvenParity = 2
Private Const MarkParity = 3
Private Const SpaceParity = 4

Rem Stop Bit Codes

Private Const OneStopBit  = 0
Private Const One5StopBit = 1
Private Const TwoStopBits = 2

Rem Word Length Codes

Private Const WordLength5 = 5
Private Const WordLength6 = 6
Private Const WordLength7 = 7
Private Const WordLength8 = 8

Rem baud codes

Private Const Baud110 = 0
Private Const Baud300 = 1
Private Const Baud1200 = 2
Private Const Baud2400 = 3
Private Const Baud4800 = 4
Private Const Baud9600 = 5
Private Const Baud19200 = 6
Private Const Baud38400 = 7
Private Const Baud57600 = 8
Private Const Baud115200 = 9

Rem SioGetError Masks

Private Const WSC_RXOVER = &H1
Private Const WSC_OVERRUN = &H2
Private Const WSC_PARITY = &H4
Private Const WSC_FRAME = &H8
Private Const WSC_BREAK = &H10
Private Const WSC_TXFULL = &H100

Rem Command codes

Private Const ASSERT_BREAK = 65
Private Const CANCEL_BREAK = 67
Private Const DETECT_BREAK = 68

Private Const SET_LINE = 83
Private Const CLEAR_LINE = 67
Private Const READ_LINE = 82

Rem Return codes

Private Const IE_BADID = -1
Private Const IE_OPEN = -2
Private Const IE_NOPEN = -3
Private Const IE_MEMORY = -4
Private Const IE_DEFAULT = -5
Private Const IE_HARDWARE = -10
Private Const IE_BYTESIZE = -11
Private Const IE_BAUDRATE = -12
Private Const WSC_NO_DATA = -100
Private Const WSC_RANGE = -101
Private Const WSC_ABORTED = -102
Private Const WSC_WIN32ERR = -103

Private Sub Sleep(ByVal MilliSec As Long)
Dim Time As Long
Time = SioTimer() + MilliSec
While SioTimer() < Time
Wend
End Sub

Private Sub CommandButton1_Click()
Dim Code As Long
Dim S As String
Dim NL As String
Dim X As String * 32
Dim ThePort As Long
' begin
ThePort = COM1
NL = Chr$(13) + Chr$(10)
' open port
Code = SioReset(ThePort, 128, 128)
If Code < 0 Then
  MsgBox "Error " + Str$(Code), , "SioReset fails"
  Exit Sub
End If
Code = SioBaud(ThePort, 19200)
' set DTR & RTS when talking to modem
Code = SioDTR(ThePort, Asc("S"))
Code = SioRTS(ThePort, Asc("S"))
' transmit AT command (should delay between each character)
Code = SioPutc(ThePort, Asc("A"))
Call Sleep(20)
Code = SioPutc(ThePort, Asc("T"))
Call Sleep(20)
Code = SioPutc(ThePort, 13)
' wait for response
Call Sleep(250)
' get response (expecting "OK")
Code = SioGets(ThePort, X, 32)
If Code > 0 Then
  MsgBox "Transmitted 'AT', and got " + NL + Left$(X,Code) + NL
Else
  MsgBox "Transmitted 'AT', and got no response."
End If
Code = SioDone(ThePort)
End Sub