smsdeal.cls

通过西门子模块收发短信

         strLenthCode = Right(Left(strRemainPart, 20), 2)
         HeadTag = ""
         
         If InStr(Right(strSMSComin, Len(strSMSComin) - 80), "0500") >= 4 And InStr(Right(strSMSComin, Len(strSMSComin) - 80), "0500") <= 10 Then
            HeadTag = "0500"
         ElseIf InStr(Right(strSMSComin, Len(strSMSComin) - 80), "0608") >= 4 And InStr(Right(strSMSComin, Len(strSMSComin) - 80), "0608") <= 10 Then
            HeadTag = "0608"
         End If
            
         If HeadTag <> "" Then
            PartContPdu = GetBetweenPart(Right(strSMSComin, Len(strSMSComin) - 80), HeadTag, Chr(13) & Chr(10))
            MidTag = Left(PartContPdu, 8)
            PartContPdu = Right(PartContPdu, Len(PartContPdu) - 8)
            SumTag = Right(Left(MidTag, 6), 1)
            TurnTag = Right(MidTag, 1)
              
            Select Case TurnTag
            Case "1"
               Call WriteFirst(strHandNum, PartContPdu)
            Case "2"
               Call WriteSecond(strHandNum, PartContPdu)
            Case "3"
               Call WriteThird(strHandNum, PartContPdu)
            Case "4"
               Call WriteFourth(strHandNum, PartContPdu)
            End Select
            
            Select Case SumTag
            Case "2"
               longRlt1 = SearchFirst(strHandNum)
               longRlt2 = SearchSecond(strHandNum)
               If longRlt1 >= 0 And longRlt2 >= 0 Then
                  strPDUContent = FirstList(longRlt1).strCon + SecondList(longRlt2).strCon
                  FirstList(longRlt1).strPhone = ""
                  FirstList(longRlt1).strCon = ""
                  SecondList(longRlt2).strPhone = ""
                  SecondList(longRlt2).strCon = ""
                  longCodeLenth = Len(strPDUContent) / 2
               Else
                  Call DelSMS(Index, PortNo)
                  GoTo Escape
               End If
            Case "3"
               longRlt1 = SearchFirst(strHandNum)
               longRlt2 = SearchSecond(strHandNum)
               longRlt3 = SearchThird(strHandNum)
               If longRlt1 >= 0 And longRlt2 >= 0 And longRlt3 >= 0 Then
                  strPDUContent = FirstList(longRlt1).strCon + SecondList(longRlt2).strCon + ThirdList(longRlt3).strCon
                  FirstList(longRlt1).strPhone = ""
                  FirstList(longRlt1).strCon = ""
                  SecondList(longRlt2).strPhone = ""
                  SecondList(longRlt2).strCon = ""
                  ThirdList(longRlt3).strPhone = ""
                  ThirdList(longRlt3).strCon = ""
                  longCodeLenth = Len(strPDUContent) / 2
               Else
                  Call DelSMS(Index, PortNo)
                  GoTo Escape
               End If
            Case "4"
               longRlt1 = SearchFirst(strHandNum)
               longRlt2 = SearchSecond(strHandNum)
               longRlt3 = SearchThird(strHandNum)
               longRlt4 = SearchFourth(strHandNum)
               If longRlt1 >= 0 And longRlt2 >= 0 And longRlt3 >= 0 And longRlt4 >= 0 Then
                  strPDUContent = FirstList(longRlt1).strCon + SecondList(longRlt2).strCon + ThirdList(longRlt3).strCon + FourthList(longRlt4).strCon
                  FirstList(longRlt1).strPhone = ""
                  FirstList(longRlt1).strCon = ""
                  SecondList(longRlt2).strPhone = ""
                  SecondList(longRlt2).strCon = ""
                  ThirdList(longRlt3).strPhone = ""
                  ThirdList(longRlt3).strCon = ""
                  FourthList(longRlt4).strPhone = ""
                  FourthList(longRlt4).strCon = ""
                  longCodeLenth = Len(strPDUContent) / 2
               Else
                  Call DelSMS(Index, PortNo)
                  GoTo Escape
               End If
            End Select
         Else
            longCodeLenth = Chex(Left(strLenthCode, 1)) * 16 + Chex(Right(strLenthCode, 1))
            strPDUContent = Right(Left(strRemainPart, 20 + 2 * longCodeLenth), 2 * longCodeLenth)
         End If
         
      ElseIf strSMSType = "小灵通" Then
       
         strLenthCode = Right(Left(strSMSComin, longLOCATION + 23 + NumLen), 2)
         longCodeLenth = Chex(Left(strLenthCode, 1)) * 16 + Chex(Right(strLenthCode, 1))
         strPDUContent = Right(Left(strSMSComin, longLOCATION + 23 + NumLen + 2 * longCodeLenth), 2 * longCodeLenth)
         
      End If
       
      strContent = ""
       
      For I = 1 To longCodeLenth / 2 '转化UNICODE码为汉字
          strUnicode = Left(strPDUContent, 4)
          longCodeNum = Chex(Left(strUnicode, 1)) * 16 * 16 * 16 + Chex(Right(Left(strUnicode, 2), 1)) * 16 * 16 + Chex(Right(Left(strUnicode, 3), 1)) * 16 + Chex(Right(strUnicode, 1))
          strContent = strContent + ChrW(longCodeNum)
          strPDUContent = Right(strPDUContent, Len(strPDUContent) - 4)
      Next I
   Else
      Call DelSMS(Index, PortNo)
      GoTo Escape
   End If
   
   If Trim(strContent) = "" Then '如果文字内容为空，删除短信
      Call DelSMS(Index, PortNo)
      GoTo Escape
   End If
   
   MList = MList + strHandNum + ","
   CList = CList + strContent + "$$"
   Call DelSMS(Index, PortNo)
Escape:
  
Loop Until InSMSList = "" Or CountMe >= 50 Or Timer > BaseTime + 60

ReadSMS = "OK/" & CountMe & "%%" & MList & "%%" & CList

frmMain.MSComm(PortNo).PortOpen = False

Exit Function

ErrorDeal:

strSMSComin = ""
ReadSMS = "ERROR/" + Err.Description
frmMain.MSComm(PortNo).PortOpen = False
 
End Function

Private Function Chex(ByVal vhex As String) As Long '16-10部分转换函数

On Error GoTo ErrorDeal

If vhex = "A" Then
   Chex = 10
ElseIf vhex = "B" Then
   Chex = 11
ElseIf vhex = "C" Then
   Chex = 12
ElseIf vhex = "D" Then
   Chex = 13
ElseIf vhex = "E" Then
   Chex = 14
ElseIf vhex = "F" Then
   Chex = 15
Else
   Chex = vhex
End If

Exit Function

ErrorDeal:

Chex = 0

End Function

Private Sub DelSMS(I As Long, PortNo As Long) '删除短信

strSMSComin = ""
frmMain.MSComm(PortNo).Output = "AT+CMGD=" & I & Chr(13)
Call WaitA(PortNo)
strSMSComin = ""
  
End Sub

Private Sub ChangeMode(I As Long, PortNo As Long)
Dim strINT As String

blnExceed = False
strSMSComin = ""

frmMain.MSComm(PortNo).Output = "AT+CMGF=1" & Chr(13) '更改进入文本模式
Call WaitA(PortNo)
If blnExceed = True Or InStr(strSMSComin, "ERROR") > 0 Then
   Exit Sub
End If

strSMSComin = ""
frmMain.MSComm(PortNo).Output = "AT+CMGR=" & I & Chr(13) '读取文本
Call WaitA(PortNo)
If blnExceed = True Or InStr(strSMSComin, "ERROR") > 0 Then
   Exit Sub
End If

strINT = Right(strSMSComin, Len(strSMSComin) - InStr(strSMSComin, Chr(34) & Chr(13)) - 2)
strContent = Left(strINT, Len(strINT) - 8)
strSMSComin = ""
frmMain.MSComm(PortNo).Output = "AT+CMGF=0" & Chr(13) '返回PDU模式
Call WaitA(PortNo)
strSMSComin = ""

End Sub

Public Function SendSMS(PhoneNum As String, SendInfo As String, PortNo As Long) As String '发送信息函数
On Error GoTo ErrorDeal

If frmMain.MSComm(PortNo).PortOpen = False Then
   frmMain.MSComm(PortNo).PortOpen = True
End If

blnExceed = False
strSMSComin = ""

Call SmsDeal(PhoneNum, SendInfo)  '将内容编为PDU码
frmMain.MSComm(PortNo).Output = "AT+CMGS=" + strSMSLen & Chr(13) '输入字节数
sglBasetime = Timer
Do                                             '等待
  DoEvents
  strSMSComin = frmMain.MSComm(PortNo).Input
Loop Until InStr(strSMSComin, ">") > 0 Or InStr(strSMSComin, "ERROR") > 0 Or Timer > sglBasetime + 2

If InStr(strSMSComin, "ERROR") > 0 Then
   strSMSComin = ""
   SendSMS = "ERROR/发送失败"
   Exit Function
ElseIf Timer > sglBasetime + 2 Then  '如果错误,退出
   strSMSComin = ""
   SendSMS = "ERROR/发送操作超时"
   Exit Function
Else  '如果正确，进入发送
   strSMSComin = ""
   Call Pause(0.1)
   frmMain.MSComm(PortNo).Output = strSMSCode & Chr(26) '发送短信
   Call WaitA(PortNo)
   If InStr(strSMSComin, "ERROR") > 0 Then '如果发送错误，退出
      SendSMS = "ERROR/发送错误"
   ElseIf blnExceed = True Then
      SendSMS = "ERROR/发送操作超时"
   Else
      Call Pause(0.2)
      SendSMS = "OK/发送成功"
   End If
End If
strSMSComin = ""
frmMain.MSComm(PortNo).PortOpen = False

Exit Function

ErrorDeal:
  
SendSMS = "ERROR/发送错误"
frmMain.MSComm(PortNo).PortOpen = False

End Function

Public Function InitialCard(PortNo As Long) As String  '检测并启动sim卡
Dim sglBasetime As Single
Dim RateList As String

If frmMain.MSComm(PortNo).PortOpen = False Then
   frmMain.MSComm(PortNo).PortOpen = True
End If

RateList = "115200,1200,2400,4800,9600,19200,38400,57600,"

Do While InStr(RateList, ",") > 0
DoEvents
   strSMSComin = ""
   frmMain.MSComm(PortNo).Settings = GetLeftPart(RateList, ",") + ",N,8,1"
   frmMain.MSComm(PortNo).Output = "AT" & Chr(13)
   
   sglBasetime = Timer
   Do
   DoEvents
      strSMSComin = strSMSComin & frmMain.MSComm(PortNo).Input
   Loop Until Timer > sglBasetime + 0.5 Or InStr(strSMSComin, "OK") > 0
   
   If InStr(strSMSComin, "OK") > 0 Then
      frmMain.MSComm(PortNo).Output = "AT+IPR=115200" & Chr(13)
      Call Pause(0.2)
      frmMain.MSComm(PortNo).Settings = "115200,N,8,1"
      Exit Do
   End If
   RateList = GetRightPart(RateList, ",")
Loop

If RateList = "" Then
   InitialCard = "ERROR/设置速率失败"
   Exit Function
End If

strSMSComin = ""

frmMain.MSComm(PortNo).Output = "AT+CPIN?" & Chr(13) '进入读卡流程
Call WaitB(PortNo)
If InStr(strSMSComin, "ERROR") > 0 Or blnExceed = True Then
   strSMSComin = ""
   InitialCard = "ERROR/读卡失败"
   Exit Function
End If

strSMSComin = ""
frmMain.MSComm(PortNo).Output = "AT+CMGF=0" & Chr(13) '进入设置PDU模式流程
Call WaitB(PortNo)
If InStr(strSMSComin, "ERROR") > 0 Or blnExceed = True Then
   strSMSComin = ""
   InitialCard = "ERROR/无法进入PDU模式"
   Exit Function
End If

strSMSComin = ""
frmMain.MSComm(PortNo).Output = "AT+CNMI=0,0,0,0,1" & Chr(13) '进入设置通信读取模式流程
Call WaitB(PortNo)
If InStr(strSMSComin, "ERROR") > 0 Or blnExceed = True Then
   InitialCard = "ERROR/无法进入正确读写模式"
Else
   InitialCard = "OK/SIM卡检测启动成功"
End If
strSMSComin = ""
frmMain.MSComm(PortNo).PortOpen = False
 
End Function

Public Function SetCenter(CenterNum As String, PortNo As Long) As String '设置服务中心

blnExceed = False
strSMSComin = ""

frmMain.MSComm(PortNo).Output = "AT+CSCA=" + Chr(34) + CenterNum + Chr(34) & Chr(13)
Call WaitA(PortNo)
If blnExceed = True Then
   SetCenter = "ERROR/设置操作超时"
   Exit Function
End If
   
If InStr(strSMSComin, "OK") > 0 Then
   SetCenter = "OK/中心号码设置成功"
Else
   SetCenter = "ERROR/中心号码设置失败"
End If
strSMSComin = ""

End Function

Public Function EraseAll(PortNo As Long) As String  '删除全部短信
On Error GoTo ErrorDeal

blnExceed = False
strSMSComin = ""
InSMSList = ""

frmMain.MSComm(PortNo).Output = "AT+CMGL=4" & Chr(13)
Call WaitA(PortNo)
EraseAll = "ERROR/删除操作延时错误"

If InStr(strSMSComin, "CMGL:") = 0 Then
   EraseAll = "OK/没有储存的短信"
   Exit Function
Else
   Do
   DoEvents
      DealString = GetBetweenPart(strSMSComin, "+", ",,")
      InSMSList = InSMSList + GetBetweenPart(DealString, "CMGL: ", ",") + ","
      strSMSComin = GetRightPart(strSMSComin, ",,")
   Loop Until InStr(strSMSComin, "CMGL") = 0
   strSMSComin = ""
End If

Do While InStr(InSMSList, ",") > 0
DoEvents
    frmMain.MSComm(PortNo).Output = "AT+CMGD=" + GetLeftPart(InSMSList, ",") & Chr(13) '删除短信
    InSMSList = GetRightPart(InSMSList, ",")
    Call WaitA(PortNo)
    If blnExceed = True Then '短信清单出错处理
       EraseAll = "ERROR/操作延时错误"
       strSMSComin = ""
       Exit Function
    End If
    strSMSComin = ""
Loop
EraseAll = "OK/成功删除全部短信"

Exit Function

ErrorDeal: