DISCAR NO MODEM

MARIOZNETO 14/09/2005 15:38:53
#104153 Resposta escolhida

Sim,

Veja este exemplo usando Create File:

Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long

Private Const WAITSECONDS = 6
Private Const ID_CANCEL = 2
Private Const MB_OKCANCEL = 1
Private Const MB_ICONSTOP = 16
Private Const MB_ICONINFORMATION = 64

Private Sub Command1_Click()
DialNumber Text1.Text, Text2.Text
End Sub

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 i

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 i

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

[txt-size=3]'Pequei este código no Macoratti, não sei se funciona...[/txt-size]