📄 frmreceive.frm
字号:
'</Gjr030824Modi>
SMSContent = Mid(StrArray(I), StartPosition + 58, SMSContentLen * 2)
UnZipStr = PubUnZip_English(SMSContent)
PubStatus "收到" & PubSimNumber & "发来短信。", True
'<Gjr030826Added>
PubStatus "短信：" & StrArray(I)
'</Gjr030826Added>
PubStatus "短信内容：" & SMSContent
PubStatus "解压内容：" & UnZipStr
If Len(UnZipStr) > 0 Then
If Len(UnZipStr) >= 5 And Len(UnZipStr) <= 12 And IsNumeric(Right(UnZipStr, 1)) = True Then
With rdsmsreceive
.Open "select*from ReceiveSMS", Cn, adOpenKeyset, adLockPessimistic
.AddNew
.Fields!接收时间 = Now
.Fields!接收内容 = UnZipStr
.Fields!是否提示 = "否"
.Fields!手机号 = PubSimNumber
.Update
.Close
End With
End If
End If
'分析字符串中参数，并向移动站发送
If UnZipStr <> "" Then
'AnlisysAndSend UnZipStr, PubSimNumber
End If
Debug.Print StrArray(I)
'保存当前信息编号
If IsNumeric(Mid(StrArray(I), StartPosition - 14, 3)) Then
DelNum = Val(Mid(StrArray(I), StartPosition - 14, 3))
End If
'如果有已读过短信，则删除
If DelNum <> -1 Then
DelSMS_G18 DelNum
End If
ElseIf Mid(StrArray(I), StartPosition + 40, 2) = "08" Then
'短信按中文方式处理 注:SMSContentLen是整条短信的长度。
'<Gjr030826Modi>
SMSContentLen = Val(HtoD_1byte(Mid(StrArray(I), StartPosition + 56, 2))) * 2
SMSContent = Mid(StrArray(I), StartPosition + 58, SMSContentLen)
'SMSContentLen = Val(Mid(StrArray(i), StartPosition - 4, 2)) - 20 + intP
'SMSContent = Mid(StrArray(i), StartPosition + 58, SMSContentLen * 2)
'</Gjr030826Modi>
UnZipStr = PubUnZip_Chinese(SMSContent)
PubStatus "收到" & PubSimNumber & "发来短信。", True
'<Gjr030826Added>
PubStatus "短信：" & StrArray(I)
'</Gjr030826Added>
PubStatus "短信内容：" & SMSContent
PubStatus "解压内容：" & UnZipStr
If Len(UnZipStr) > 0 Then
If Len(UnZipStr) >= 5 And Len(UnZipStr) <= 12 And IsNumeric(Right(UnZipStr, 1)) = True Then
With rdsmsreceive
.Open "select*from receivesms", Cn, adOpenKeyset, adLockPessimistic
.AddNew
.Fields!接收时间 = Now
.Fields!接收内容 = Trim(UnZipStr)
.Fields!是否提示 = "否"
.Fields!手机号 = PubSimNumber
.Update
.Close
End With
End If
End If
'分析字符串中参数，并向移动站发送
If UnZipStr <> "" Then
'AnlisysAndSend UnZipStr, PubSimNumber
End If
'保存当前信息编号
If IsNumeric(Mid(StrArray(I), StartPosition - 14, 3)) Then
DelNum = Val(Mid(StrArray(I), StartPosition - 14, 3))
End If
'如果有已读过短信，则删除
If DelNum <> -1 Then
DelSMS_G18 DelNum
End If
Else
PubStatus "不可识别的信息类型：" & Mid(StrArray(I), StartPosition + 40, 2)
'保存当前信息编号
If IsNumeric(Mid(StrArray(I), StartPosition - 14, 3)) Then
DelNum = Val(Mid(StrArray(I), StartPosition - 14, 3))
End If
'保存不可识别信息到通讯文本文件
PubStatus "收到不可识别的信息类型，信息内容：" & StrArray(I), True
'如果有已读过短信，则删除
If DelNum <> -1 Then
DelSMS_G18 DelNum
End If
End If
Else
PubStatus "短信长度非法。StrArray(" & I & ")=" & StrArray(I)
End If
'延时，防止接收多个短信时，ReceiveTime重复
PubDelay 1000
End If
Next I
End Sub
'////////////////////////////////////////////
'删除一条短信
'////////////////////////////////////////////
Private Sub DelSMS_G18(ByVal vInputNum As Integer)
Dim InputStrS
Dim InputStrL
Dim I As Integer
G18.Output = "AT+CMGD=" & vInputNum & Chr(13)
For I = 1 To 5
PubDelay (1000)
InputStrS = G18.Input
InputStrL = InputStrL + InputStrS
If InStr(InputStrL, "OK" & Chr(13) & Chr(10)) <> 0 Then
Exit For
End If
Next
End Sub
'///////////////////////////////////////////////////////////////////////////
'输出字符到状态窗口
'参数vAddblankline用于设置是否在输入字符前面加入空行。True——加入空行。
'////////////////////////////////////////////////////////////////////////////
Public Sub PubStatus(InputStr As String, Optional vAddblankline As Boolean)
Dim StartPosition As Integer
Dim CmdNum As Integer
Dim msgFileName As String
If InputStr <> "" Then
'删除字符串 Chr(13) & Chr(10)
Do While InStr(InputStr, Chr(13) & Chr(10))
StartPosition = InStr(InputStr, Chr(13) & Chr(10))
InputStr = Mid(InputStr, 1, StartPosition - 1) & " " & Mid(InputStr, StartPosition + 2)
Loop
'判断是否需要在输入字符前加入空行
If vAddblankline = True Then
txtStatus.Text = txtStatus.Text & Chr(13) & Chr(10) & Time & ": " & InputStr & Chr(13) & Chr(10)
Else
txtStatus.Text = txtStatus.Text & Time & ": " & InputStr & Chr(13) & Chr(10)
End If
txtStatus.SelStart = Len(txtStatus.Text)
End If
'自动保存提示信息到 "app.path\ComMsg"目录下
msgFileName = Right("0000" & Year(Now), 4) & Right("00" & Month(Now), 2) & Right("00" & Day(Now), 2) & ".txt"
'保存文件
CmdNum = FreeFile
Open App.Path & "\pubMsg\" & msgFileName For Append As CmdNum
If vAddblankline = True Then
Print #CmdNum, Chr(13) & Chr(10) & Time & ": " & InputStr
Else
Print #CmdNum, Time & ": " & InputStr
End If
Close CmdNum
End Sub
'/////////////////////////////////////////////
'清空短信串口接收和发送缓冲区
'/////////////////////////////////////////////
Private Sub ClrSMSInputOutputBuffer()
G18.Output = "AT" & Chr(13)
PubDelay (300)
Do While G18.InBufferCount <> 0
G18.InBufferCount = 0
PubDelay (200)
Loop
G18.OutBufferCount = 0
End Sub
'//////////////////////////////////////////////////////////////
'延时若干毫秒
'//////////////////////////////////////////////////////////////
Public Sub PubDelay(DT As Long)
Dim T As Long
T = GetTickCount()
Do
'DoEvents
Loop Until GetTickCount - T > DT
End Sub
'/////////////////////////////////////////////////////////////////
'输入短信压缩后十六进制字符串，输出解压缩后字符串
'/////////////////////////////////////////////////////////////////
Private Function PubUnZip_English(ByVal InputStr As String) As String
Dim tempStr As String
Dim I As Integer
'输入字符串须为十六进制字符串
If IsHexStr(InputStr) = False Then
PubUnZip_English = ""
Exit Function
End If
If Len(InputStr) / 2 <> Int(Len(InputStr) / 2) Then
'MsgBox "输入的字符个数不能为奇数！"
PubUnZip_English = ""
Exit Function
End If
If Len(InputStr) = 14 Then
tempStr = HtoB_long(InputStr)
PubUnZip_English = PubUnZip_English + Mid(tempStr, 2, 7) + Mid(tempStr, 11, 6) + Mid(tempStr, 1, 1) _
+ Mid(tempStr, 20, 5) + Mid(tempStr, 9, 2) + Mid(tempStr, 29, 4) + Mid(tempStr, 17, 3) _
+ Mid(tempStr, 38, 3) + Mid(tempStr, 25, 4) + Mid(tempStr, 47, 2) + Mid(tempStr, 33, 5) _
+ Mid(tempStr, 56, 1) + Mid(tempStr, 41, 6)
Else
Do While Len(InputStr) >= 14
tempStr = HtoB_long(Mid(InputStr, 1, 14))
InputStr = Mid(InputStr, 15)
PubUnZip_English = PubUnZip_English + Mid(tempStr, 2, 7) + Mid(tempStr, 11, 6) + Mid(tempStr, 1, 1) _
+ Mid(tempStr, 20, 5) + Mid(tempStr, 9, 2) + Mid(tempStr, 29, 4) + Mid(tempStr, 17, 3) _
+ Mid(tempStr, 38, 3) + Mid(tempStr, 25, 4) + Mid(tempStr, 47, 2) + Mid(tempStr, 33, 5) _
+ Mid(tempStr, 56, 1) + Mid(tempStr, 41, 6) + Mid(tempStr, 49, 7)
Loop
If Len(InputStr) > 0 And Len(InputStr) < 14 Then
Select Case Len(InputStr)
Case 2
PubUnZip_English = PubUnZip_English + Mid(HtoB_long(InputStr), 2, 7)
Case 4
PubUnZip_English = PubUnZip_English + Mid(HtoB_long(InputStr), 2, 7) + Mid(HtoB_long(InputStr), 11, 6) + Mid(HtoB_long(InputStr), 1, 1)
Case 6
PubUnZip_English = PubUnZip_English + Mid(HtoB_long(InputStr), 2, 7) + Mid(HtoB_long(InputStr), 11, 6) + Mid(HtoB_long(InputStr), 1, 1) + Mid(HtoB_long(InputStr), 20, 5) + Mid(HtoB_long(InputStr), 9, 2)
Case 8
PubUnZip_English = PubUnZip_English + Mid(HtoB_long(InputStr), 2, 7) + Mid(HtoB_long(InputStr), 11, 6) + Mid(HtoB_long(InputStr), 1, 1) + Mid(HtoB_long(InputStr), 20, 5) + Mid(HtoB_long(InputStr), 9, 2) + Mid(HtoB_long(InputStr), 29, 4) + Mid(HtoB_long(InputStr), 17, 3)
Case 10
PubUnZip_English = PubUnZip_English + Mid(HtoB_long(InputStr), 2, 7) + Mid(HtoB_long(InputStr), 11, 6) + Mid(HtoB_long(InputStr), 1, 1) + Mid(HtoB_long(InputStr), 20, 5) + Mid(HtoB_long(InputStr), 9, 2) + Mid(HtoB_long(InputStr), 29, 4) + Mid(HtoB_long(InputStr), 17, 3) + Mid(HtoB_long(InputStr), 38, 3) + Mid(HtoB_long(InputStr), 25, 4)
Case 12
PubUnZip_English = PubUnZip_English + Mid(HtoB_long(InputStr), 2, 7) + Mid(HtoB_long(InputStr), 11, 6) + Mid(HtoB_long(InputStr), 1, 1) + Mid(HtoB_long(InputStr), 20, 5) + Mid(HtoB_long(InputStr), 9, 2) + Mid(HtoB_long(InputStr), 29, 4) + Mid(HtoB_long(InputStr), 17, 3) + Mid(HtoB_long(InputStr), 38, 3) + Mid(HtoB_long(InputStr), 25, 4) + Mid(HtoB_long(InputStr), 47, 2) + Mid(HtoB_long(InputStr), 33, 5)
Case Else
'MsgBox ("短信解压缩错误！！" & Chr(13) & Chr(10))
PubUnZip_English = ""
Exit Function
End Select
End If
End If
tempStr = PubUnZip_English
PubUnZip_English = ""
For I = 1 To Len(tempStr) Step 7
PubUnZip_English = PubUnZip_English + Chr(BtoD(Mid(tempStr, I, 7)))
Next
Debug.Print tempStr
End Function
'/////////////////////////////////////////////////////////////////
'输入短信Unicode代码，输出汉字字符串
'/////////////////////////////////////////////////////////////////
Public Function PubUnZip_Chinese(ByVal vInputStr As String) As String
Dim I As Integer
'输入字符串为空或长度不是四的整数，返回空字符串。
If Len(vInputStr) = 0 Or (Len(vInputStr) / 2 <> Int(Len(vInputStr) / 2)) Then
PubUnZip_Chinese = ""
'Debug.Print Len(vInputStr)
Exit Function
End If
For I = 1 To Len(vInputStr) Step 4
PubUnZip_Chinese = PubUnZip_Chinese & ChrW(HtoD_2byte(Mid(vInputStr, I, 4)))
Next
End Function
'////////////////////////////////////////////////////
'检验用户手机叫参数是否合法
'////////////////////////////////////////////////////
Private Function TestParameter(ByVal vInputStr As String) As Boolean
Dim tempArray() As String
Dim I As Integer
TestParameter = True
'长度不允许小于7个字节且不大于40个字节
If Len(vInputStr) < 7 Or Len(vInputStr) > 40 Then
TestParameter = False
Exit Function
End If
vInputStr = Mid(vInputStr, 6)
tempArray = Split(vInputStr, "0")
For I = LBound(tempArray) To UBound(tempArray)
If Not (tempArray(I) = "11" Or tempArray(I) = "21" Or tempArray(I) = "31" Or tempArray(I) = "41" Or _
tempArray(I) = "51" Or tempArray(I) = "61" Or tempArray(I) = "71" Or tempArray(I) = "12" _
Or tempArray(I) = "22" Or tempArray(I) = "32" Or tempArray(I) = "42" Or tempArray(I) = "52") Then
TestParameter = False
End If
Next
End Function
'***********************************************************************************
'正常SIM卡号转化为发送格式SIM卡号,输入11字符，输出12位字符
'***********************************************************************************
Private Function SIMSendChange(SIMString As String)
Dim I As Integer
I = 2
Do While I <= 10
SIMSendChange = SIMSendChange + Mid(SIMString, I, 1) + Mid(SIMString, I - 1, 1)
I = I + 2
Loop
SIMSendChange = SIMSendChange + "F" + Mid(SIMString, 11, 1)
End Function
'**************************************************************
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -