Option Explicit
Public bOK As Boolean
Public bError As Boolean
Public Buffer
Public bMessageStore As Boolean
Public strMessageBuffer As String
Public bGreaterSign As Boolean
Public OL As Integer
Private Sub Command1_Click()
Dim sms As String
If MSComm1.PortOpen = False Then
MSComm1.DTREnable = True
MSComm1.RTSEnable = True
MSComm1.RThreshold = 1
MSComm1.InputLen = 1
MSComm1.Settings = "115200, N, 8, 1"
MSComm1.PortOpen = True
End If
'echo off
MSComm1.Output = "ATE0" & Chr$(13)
Do
DoEvents
Buffer = Buffer & MSComm1.Input
Loop Until InStr(Buffer, "OK")
MSComm1.Output = "AT+CMGF=0" & Chr$(13)
Do
DoEvents
Buffer = Buffer & MSComm1.Input
Loop Until InStr(Buffer, "OK")
Buffer = ""
' sms = MakeSms("004917212345678", "Does it work?")
sms = MakeSms("9177414078", "Does it work?")
Debug.Print sms
MSComm1.Output = "AT+CMGS=" & Len(sms) / 2 & Chr$(13)
Do
DoEvents
Buffer = Buffer & MSComm1.Input
Loop Until InStr(Buffer, ">")
Debug.Print Buffer
MSComm1.Output = sms + Chr$(26)
Do
DoEvents
Buffer = Buffer & MSComm1.Input
Loop Until InStr(Buffer, "OK")
Debug.Print Buffer
MSComm1.PortOpen = False
End Sub
Function MakeSms(number As String, txt As String) As String
MakeSms = "001100"
' MakeSms = "0011"
MakeSms = MakeSms + ConvNumber(number)
' MakeSms = MakeSms + "000064"
MakeSms = MakeSms + "0000AA"
' MakeSms = MakeSms + "0000"
MakeSms = MakeSms + ConvTxt(txt)
End Function
Function ConvNumber(num As String) As String
Dim i As Integer
Dim numType As String
'default local number
' numType = "81"
numType = "91"
'but if international number then .....
' If Left$(num, 3) = "+00" And Len(num) > 3 Then num = Mid$(num, 4): numType = "91"
' If Left$(num, 2) = "00" And Len(num) > 2 Then num = Mid$(num, 3): numType = "91"
' If Left$(num, 1) = "+" And Len(num) > 1 Then num = Mid$(num, 2): numType = "91"
ConvNumber = Right$("00" & Hex(Len(num)), 2)
ConvNumber = ConvNumber + numType
For i = 1 To Len(num) Step 2
ConvNumber = ConvNumber + Mid$(num + "F", i + 1, 1) + Mid$(num + "F", i, 1)
Next i
End Function
Function ConvTxt(txt As String) As String
Dim i As Integer
Dim datArr1(1 To 256) As Byte
Dim l As Integer
Dim touw As String
'no more than 160 chars
If Len(txt) > 160 Then txt = Left$(txt, 160)
l = Len(txt)
ConvTxt = Right$("00" & Hex(Len(txt)), 2)
For i = 1 To l
datArr1(i) = Asc(Mid$(txt, i, 1))
Next i
'make a bit stream of septets
touw = ""
For i = 1 To l
touw = ToBin7(datArr1(i)) + touw
Next i
'and convert it to octets
While Len(touw) > 8
ConvTxt = ConvTxt + Bin2Hex(Right$(touw, 8))
touw = Mid$(touw, 1, Len(touw) - 8)
Wend
OL = Len(ConvTxt)
' OL = Hex$(OL)
ConvTxt = Bin2Hex(OL) + ConvTxt
ConvTxt = ConvTxt + Bin2Hex(touw) ' original code
' ConvTxt = OL + ConvTxt + Bin2Hex(touw) ' added newly
Debug.Print ConvTxt
End Function
Function ToBin7(ByVal num As Byte) As String
'convert to padded 7 place binary number
While num > 0
ToBin7 = Trim(num Mod 2) + ToBin7
num = num \ 2
Wend
ToBin7 = Right$("0000000" + ToBin7, 7)
End Function
Function Bin2Hex(ByVal touw As String) As String
'convert binary to a padded 2 place hex number
Dim x As Integer
Dim num As Long
For x = 1 To Len(touw)
If Mid$(touw, x, 1) = "1" Then
num = num + 2 ^ (Len(touw) - x)
End If
Next x
Bin2Hex = Right$("00" + Hex(num), 2)
End Function
Public Sub Wait()
Dim start
start = Timer
Do While Timer < start + 8
DoEvents
If bOK Then
Exit Sub
End If
If bError Then
Exit Sub
End If
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub MSComm1_OnComm()
Static stEvent As String
Dim stComChar As String * 1
Buffer = ""
Select Case MSComm1.CommEvent
Case comEvReceive
Do
On Error GoTo handler
stComChar = MSComm1.Input
Buffer = Buffer + stComChar
If bMessageStore Then
strMessageBuffer = strMessageBuffer & stComChar
End If
Select Case stComChar
Case ">"
bGreaterSign = True
Case vbLf
Case vbCr
If Len(stEvent) > 0 Then
ProcessEvent stEvent
stEvent = ""
End If
Case Else
stEvent = stEvent + stComChar
End Select
Loop While MSComm1.InBufferCount
Case 2
MsgBox "Modem Unplugged", vbInformation
End Select
handler:
End Sub
Private Sub ProcessEvent(stEvent As String)
Dim stNumber As String
If Mid$(stEvent, 1, 5) = "+CMTI" Then
' frmSendSingleMessage.Enabled = False
Timer1.Enabled = False
strMessageBuffer = ""
' While frmSend.SendingMessage = "yes"
' DoEvents
' Wend
stEvent = ""
' Command3_Click
' LoadInbox
' bpp_list.Refresh
bOK = False
bError = False
MSComm1.Output = "AT+CMGD=1,3" & vbCrLf
While Not bOK Or bError
DoEvents
Wait
Wend
' Timer1.Enabled = True
If bError Then
MsgBox "Unable to delete"
End If
Exit Sub
End If
Select Case stEvent
Case "OK"
bOK = True
Case "ERROR"
bError = True
Case "RING"
MsgBox "Incoming Call Alert", vbInformation
' If bRing = False Then
' bRing = True
' End If
' iRingTime = Timer
Case Else
Select Case Left(stEvent, 4)
Case "TIME"
Case "DATE"
Case "NMBR"
Case "NAME"
End Select
End Select
End Sub
Reply With Quote
Originally Posted by westconn1
