各位大虾:
因为最近看了很多短信收发的编写,从网上下载了一下短个收发源代码,问题是可以发送,但无法收短信!请各位检查检查,指导下!谢谢!
具体代码如下: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 Command1_Click()
RequestRecMsg MsgIndex.Text
End SubPrivate Sub Form_Load() SmsInit 6, "9600,n,8,1"End Sub
Private Function SmsInit(Port As Integer, setstr As String) As Boolean
SmsInit = False
If SmsOpen(Port, setstr) = False Then Exit Function
WorkFlag = True
SendSuccessCount = 0
SendFailedCount = 0
ReceiveCount = 0
ReceiveData = ""
SendSuccess = 0
ReceiveSuccess = 0
SmsInit = True
End Function
Private Function SmsSend(MoblieID As String, TxtMessage As String) As Boolean '被timer1_timer调用
Dim TxtMsg As String SmsSend = False
If WorkFlag = False Or SendSuccess = -1 Then Exit Function
'编码
TxtMsg = Encode(TxtMessage)
If MSComm1.PortOpen Then
MSComm1.Output = "AT+CMGS=" + Chr(34) + MoblieID + Chr(34) + Chr(13) '送出短信目的号码
MSComm1.Output = TxtMsg + Chr(26) '送出已编码后的短信内容
SendSuccess = -1
SmsSend = True
End If
End FunctionFunction 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
因为最近看了很多短信收发的编写,从网上下载了一下短个收发源代码,问题是可以发送,但无法收短信!请各位检查检查,指导下!谢谢!
具体代码如下: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 Command1_Click()
RequestRecMsg MsgIndex.Text
End SubPrivate Sub Form_Load() SmsInit 6, "9600,n,8,1"End Sub
Private Function SmsInit(Port As Integer, setstr As String) As Boolean
SmsInit = False
If SmsOpen(Port, setstr) = False Then Exit Function
WorkFlag = True
SendSuccessCount = 0
SendFailedCount = 0
ReceiveCount = 0
ReceiveData = ""
SendSuccess = 0
ReceiveSuccess = 0
SmsInit = True
End Function
Private Function SmsSend(MoblieID As String, TxtMessage As String) As Boolean '被timer1_timer调用
Dim TxtMsg As String SmsSend = False
If WorkFlag = False Or SendSuccess = -1 Then Exit Function
'编码
TxtMsg = Encode(TxtMessage)
If MSComm1.PortOpen Then
MSComm1.Output = "AT+CMGS=" + Chr(34) + MoblieID + Chr(34) + Chr(13) '送出短信目的号码
MSComm1.Output = TxtMsg + Chr(26) '送出已编码后的短信内容
SendSuccess = -1
SmsSend = True
End If
End FunctionFunction 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 NextFlagEnd 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 Send_Click()
Success = -1
If Len(MobileTel.Text) < 11 Or Len(MobileTel.Text) > 12 Then
MsgBox "请输入正确的手机号"
Exit Sub
End If
If Len(SendMsg.Text) < 1 Or Len(SendMsg.Text) > 80 Then
MsgBox "必须信息或输入的信息不能超过80"
Exit Sub
End If
Status.Panels(2).Text = "正发送..."
SmsSend MobileTel.Text, SendMsg.Text
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
DO
‘中的那些代码有些问题。
Loop While NextFlag
也是vB
发现一个问题 就是不太明确到底OnComm事件的优先级的问题 比如正在进行一个过程 那如果有inputBuffer有字符 是不跳转去执行OnComm事件了
啊真的很苦恼。