Option Explicit
Private Const TimeDelay = 2000 '命令延时
Private Const TimeInc = 50
Private Const str_GetSCA = "AT+CSCA?" + vbCr
Dim bportopen As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '


 
Private Sub Command1_Click()
'MSComm1.PortOpen = True
    Command1.Caption = "串口已打开"
    Form1.Caption = "短信猫串口已打开"
    If bportopen = 0 Then
        MSComm1.PortOpen = True
        bportopen = 1
    Else
        MsgBox "串口已打开"
    End If
    MSComm1.InputLen = 0 '读入整个缓冲区
                                                        
End Sub

Private Sub Command2_Click()
Dim neirong As String
Dim i As Integer
Dim str As String
Dim pdustr As String
Dim sms_center As String
Dim sms_mobile As String
Dim success As String
Dim a As String
Dim info As String
    Command2.Caption = " 发送短信"
    sms_center = "8613800290500"
    neirong = Text1.Text
    sms_center = telc(sms_center)
    sms_mobile = telc(Text2.Text)
    pdustr = "0891"
    pdustr = pdustr + sms_center + "11000D91" + sms_mobile + "000800" + chg(neirong)  '下次开的时候 把+改成&试试
    MSComm1.Output = "AT+CMGF=0" & vbCr
    Sleep (100)
   'pdustr = "0891683108200905F011000D91685128392972F10008000A5DE54F5C61095FEBFF01"                                                                       'str = MSComm1.Input
    MSComm1.Output = " AT+CMGS=" & CStr(Len(pdustr) / 2 - 9) & vbCr
    Sleep (1000)                                                                  'str = MSComm1.Input
        MSComm1.Output = pdustr & Chr(26)                                                                        'Text3.Text = CStr(Now) + "发送给" + sms_mobile
    Sleep (2000)
     'Exit Sub
        info = CStr(Now) + "发送给" + Text1.Text
'Sleep (2000)
        Text3.Text = info
Open "e:/1.txt" For Append As #1
Print #1, Text3.Text
Close #1

End Sub

Private Sub Command3_Click()
    Command1.Caption = "关闭"
    MSComm1.PortOpen = False
    Unload Form1

End Sub

Private Sub Command4_Click()
    If bportopen = 1 Then
       Call SendSMS(Text2.Text, Text1.Text)
    Else
        MsgBox "串口未打开！", vbCritical + vbOKOnly, "打开串口"
    End If
End Sub

Private Sub Form_Load()
MSComm1.CommPort = 5
MSComm1.Settings = "9600,n,8,1"
'MSComm1.SThreshold = 1
End Sub


 Public Function telc(num As String) As String
  Dim tl As Integer
  Dim ltem, rtem, ttem As String
  Dim ti As Integer
  ttem = ""
  tl = Len(num)
  If tl <> 11 And tl <> 13 Then
    MsgBox "wrong number." & tl
    Exit Function
  End If
  If tl = 11 Then
    tl = tl + 2
    num = "86" & num
  End If
  For ti = 1 To tl Step 2
    ltem = Mid(num, ti, 1)
    rtem = Mid(num, ti + 1, 1)
    If ti = tl Then rtem = "F"
    ttem = ttem & rtem & ltem
  Next ti
  telc = ttem
 End Function

 
 
Public Function chg(rmsg As String) As String    'ChrW（）将中文转换为Unicode码
                                              
    Dim tep As String
    Dim temp As String
    Dim i As Integer
    Dim b As Integer
    tep = rmsg
    i = Len(tep)
    b = i / 4
    If i = b * 4 Then
        b = b - 1
        tep = Left(tep, b * 4)
    Else
        tep = Left(tep, b * 4)
    End If
    chg = ""
    For i = 1 To b
        temp = "&H" & Mid(tep, (i - 1) * 4 + 1, 4)
        chg = chg & ChrW(CInt(Val(temp)))
    Next i
End Function

Private Function GetSCANumber() As String
'读取SIM卡中的短信中心号码
Dim CurrentTime As Long
Dim bool_SMS As Boolean
Dim tempsms As String
    MSComm1.InBufferCount = 0
    MSComm1.OutBufferCount = 0
    MSComm1.Output = str_GetSCA
    Do While CurrentTime < TimeDelay
        tempsms = tempsms & MSComm1.Input
        If InStr(tempsms, "OK") > 0 Then
            bool_SMS = True
            Exit Do
        End If
        Sleep (TimeInc)
        CurrentTime = CurrentTime + TimeInc
    Loop
    If bool_SMS = True Then
        GetSCANumber = GetSCA(tempsms)
    Else
        GetSCANumber = ""
    End If
End Function
'获取短信中心号码
Private Function GetSCA(SCAStr As String)
Dim i As Integer
Dim iLen As Integer
Dim tempstr As String
Dim ipos As Integer
    ipos = InStr(SCAStr, "+CSCA:")
    tempstr = Mid(SCAStr, ipos + 7, Len(SCAStr) - ipos)
    ipos = InStr(tempstr, ",")
    If ipos <= 0 Then
        tempstr = ""
        Exit Function
    End If
    tempstr = Mid(tempstr, 2, ipos - 3)
    If Left(tempstr, 3) = "+86" Then
        GetSCA = Right(tempstr, Len(tempstr) - 3)
    Else
        GetSCA = tempstr
    End If

End Function
'将短信内容转化为PDU码
'参数说明：msgStr：待转化的短信内容;PDUStr:转化后的字符串
'返回：数据长度
Private Function MsgToPDU(MsgStr As String) As String
Dim HexStr As String
Dim strChar As Integer
Dim resultStr As String
Dim i As Long
Dim iLen As Long
iLen = Len(MsgStr)
For i = 1 To iLen
    strChar = AscW(Mid(MsgStr, i, 1))
    HexStr = Hex(strChar)
    resultStr = resultStr & FormatStr(HexStr, "0000")
Next i
MsgToPDU = resultStr
End Function
'自定义format函数
Private Function FormatStr(SourceStr As String, FormatString As String) As String
Dim i As Long
Dim tempstr As String
Dim iLen As Long
Dim FormatLen As Long
Dim DecLen As Long
    FormatLen = Len(FormatString)
    iLen = Len(SourceStr)
    If FormatLen >= iLen Then
        DecLen = FormatLen - iLen
        tempstr = Left(FormatString, DecLen) & SourceStr
    Else
        tempstr = Left(SourceStr, FormatLen)
    End If
    FormatStr = tempstr
End Function

Private Sub SendSMS(SMSNumber As String, SMSContent As String)
Dim SCANumber As String
Dim SendNumber As String
Dim PDUContent As String
Dim SendPDU As String
Dim SMSLen As String
Dim SMSHeader As String
Dim SMSFlag As String
Dim tempPDU As String
Dim SendLen As String
Dim CurrentTime As Integer
Dim tempRecv As String
Dim bool_SMS As Boolean
    CurrentTime = 0
    SCANumber = GetSCANumber()
    If GetSCANumber <> "" Then
       SendNumber = telc(SMSNumber)
       SCANumber = telc(SCANumber)
       PDUContent = MsgToPDU(SMSContent)
       SMSHeader = "11000D91"
       SMSFlag = "000800"
       SendPDU = "0891"
       SMSLen = FormatStr(Hex(Len(PDUContent) / 2), "00")
       tempPDU = SMSHeader & SendNumber & SMSFlag & SMSLen & PDUContent
       SendLen = CStr(Len(tempPDU) / 2)
       SendPDU = SendPDU + SCANumber + SMSHeader + SendNumber + SMSFlag + SMSLen + PDUContent '下次开的时候 把+改成&试试
       MSComm1.OutBufferCount = 0
       MSComm1.InBufferCount = 0
        '发送长度
       MSComm1.Output = "AT+CMGF=0" + vbCrLf
       tempRecv = ""
       bool_SMS = False
       Do While CurrentTime < TimeDelay  '发送时间稍长，加长延时
            tempRecv = tempRecv & MSComm1.Input
                If InStr(tempRecv, vbCrLf & "OK") > 0 Then
                bool_SMS = True
                Exit Do
                End If
            Sleep (TimeInc)
            CurrentTime = CurrentTime + TimeInc '继续延时
        Loop
        If bool_SMS = True Then
            bool_SMS = False
            '发送短信长度、
            MSComm1.OutBufferCount = 0
            MSComm1.InBufferCount = 0
            MSComm1.Output = "AT+CMGS=" & SendLen & vbCrLf
            '等返回
            tempRecv = ""
            CurrentTime = 0
            bool_SMS = False
            Do While CurrentTime < TimeDelay  '发送时间稍长，加长延时
            tempRecv = tempRecv & MSComm1.Input
                If InStr(tempRecv, vbCrLf & ">") > 0 Then
                bool_SMS = True
                Exit Do
                End If
            Sleep (TimeInc)
            CurrentTime = CurrentTime + TimeInc '继续延时
            Loop
            If bool_SMS = True Then
                '发送短信内容
                bool_SMS = False
                MSComm1.OutBufferCount = 0
                MSComm1.InBufferCount = 0
                MSComm1.Output = SendPDU & Chr(&H1A)
                CurrentTime = 0
                tempRecv = ""
             '延时函数
                Do While CurrentTime < TimeDelay * 5 '发送时间稍长，加长延时
                    tempRecv = tempRecv & MSComm1.Input
                    If InStr(tempRecv, vbCrLf & "+CMGS") > 0 Then
                        bool_SMS = True
                        Exit Do
                    End If
                    If InStr(tempRecv, vbCrLf & "ERROR") > 0 Then
                        bool_SMS = False
                        Exit Do
                    End If
                    Sleep (TimeInc)
                    CurrentTime = CurrentTime + TimeInc '继续延时
                Loop
                If bool_SMS = True Then
                    MsgBox "短信发送成功！", vbInformation + vbOKOnly, "发送短信"
                Else
                    MsgBox "短信发送失败！", vbCritical + vbOKOnly, "发送短信"
                End If
            Else
                MsgBox "短信长度发送失败！", vbCritical + vbOKOnly, "发送短信"
            End If
        Else
            MsgBox "设置PDU短信编码方式失败！", vbCritical + vbOKOnly, "发送短信"
        End If
       
       
    Else
        MsgBox "获取短信中心号码失败！", vbCritical + vbOKOnly, "发送短信"
    End If

End Sub

Private Sub MSComm1_OnComm()

End Sub