smsdeal.cls

通过西门子模块收发短信

EraseAll = "ERROR/删除短信错误"

End Function

Private Sub SmsDeal(hcode As String, Con As String) 'PDU编码例程

Dim Lenth As Long '内容长度
Dim hexstr(70) As String '长度为70的hex数组
Dim hexcon As String 'Unicode
Dim codepdu As String 'pdu码
Dim hexlen As String 'pdu码的hex长度

Lenth = Len(Con)

If Lenth > 70 Then
   Con = Left(Con, 70)
   Lenth = 70
End If

For I = 1 To Lenth

  hexstr(I) = Hex(AscW(Right(Left(Con, I), 1)))

  If Len(hexstr(I)) < 4 Then
  hexstr(I) = "00" + hexstr(I)
  End If

  hexcon = hexcon + hexstr(I)

Next I
 
codepdu = Right(Left(hcode, 2), 1) + Left(hcode, 1) + Right(Left(hcode, 4), 1) + Right(Left(hcode, 3), 1) + Right(Left(hcode, 6), 1) + Right(Left(hcode, 5), 1) + Right(Left(hcode, 8), 1) + Right(Left(hcode, 7), 1) + Right(Left(hcode, 10), 1) + Right(Left(hcode, 9), 1) + "f" + Right(hcode, 1)
hexlen = Hex(2 * Lenth)

If Len(hexlen) < 2 Then
   hexlen = "0" + hexlen
End If

strSMSCode = "0011000d9168" + codepdu + "0008ff" + hexlen + hexcon
strSMSLen = (Len(strSMSCode) - 2) / 2

End Sub

Private Sub Pause(st As Single) '延时等待函数

sglBasetime = Timer

Do
  DoEvents
Loop Until Timer > sglBasetime + st

End Sub

Private Sub WaitA(PortNo As Long)  '延时等待15秒，模块返回信息

sglBasetime = Timer

Do
  DoEvents
  strSMSComin = strSMSComin + frmMain.MSComm(PortNo).Input
Loop Until InStr(strSMSComin, "OK") > 0 Or InStr(strSMSComin, "ERROR") > 0 Or Timer > sglBasetime + 8

If Timer > sglBasetime + 10 Then
   blnExceed = True
   Exit Sub
End If

sglBasetime = Timer

Do
  DoEvents
  strSMSComin = strSMSComin + frmMain.MSComm(PortNo).Input
Loop Until Timer > sglBasetime + 0.1

End Sub

Private Sub WaitB(PortNo As Long)  '延时等待2秒，模块返回信息

sglBasetime = Timer

Do
  DoEvents
  strSMSComin = strSMSComin + frmMain.MSComm(PortNo).Input
Loop Until InStr(strSMSComin, "OK") > 0 Or InStr(strSMSComin, "ERROR") > 0 Or Timer > sglBasetime + 2

If Timer > sglBasetime + 2 Then
   blnExceed = True
   Exit Sub
End If

sglBasetime = Timer

Do
  DoEvents
  strSMSComin = strSMSComin + frmMain.MSComm(PortNo).Input
Loop Until Timer > sglBasetime + 0.1

End Sub

Public Function ComPortInit() As String '端口初始化
Dim I As Long
Dim TestList As String
Dim MaxPortNo As Long
Dim Turn As Long, Result As Long, Ret As Long

On Error GoTo ErrorDeal

Call TestPort(1, 16)

If PortList = "" Then
   ComPortInit = "ERROR/未检测到任何串口"
Else

   If PortSum >= 8 Then
      For I = 1 To 7
          Load frmMain.MSComm(I)
      Next I
      MaxPortNo = Left(Right(PortList, 3), 2)
      For I = 0 To 7
          frmMain.MSComm(I).CommPort = MaxPortNo + I - 7
      Next I
      UseComList = "0,1,2,3,4,5,6,7,"
   Else
      I = 0
      TestList = PortList
      Do
      DoEvents
         If I > 0 Then
            Load frmMain.MSComm(I)
         End If
         
         frmMain.MSComm(I).CommPort = GetLeftPart(TestList, ",")
         TestList = GetRightPart(TestList, ",")
         UseComList = UseComList & I & ","
         I = I + 1
      Loop Until TestList = ""
   End If
   ComPortInit = "OK/" + UseComList
End If

Exit Function

ErrorDeal:
ComPortInit = "ERROR/" + Err.Description

End Function

Private Function GetBetweenPart(Con As String, tag1 As String, tag2 As String)
On Error GoTo ErrorDeal '取标志中间字符串

GetBetweenPart = GetLeftPart(GetRightPart(Con, tag1), tag2)
Exit Function

ErrorDeal:
GetBetweenPart = ""

End Function

Private Function GetRightPart(Con As String, tag As String)
On Error GoTo ErrorDeal '取标志右边字符串

GetRightPart = Right(Con, Len(Con) - InStr(Con, tag) - Len(tag) + 1)
Exit Function

ErrorDeal:
GetRightPart = ""

End Function

Private Function GetLeftPart(Con As String, tag As String)
On Error GoTo ErrorDeal '取标志左边字符串

GetLeftPart = Left(Con, InStr(Con, tag) - 1)
Exit Function

ErrorDeal:
GetLeftPart = ""

End Function

Private Sub TestPort(IX As Long, IY As Long)
Dim I As Long

On Error GoTo ErrorDeal

For I = IX To IY

   frmMain.MSComm(0).CommPort = I
   If frmMain.MSComm(0).PortOpen = False Then
      frmMain.MSComm(0).PortOpen = True
      Call Pause(0.01)
      frmMain.MSComm(0).PortOpen = False
   Else
      frmMain.MSComm(0).PortOpen = False
   End If
   PortList = PortList & I & ","
   PortSum = PortSum + 1
   
Next I

Exit Sub

ErrorDeal:

  If I = IY Then
  Else
     I = I + 1
     Call TestPort(I, IY)
  End If
  
End Sub

Private Function CodeMe(nm As Long) As Long
Dim f1 As Long, f2 As Long

f1 = nm Mod 10
f2 = Int(nm / 10)

f1 = f1 + 1
f2 = f2 + 3
CodeMe = f1 * 10 + f2

End Function

Private Function DeCodeMe(nm As Long) As Long
Dim f1 As Long, f2 As Long

f1 = nm Mod 10
f2 = Int(nm / 10)

f1 = f1 - 3
f2 = f2 - 1
DeCodeMe = f1 * 10 + f2

End Function
Private Sub WriteFirst(Phn As String, Con As String)

For I = 0 To 100

   If FirstList(I).strCon = "" Then
      FirstList(I).strCon = Con
      FirstList(I).strPhone = Phn
      Exit For
   End If
   
Next I

End Sub

Private Sub WriteSecond(Phn As String, Con As String)

For I = 0 To 100

   If SecondList(I).strCon = "" Then
      SecondList(I).strCon = Con
      SecondList(I).strPhone = Phn
      Exit For
   End If
   
Next I

End Sub

Private Sub WriteThird(Phn As String, Con As String)

For I = 0 To 100

   If ThirdList(I).strCon = "" Then
      ThirdList(I).strCon = Con
      ThirdList(I).strPhone = Phn
      Exit For
   End If
   
Next I

End Sub

Private Sub WriteFourth(Phn As String, Con As String)

For I = 0 To 100

   If FourthList(I).strCon = "" Then
      FourthList(I).strCon = Con
      FourthList(I).strPhone = Phn
      Exit For
   End If
   
Next I

End Sub

Private Function SearchFirst(Phn As String) As Long

SearchFirst = -1

For I = 0 To 100

   If FirstList(I).strPhone = Phn Then
      SearchFirst = I
      Exit For
   End If
   
Next I

End Function

Private Function SearchSecond(Phn As String) As Long

SearchSecond = -1

For I = 0 To 100

   If SecondList(I).strPhone = Phn Then
      SearchSecond = I
      Exit For
   End If
   
Next I

End Function

Private Function SearchThird(Phn As String) As Long

SearchThird = -1

For I = 0 To 100

   If ThirdList(I).strPhone = Phn Then
      SearchThird = I
      Exit For
   End If
   
Next I

End Function

Private Function SearchFourth(Phn As String) As Long

SearchFourth = -1

For I = 0 To 100

   If FourthList(I).strPhone = Phn Then
      SearchFourth = I
      Exit For
   End If
   
Next I

End Function

Public Function ClearListBuffer()

For I = 0 To 100
   FirstList(I).strPhone = ""
   FirstList(I).strCon = ""
   SecondList(I).strPhone = ""
   SecondList(I).strCon = ""
   ThirdList(I).strPhone = ""
   ThirdList(I).strCon = ""
   FourthList(I).strPhone = ""
   FourthList(I).strCon = ""
Next I

End Function

Public Sub ClosePort()
Dim MidComList As String, ThisID As Long
MidComList = UseComList

Do While InStr(MidComList, ",") > 0
   ThisID = GetLeftPart(MidComList, ",")
   MidComList = GetRightPart(MidComList, ",")
   If frmMain.MSComm(ThisID).PortOpen = True Then
      frmMain.MSComm(ThisID).PortOpen = False
   End If
Loop

End Sub