1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
|
Option Compare Database
Option Explicit
Declare Function WriteFile& Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite&, lpNumberOfBytesWritten&, ByVal lpOverlapped&)
Declare Function CreateFile& Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName$, ByVal dwDesiredAccess&, ByVal dwShareMode&, ByVal lpSecurityAttributes&, ByVal dwCreationDisposition&, ByVal dwFlagsAndAttributes&, ByVal hTemplateFile&)
Declare Function CloseHandle& Lib "kernel32" (ByVal hObject&)
Declare Function FlushFileBuffers& Lib "kernel32" (ByVal hFile&)
Public Const WAITSECONDS = 4
Public Const ID_CANCEL = 2
Public Const MB_OKCANCEL = 1
Public Const MB_ICONSTOP = 16, MB_ICONINFORMATION = 64
Function DialNumber(PhoneNumber, CommPort As String)
Dim MSG As String, MsgBoxType As Integer, MsgBoxTitle As String
Dim bModemCommand(256) As Byte, ModemCommand As String
Dim OpenPort As Long
Dim retval As Long, RetBytes As Long, I As Integer
Dim StartTime
MSG = "Please pickup the phone and choose OK to dial " & PhoneNumber
MsgBoxType = MB_ICONINFORMATION + MB_OKCANCEL
MsgBoxTitle = "Dial Number"
If MsgBox(MSG, MsgBoxType, MsgBoxTitle) = ID_CANCEL Then
Exit Function
End If
OpenPort = CreateFile(CommPort, &HC0000000, 0, 0, 3, 0, 0)
If OpenPort = -1 Then
MSG = "Unable to open communication port " & CommPort
GoTo Err_DialNumber
End If
ModemCommand = "ATDT" & PhoneNumber & vbCrLf
For I = 0 To Len(ModemCommand) - 1
bModemCommand(I) = Asc(Mid(ModemCommand, I + 1, 1))
Next
retval = WriteFile(OpenPort, bModemCommand(0), _
Len(ModemCommand), RetBytes, 0)
If retval = 0 Then
MSG = "Unable to dial number " & PhoneNumber
GoTo Err_DialNumber
End If
retval = FlushFileBuffers(OpenPort)
StartTime = Timer
While Timer < StartTime + WAITSECONDS
DoEvents
Wend
ModemCommand = "ATH0" & vbCrLf
For I = 0 To Len(ModemCommand) - 1
bModemCommand(I) = Asc(Mid(ModemCommand, I + 1, 1))
Next
retval = WriteFile(OpenPort, bModemCommand(0), Len(ModemCommand), RetBytes, 0)
retval = FlushFileBuffers(OpenPort)
retval = CloseHandle(OpenPort)
Exit Function
Err_DialNumber:
MSG = MSG & vbCr & vbCr & "Make sure no other devices are using Com port " & CommPort
MsgBoxType = MB_ICONSTOP
MsgBoxTitle = "Dial Number Error"
MsgBox MSG, MsgBoxType, MsgBoxTitle
End Function |