functions.bas

短信群发标准版

Attribute VB_Name = "functions"
Option Explicit
Public SendMsg1 As String
Public Sendlnth As String
Public Function Sendsms(SMSC, Phno, SMS)
    Dim lnth, msg, LS, sms1 As String
    Dim i As Integer
    
    SMSC = revnum(SMSC)
    Phno = revnum(Phno)
    
    LS = hex2(Len(SMS) * 2)
    lnth = Trim(str(Len(SMS) * 2 + 15))
    For i = 1 To 3 - Len(lnth)
        lnth = "0" & lnth
    Next i
    sms1 = ""
    sms1 = ConvToHex(SMS)
        
    msg = "0011000D9168" & Phno & "0008A7" & LS & sms1
    
    Call SendMsg(lnth, msg)
End Function
Public Function SendMsg(lnth, msg)
    Dim start As Long
    
    Form1.MSComm1.Output = "AT+CMGS=" & lnth & vbCr
    start = Timer
    Do While Timer < start + 0.5
        DoEvents
    Loop
    Form1.MSComm1.Output = msg & Chr$(26)
    start = Timer
    Do While Timer < start + 3
        DoEvents
    Loop
End Function
'将电话话码或短信中心号码进行编码
Public Function revnum(numb)
    Dim s As Integer
    Dim ma, ta, A, B As String
    
    s = 1
    ma = ""
    While (s <= Len(numb))
      ta = Mid(numb, s, 2)
      A = Mid(ta, 1, 1)
      B = Mid(ta, 2, 1)
      If B = "" Then B = "F"
      ma = ma & B & A
      s = s + 2
    Wend
    revnum = ma
End Function
'将十进制转换成2位16进制
Public Function hex2(he) As String
    Dim y As String
    
    y = Hex(he)
    If Len(y) = 1 Then
       y = "0" & y
    End If
    hex2 = y
End Function
'将中文转换成Unicode码
Public Function ConvToHex(Text) As String
    Dim temp As Long
    Dim i As Integer
    Dim str As String
    
    ConvToHex = ""
    For i = 1 To Len(Text)
        temp = AscW(Mid(Text, i, 1))
        str = Hex(temp)
        If Len(str) < 4 Then
            str = "00" & str
        ElseIf Len(str) > 4 Then
            str = Right(str, 4)
        End If
        ConvToHex = ConvToHex & str
    Next i
End Function
Public Function GetSMS(Index As Integer) As String
    Dim InString As String
    Dim pos As Integer
    Dim start As Single
    
    Form1.MSComm1.Output = "AT+CMGR=" & str(Index) + vbCr
    start = Timer
    Do While Timer < start + 0.5
        DoEvents
    Loop
    If Form1.MSComm1.InBufferCount Then
       InString = Form1.MSComm1.Input
    End If
    
    pos = CStr(InStr(InString, "0891"))
    If pos > 0 Then
        InString = Mid(InString, pos)
        If Mid(InString, 19, 2) = "11" Then
            InString = ""
        End If
    Else
        InString = ""
    End If

    GetSMS = InString
End Function
Public Function GetPhone(InString As String) As String
    Dim i As Integer
    Dim Phone As String
    
    Phone = ""
    For i = 1 To 6
        Phone = Phone + Mid(InString, i * 2 + 24, 1)
        Phone = Phone + Mid(InString, i * 2 + 23, 1)
    Next i
    Phone = Left(Phone, 11)
    GetPhone = Phone
End Function
'***********************************************
'获取短信内容
'***********************************************
Public Function GetMessage(InString As String) As String
    Dim msglen As Integer
    Dim msg As String
    Dim i As Integer
    Dim Code As Long
    
    msg = ""
    If Mid(InString, 39, 2) = "08" Then
        msglen = ConverDec(Mid(InString, 55, 2))
        msglen = msglen / 2
        For i = 1 To msglen
            Code = ConverDec(Mid(InString, i * 4 + 53, 4))
            msg = msg + ChrW(Code)
        Next i
    ElseIf Mid(InString, 39, 2) = "00" Then
        msglen = ConverDec(Mid(InString, 55, 2))
        msglen = msglen - (Int(msglen / 8))
        msg = ConvToStr(Mid(InString, 57, msglen * 2))
    End If
    GetMessage = msg
End Function
'***********************************************
'将十六进制数转换为十进制数
'***********************************************
Public Function ConverDec(temp As String) As Long
    Dim length As Integer
    Dim i As Integer
    Dim number As Integer
    Dim c As String
    
    length = Len(temp)
    ConverDec = 0
    For i = 1 To length
        c = Mid(temp, i, 1)
        If c = "0" Then
            number = 0
        ElseIf c = "1" Then
            number = 1
        ElseIf c = "2" Then
            number = 2
        ElseIf c = "3" Then
            number = 3
        ElseIf c = "4" Then
            number = 4
        ElseIf c = "5" Then
            number = 5
        ElseIf c = "6" Then
            number = 6
        ElseIf c = "7" Then
            number = 7
        ElseIf c = "8" Then
            number = 8
        ElseIf c = "9" Then
            number = 9
        ElseIf c = "A" Then
            number = 10
        ElseIf c = "B" Then
            number = 11
        ElseIf c = "C" Then
            number = 12
        ElseIf c = "D" Then
            number = 13
        ElseIf c = "E" Then
            number = 14
        ElseIf c = "F" Then
            number = 15
        End If
        ConverDec = ConverDec + number * (16 ^ (length - i))
    Next i
End Function
Public Function DelMessage(Index As Integer)
    Dim start As Single
    
    Form1.MSComm1.Output = "AT" + vbCr
    start = Timer
    Do While Timer < start + 0.5
        DoEvents
    Loop
    
    Form1.MSComm1.Output = "AT+CMGD=" & str(Index) + vbCr
    start = Timer
    Do While Timer < start + 0.5
        DoEvents
    Loop
End Function
Public Function ConvToStr(msg As String) As String
    Dim msglen As Integer
    Dim result As Integer
    Dim i, x, y, z As Integer
    Dim temp As Long
    
    ConvToStr = ""
    x = 0
    msglen = Len(msg) / 2
    For i = 0 To msglen - 1
        y = i Mod 7
        temp = ConverDec(Mid(msg, i * 2 + 1, 2))
        result = temp Mod 2 ^ (7 - y)
        result = result * 2 ^ (y) + x
        x = Int(temp / (2 ^ (7 - y)))
        ConvToStr = ConvToStr & Chr(result)
        If y = 6 Then
            ConvToStr = ConvToStr & Chr(x)
            x = 0
        End If
    Next i
End Function