Private Sub MSComm1_OnComm()
Dim instring As String, y As Integer
Static Buffer As String
Dim i As Integer, x As String
instring = MSComm1.Input
Buffer = Buffer & instring
y = InStr(Buffer, vbCrLf)
While y > 0
instring = Left$(Buffer, y - 1)
Buffer = (Mid$(Buffer, y + 2))
If Not CID(instring) Then ModemResponse = Stripped(instring)
y = InStr(Buffer, vbCrLf)
Wend
End Sub
Function CID(instring As String) As Boolean
Dim x As String, y As Integer, q As String, w As String, i As Integer
Dim Z As String, O As String, Cname As String
Dim Tuday As String, Thisdate As String, NowsTime As String
Dim AC As String, SoundFile As String
Dim MessageLen As Integer, pointer As Integer, Field As String
Dim Number As String, T As String, a As Single, D As String
x = "MESG = "
'Message format:
'{header} {message length} {field1} {field2} ... {fieldn} {checksum}
'Typical messages:
'80 27 01 08 {mm dd hh mm} 02 0A {acd pre suff} 07 0F {name} 8D
'80 19 01 08 {mm dd hh mm} 02 0A {acd pre suff} 08 01 "O" 5F
'80 10 01 08 {mm dd hh mm} 04 01 4F 08 01 4F 5F
'{header} = 80h
'{message length} = number of bytes in message not including header, this byte, or checksum
pointer = InStr(instring, x) ' y points to header -1
If pointer = 0 Then CID = False: Exit Function ' not a caller ID message
CID = True
pointer = pointer + 1 + Len(x)
MessageLen = Asc(Mid(instring, pointer, 1)) + pointer 'length of message
pointer = pointer + 1 'point to 1st field
While pointer < MessageLen 'parse the fields
Select Case FieldType(instring, pointer, Field)
Case Is = 1 'date field
' 08 length of date field
' {mm dd hh mm} date and time
If SetTime Then
T = Mid$(Field, 5, 2) & ":" & Mid$(Field, 7, 2)
D = Mid$(Field, 1, 2) & "/" & Mid$(Field, 3, 2)
Time = T
Date = D
End If
x = Format(Date, "long date")
Tuday = Left$(x, InStr(x, ",") - 1)
Thisdate = Format(Date, "medium date")
NowsTime = Format(Time, "medium time")
Case Is = 2 'caller number field
' 0A length of caller number filed
' {acd pre suff} caller's number areacode+prefix+suffix
Z = Trim$(Right$(Field, 4)) 'suffix
q = Trim$(Mid$(Field, 4, 3)) 'prefix
w = Trim$(Left$(Field, 3)) 'area code
Number = Field
Case Is = 4 ' UnAvailable Caller Number
' 01 length of caller number filed
' 4F "O"
Number = "UnAvailable"
Case Is = 7 ' caller name field
' 0F length of caller name field
' {name} caller's name padded on left with spaces
Cname = Field
Case Is = 8 ' UnAvailable Caller Name
' 01 length of Unavailable field
' 4F signals callers name is unavailable
Cname = "UnAvailable"
End Select
Wend
SoundFile = GetSoundFile(Number, Cname)
If Number = "UnAvailable" And HangAnon Then 'Hangup on unwanted calls
SendModemCommand "ATA"
a = Timer + 0.5
While a > Timer: DoEvents: Wend
SendModemCommand "+++"
While a > Timer: DoEvents: Wend
SendModemCommand "ATH"
ElseIf SoundFile = "" Then 'Or announce an unknown caller
PlaySounds RingFileName
Call AnnounceCaller(Cname, Number)
Else 'Or announce known calls
PlaySounds RingFileName
Cname = Data1.Recordset("LastName") & " " & Data1.Recordset("FirstName")
PlaySounds SoundFile
End If
'Write call to log file
Open MainPath & "phone.log" For Append As #1
O = Space$(75)
Mid$(O, 1, Len(Cname)) = Cname
Mid$(O, 18, Len(Number) + 3) = Format$(Number, "(@@@)@@@-@@@@")
Mid$(O, 35, Len(Tuday)) = Tuday
Mid$(O, 50, Len(Thisdate)) = Thisdate
Mid$(O, 65, Len(NowsTime)) = NowsTime
Print #1, O
Close #1
'Add call to recent caller's list
RecentCalls.AddItem O
'Change task bar icon to indicate a called has been received
Set TBIcon1.Picture = Pic(1).Picture
'Save call in buffer for future use
Lastcall = Lastcall + 1
PreviousCall(Lastcall) = O
End Function
Function Stripped(x As String) As String
Dim y As Integer, Z As String
Z = x
y = InStr(Z, vbCr)
While y > 0
Mid(Z, y, 1) = " "
y = InStr(Z, vbCr)
Wend
Stripped = Z
End Function
Reply With Quote
downloaded the test to speach exe and installed, but still no joy, what am i doing wrong?
