module1.bas

通过串口与手机模块收发短信。已经用sim100测试过

   Dim mointerh As Integer
   Dim mointerl As Integer
   Dim conclusion As String
   
   
   mointer = asccode
   
  
   
   mointerh = mointer \ 16
   
   If mointerh < 10 Then
   
   mointerh = mointerh + 48
   
   Else

   mointerh = mointerh + 55
   
End If



mointerl = mointer Mod 16

If mointerl < 10 Then

mointerl = mointerl + 48

 Else

mointerl = mointerl + 55

End If

 AscToHex = Chr(mointerh) & Chr(mointerl)
 
 
End Function
Function HStrJudge(HexStr As String) As String
  Dim TempStr As String
  Dim StrCount As Integer
  Dim StrRecount As Integer
  Dim ArrCount As Integer

  HexStr = Delspace(HexStr)
  
  StrRecount = 1
  
  '输入数据错误处理，违法数据舍弃，不足偶数补“F”
  
  For StrCount = 1 To Len(HexStr)
    TempStr = Mid(HexStr, StrRecount, 1)
    If Not ((Asc(TempStr) <= Asc("F") And Asc(TempStr) >= Asc("A")) _
         Or (Asc(TempStr) <= Asc("f") And Asc(TempStr) >= Asc("a")) _
         Or (Asc(TempStr) <= Asc("9") And Asc(TempStr) >= Asc("0"))) Then
    HexStr = Mid(HexStr, 1, StrRecount - 1) & Mid(HexStr, StrRecount + 1)
    StrRecount = StrRecount - 1
    End If
    StrRecount = StrRecount + 1
  Next StrCount
  
  If Len(HexStr) Mod 2 <> 0 Then
      HexStr = HexStr & "F"
  End If
   HStrJudge = HexStr
 '输入数据错误处理，违法数据舍弃，不足偶数补“F”
   
    
End Function
Function HStrToAAray(HexStr As String) As Variant
If HexStr = "" Then
 Exit Function
End If
  Dim TempStr As String
  Dim StrCount As Integer
  Dim StrRecount As Integer
  Dim ArrCount As Integer
  Dim ByteArray() As Byte
  HexStr = Delspace(HexStr)
  HStrToAAray = ""
  StrRecount = 1
  
  '输入数据错误处理，违法数据舍弃，不足偶数补“F”
  
  For StrCount = 1 To Len(HexStr)
    TempStr = Mid(HexStr, StrRecount, 1)
    If Not ((Asc(TempStr) <= Asc("F") And Asc(TempStr) >= Asc("A")) _
         Or (Asc(TempStr) <= Asc("f") And Asc(TempStr) >= Asc("a")) _
         Or (Asc(TempStr) <= Asc("9") And Asc(TempStr) >= Asc("0"))) Then
    HexStr = Mid(HexStr, 1, StrRecount - 1) & Mid(HexStr, StrRecount + 1)
    StrRecount = StrRecount - 1
    End If
    StrRecount = StrRecount + 1
  Next StrCount
  
  If Len(HexStr) Mod 2 <> 0 Then
      HexStr = HexStr & "F"
  End If

 '输入数据错误处理，违法数据舍弃，不足偶数补“F”
     ArrCount = 0
     ReDim ByteArray(Len(HexStr) / 2 - 1)
  For StrCount = 1 To Len(HexStr)
  
    TempStr = Mid(HexStr, StrCount, 2)
    ByteArray(ArrCount) = HexToAsc(TempStr)
    StrCount = StrCount + 1
    ArrCount = ArrCount + 1
  Next StrCount
  
    HStrToAAray = ByteArray()
End Function
Function HStrToAArayGsm(HexStr As String) As Variant

  Dim TempStr As String
  Dim StrCount As Integer
  Dim StrRecount As Integer
  Dim ArrCount As Integer
  Dim ByteArray() As Byte
  HexStr = Delspace(HexStr)
  HStrToAArayGsm = ""
  StrRecount = 1
  
  '输入数据错误处理，违法数据舍弃，不足偶数补“F”
  
  For StrCount = 1 To Len(HexStr)
    TempStr = Mid(HexStr, StrRecount, 1)
    If Not ((Asc(TempStr) <= Asc("F") And Asc(TempStr) >= Asc("A")) _
         Or (Asc(TempStr) <= Asc("f") And Asc(TempStr) >= Asc("a")) _
         Or (Asc(TempStr) <= Asc("9") And Asc(TempStr) >= Asc("0"))) Then
    HexStr = Mid(HexStr, 1, StrRecount - 1) & Mid(HexStr, StrRecount + 1)
    StrRecount = StrRecount - 1
    End If
    StrRecount = StrRecount + 1
  Next StrCount
  
  If Len(HexStr) Mod 2 <> 0 Then
      HexStr = HexStr & "F"
  End If

 '输入数据错误处理，违法数据舍弃，不足偶数补“F”
     ArrCount = 0
     ReDim ByteArray(Len(HexStr) / 2)
  For StrCount = 1 To Len(HexStr)
  
    TempStr = Mid(HexStr, StrCount, 2)
    ByteArray(ArrCount) = HexToAsc(TempStr)
    StrCount = StrCount + 1
    ArrCount = ArrCount + 1
  Next StrCount
  ByteArray(Len(HexStr) / 2) = 26
    HStrToAArayGsm = ByteArray()
End Function
Function HexToAsc(Hexcode As String) As Integer  '两位字符表示的hex转化为数字

   Dim Hexhibyte As String
   Dim Hexlowbyte As String
   Dim Hexhivalue As Integer
   Dim Hexlovalue As Integer
   
 If Hexcode = "" Then
  Exit Function
 End If
   Hexhibyte = Mid(Hexcode, 1, 1)
   Hexlowbyte = Mid(Hexcode, 2, 1)
   
 '未加错误处理，系统调用采用 HStrToAAray
   
   If Asc(Hexhibyte) < 65 Then
      
      Hexhivalue = Asc(Hexhibyte) - 48
      
      ElseIf Asc(Hexhibyte) >= 65 And Asc(Hexhibyte) < 97 Then
      
        Hexhivalue = Asc(Hexhibyte) - 55
        
      ElseIf Asc(Hexhibyte) >= 97 Then
      
        Hexhivalue = Asc(Hexhibyte) - 87
        
  End If
  
  If Asc(Hexlowbyte) < 65 Then
      
      Hexlovalue = Asc(Hexlowbyte) - 48
      
      ElseIf Asc(Hexlowbyte) >= 65 And Asc(Hexlowbyte) < 97 Then
      
        Hexlovalue = Asc(Hexlowbyte) - 55
        
      ElseIf Asc(Hexlowbyte) >= 97 Then
      
        Hexlovalue = Asc(Hexlowbyte) - 87
  End If
  
  HexToAsc = Hexhivalue * 16 + Hexlovalue
  
End Function
Function AByteToHStr(AByte As Variant) As String

    Dim AByteLen As Integer
    
    AByteToHStr = ""
    AByteLen = 0
    
    For AByteLen = 0 To UBound(AByte)
        AByteToHStr = AByteToHStr & AscToHex(Int(AByte(AByteLen))) & " "
    Next AByteLen
    
End Function

Function AStrToHByteGsm(AStr As String) As Variant


  Dim StrCount As Integer

  Dim ByteArray() As Byte
  
 
  ReDim ByteArray(Len(AStr))
  For StrCount = 0 To Len(AStr) - 1
  
    
    ByteArray(StrCount) = Asc(Mid(AStr, StrCount + 1, 1))
    
    
  Next StrCount
  ByteArray(Len(AStr)) = 26
    AStrToHByteGsm = ByteArray()
    
    
    
End Function
Function AStrToHByte(AStr As String) As Variant


  Dim StrCount As Integer

  Dim ByteArray() As Byte
  
 
  ReDim ByteArray(Len(AStr) - 1)
  For StrCount = 0 To Len(AStr) - 1
  
    
    ByteArray(StrCount) = Asc(Mid(AStr, StrCount + 1, 1))
    
    
  Next StrCount
  
    AStrToHByte = ByteArray()
    
    
    
End Function


Function ScaCode(ScaTxt As String) As String
Dim i1 As String
Dim i2 As Integer
   If Left(ScaTxt, 1) = "+" Then
       ScaTxt = Mid(ScaTxt, 2) & "F"
       ScaCode = ""
         
         For i2 = 1 To Len(ScaTxt)
          i1 = Mid(ScaTxt, i2 + 1, 1)
       ScaCode = ScaCode & i1
          i1 = Mid(ScaTxt, i2, 1)
       ScaCode = ScaCode & i1
         i2 = i2 + 1
        Next i2
    ScaCode = "0" & CStr(Len(ScaTxt) / 2 + 1) & "91" & ScaCode
    Else
       ScaTxt = ScaTxt & "F"
       ScaCode = ""
        
         For i2 = 1 To Len(ScaTxt)
          i1 = Mid(ScaTxt, i2 + 1, 1)
       ScaCode = ScaCode & i1
          i1 = Mid(ScaTxt, i2, 1)
       ScaCode = ScaCode & i1
         i2 = i2 + 1
        Next i2
    ScaCode = "0" & CStr(Len(ScaTxt) / 2 + 1) & "81" & ScaCode
   End If
End Function

Function ScaDeCode(ScaTxt As String) As String
Dim i1 As String
Dim i2 As Integer
   If Mid(ScaTxt, 1, 2) = "91" Then
       ScaDeCode = "+"
       ScaTxt = Mid(ScaTxt, 3)
       
         For i2 = 1 To Len(ScaTxt)
          i1 = Mid(ScaTxt, i2 + 1, 1)
       ScaDeCode = ScaDeCode & i1
          i1 = Mid(ScaTxt, i2, 1)
       ScaDeCode = ScaDeCode & i1
         i2 = i2 + 1
        Next i2
      ' ScaDeCode = Mid(ScaDeCode, 1, Len(ScaDeCode) - 1)
    Else 'If Mid(ScaTxt, 3, 2) = "A1" Then
       
       ScaDeCode = ""
       ScaTxt = Mid(ScaTxt, 5)
         For i2 = 1 To Len(ScaTxt)
          i1 = Mid(ScaTxt, i2 + 1, 1)
       ScaDeCode = ScaDeCode & i1
          i1 = Mid(ScaTxt, i2, 1)
       ScaDeCode = ScaDeCode & i1
         i2 = i2 + 1
        Next i2
    'ScaDeCode = Mid(ScaDeCode, 1, Len(ScaDeCode) - 1)
   End If
End Function

Function ComCode(ComTxt As String) As String
     
     Dim i1 As String
     Dim i2 As Integer
     ComCode = ""
    If Len(ComTxt) Mod 2 <> 0 Then
     ComTxt = ComTxt & "F"
    End If
     For i2 = 1 To Len(ComTxt)
          i1 = Mid(ComTxt, i2 + 1, 1)
       ComCode = ComCode & i1
          i1 = Mid(ComTxt, i2, 1)
       ComCode = ComCode & i1
         i2 = i2 + 1
        Next i2
      ComCode = AscToHex(Len(ComCode)) & "A1" & ComCode
End Function
Function ComDeCode(ComTxt As String) As String
   Dim TemComTxt As String
   TemComTxt = ComTxt
     If Mid(ComTxt, 3, 2) = "91" Then
       ComDeCode = "+"
       ComTxt = Mid(ComTxt, 5)
       
         For i2 = 1 To Len(ComTxt)
          i1 = Mid(ComTxt, i2 + 1, 1)
       ComDeCode = ComDeCode & i1
          i1 = Mid(ComTxt, i2, 1)
       ComDeCode = ComDeCode & i1
         i2 = i2 + 1
        Next i2
       ComDeCode = Mid(ComDeCode, 1, HexToAsc(Mid(TemComTxt, 1, 2)))
    Else   'If Mid(ComTxt, 3, 2) = "81" Then
       ComDeCode = ""
       ComTxt = Mid(ComTxt, 5)
       
         For i2 = 1 To Len(ComTxt)
          i1 = Mid(ComTxt, i2 + 1, 1)
       ComDeCode = ComDeCode & i1
          i1 = Mid(ComTxt, i2, 1)
       ComDeCode = ComDeCode & i1
         i2 = i2 + 1
        Next i2
       ComDeCode = Mid(ComDeCode, 1, HexToAsc(Mid(TemComTxt, 1, 2)))
    End If
End Function
Function TimeDeCode(ComTxt As String) As String

     Dim i1 As String
     Dim i2 As Integer
     TimeDeCode = ""
     
     For i2 = 1 To Len(ComTxt)
          i1 = Mid(ComTxt, i2 + 1, 1)
       TimeDeCode = TimeDeCode & i1
          i1 = Mid(ComTxt, i2, 1)
       TimeDeCode = TimeDeCode & i1
         i2 = i2 + 1
        Next i2
       TimeDeCode = Mid(TimeDeCode, 1, 2) & "-" & _