VB6.0编写手机短信收发的问题
通常代码就是unicode转pdu实现中文收发,可是下边的就不明白了,望高手指点!
Dim SendSuccessCount As Integer
Dim SendFailedCount As Integer
Dim ReceiveCount As Integer
Dim WorkFlag As Boolean
Dim ReceiveData As String
Dim SendSuccess As Integer '-1等待;0失败;1成功
Dim ReceiveSuccess As Integer '-1等待;0失败;1成功
Private Sub Form_Load()
SmsInit 3, "9600,n,8,1"
End Sub
Function SmsOpen(Port As Integer, Setings As String) As Integer '被opensms_click 调用
On Error GoTo ErrHandle
SmsOpen = False
If MSComm1.PortOpen Then MSComm1.PortOpen = False
MSComm1.CommPort = Port
MSComm1.Settings = Setings
MSComm1.PortOpen = True
If MSComm1.PortOpen Then
SmsOpen = True
MSComm1.Output = "ATE0" + Chr(13) + Chr(10)
MSComm1.RThreshold = 1
MSComm1.Output = "AT+CMGF=1" + Chr(13) + Chr(10)
MSComm1.Output = "AT+CSMP=4,167,0,8" + Chr(13) + Chr(10)'上边两行语句作为联机是初始化用的命令
End If
Exit Function
ErrHandle:
MsgBox "错误: " + Str(Err.Number) + Chr(13) + Chr(10) + Err.Description, _
vbOKOnly + vbCritical, App.Title
End Function
Private Sub MSComm1_OnComm()
Dim buffer As String
Dim i As Integer, j As Integer
Dim NextFlag As Boolean
ReceiveData = ReceiveData + MSComm1.Input
Do
NextFlag = False
j = InStr(ReceiveData, "+CMS")
If j > 0 Then
ReceiveSuccess = 0
End If
i = InStr(ReceiveData, "+CMGR:")
j = InStr(ReceiveData, "+CMGS")
If j = 0 And i = 0 And Len(ReceiveData) > 8 Then '删除接收区中无用的数据
ReceiveData = Mid(ReceiveData, Len(ReceiveData) - 7)
End If
If j > 0 And j < i And 14 >= Len(ReceiveData) - j Then '最前的数据为发送返回结果
If SendSuccess = -1 Then
buffer = Mid(ReceiveData, j, 14)
If InStr(buffer, "OK") > 0 Then
SendSuccess = 1
SendSuccessCount = SendSuccessCount + 1
Else
SendSuccess = 0
SendFailedCount = SendFailedCount + 1
End If
End If
ReceiveData = Mid(ReceiveData, j + 14)
NextFlag = True
Else
If i > 0 Then
j = InStr(ReceiveData, Chr(13) + Chr(10) + "OK")
If j > 0 Then
buffer = Mid(ReceiveData, i, j - i)
ReceiveSuccess = 0
If Analyze(buffer) Then
ReceiveSuccess = 1 '接收成功
ReceiveCount = ReceiveCount + 1
End If
ReceiveData = Mid(ReceiveData, j + 3)
NextFlag = True
End If
End If
End If
Loop While NextFlag
End Sub
Function Analyze(RecMsg As String) As Boolean
Dim tel As String, msg As String, time As String
Analyze = AnalyzeRecMsg(buffer, tel, msg, time)
If Analyze = True Then
'用户处理
MobileTel.Text = tel
SendMsg.Text = msg
' Label1.Caption = time
End If
End Function
Private Sub MsgIndex_Change()
End Sub
Private Function Encode(TxtMessage As String) As String
Dim High As String, Low As String, OneWord As String
Dim i As Integer
For i = 1 To Len(TxtMessage) '将短信息转化为编码
OneWord = Mid(TxtMessage, i, 1)
Low = Hex(AscB(MidB(OneWord, 1, 1)))
High = Hex(AscB(MidB(OneWord, 2, 1)))
If Len(High) = 1 Then High = "0" + High
If Len(Low) = 1 Then Low = "0" + Low
Encode = Encode + High + Low '得到的编码
Next i
End Function
Private Function Decode(EncodeMessage As String) As String
Dim Word(2) As Byte
Dim ascii As String
Dim Temp As String
Dim j As Integer, Pos As Integer
Pos = 1
j = 1
Do
If j >= Len(EncodeMessage) Then
Exit Function
End If
ascii = Mid(EncodeMessage, j, 2)
j = j + 2
Word(Pos) = Val("&H" + ascii)
Pos = Pos - 1
If Pos < 0 Then
Temp = Word
Decode = Decode + Left(Temp, 1)
Pos = 1
End If
Loop
End Function
Private Function GetBPNumber(RecDecodeMsg As String) As String
Dim i As Integer
Dim Start As Boolean
Dim OneWord As String
GetBPNumber = ""
Start = False
For i = 1 To Len(RecDecodeMsg)
OneWord = Mid(RecDecodeMsg, i, 1)
If OneWord >= "0" And OneWord <= "9" Then
Start = True
GetBPNumber = GetBPNumber + OneWord
Else
If Start = False Then
If OneWord <> " " Then Exit Function
Else
If OneWord = " " Then
Do
i = i + 1
OneWord = Mid(RecDecodeMsg, i, 1)
Loop While OneWord = " " And i < Len(RecDecodeMsg)
End If
RecDecodeMsg = Mid(RecDecodeMsg, i)
Exit Function
End If
End If
Next i
End Function
Private Function AnalyzeRecMsg(ByVal RecMsg As String, ByRef MobileNumber As String, ByRef msg As String, ByRef MsgTime As String) As Boolean
Dim i As Integer, j As Integer
Dim AnalyzeMsg As String
Dim Length As Integer
AnalyzeRecMsg = False
i = InStr(RecMsg, "+CMGR:")
If i < 1 Then Exit Function
AnalyzeMsg = Mid(RecMsg, i + 6)
i = InStr(AnalyzeMsg, Chr(34) + "+86")
If i < 1 Then Exit Function
j = InStr(i + 1, AnalyzeMsg, Chr(34))
If j < i Then Exit Function
MobileNumber = Mid(AnalyzeMsg, i + 4, j - i - 4)
AnalyzeMsg = Mid(AnalyzeMsg, j)
i = InStr(AnalyzeMsg, ",")
If i < 1 Then Exit Function
i = InStr(i, AnalyzeMsg, ",")
If i < 1 Then Exit Function
i = InStr(i, AnalyzeMsg, Chr(34))
If i < 1 Then Exit Function
j = InStr(i + 1, AnalyzeMsg, Chr(34))
If j < i Then Exit Function
MsgTime = Mid(AnalyzeMsg, i + 1, j - i - 4)
AnalyzeMsg = Mid(AnalyzeMsg, j)
i = InStr(AnalyzeMsg, Chr(13) + Chr(10))
If i < 1 Then Exit Function
j = InStrRev(AnalyzeMsg, ",", i)
If j < 1 Then Exit Function
Length = Val(Mid(AnalyzeMsg, j + 1, i - j - 1))
j = InStr(i + 2, AnalyzeMsg, Chr(13) + Chr(10))
If j < 1 Then Exit Function
msg = Mid(AnalyzeMsg, i + 2, j - i - 2)
If Len(msg) > Length Then
msg = Decode(msg)
End If
AnalyzeRecMsg = True
End Function
Private Function RequestRecMsg(MsgIndex As String) As Boolean
RequestRecMsg = False
If ReceiveSuccess = -1 Then Exit Function
ReceiveSuccess = -1
RequestRecMsg = True
MSComm1.Output = "AT+CSDH=1" + Chr(13) + Chr(10)
MSComm1.Output = "AT+CMGR=" + MsgIndex + Chr(13) + Chr(10)
End Function
Private Function RequestDelMsg(MsgIndex As String)
MSComm1.Output = "AT+CMGD=" + MsgIndex + Chr(13) + Chr(10)
End Function