form1.frm

一个MODEM的短信软件

 MSComm1.Output = "at" & vbCrLf
Dim attext
Sleep (800)
attext = MSComm1.Input
If InStr(attext, "OK") <> 0 Then
  Command2.Enabled = True
    Command7.Enabled = True
   Command6.Enabled = True
   Command4.Enabled = True
   Command1.Enabled = True
   Command9.Enabled = True
   Command10.Enabled = True
   Command11.Enabled = True
   Label5.Enabled = True
   Text4.SelText = "设备已经连接！" & vbCrLf
   
  Else
   Text4.SelText = "串口无反应，请检查！" & vbCrLf
  
 End If
End If
OpenOnComm
End Sub



Private Sub Command9_Click()
On Local Error Resume Next

CloseOnComm
Dim TxString As String
Dim i As Integer
If Check2.Value Then
 MSComm1.Output = "at+cmgf=1" & vbCrLf
   Sleep (600)
   MSComm1.Output = "at+cmgl= """ & "REC READ" & """" & vbCrLf
   Sleep (3000)
   TxString = MSComm1.Input
   Text4.SelText = TxString
Else
MSComm1.Output = "at+cmgf=0" & vbCrLf
Sleep (600)
MSComm1.Output = "at+cmgl=1" & Chr(13) & Chr(10)
Sleep (3600)
TxString = MSComm1.Input
Dim atext() As String
'Text8.SelText = TxString
atext = Split(TxString, Chr(13) & Chr(10))
'Text8.Text = atext(4)
If Len(atext(4)) < 15 Then
   Text4.SelText = "无已读信息，请检查！" & vbCrLf
Else
  For i = 2 To (UBound(atext) - 1) / 2 - 1
 Sleep (100)
  Text8.Text = atext(i * 2)
  
SuperSMS1.ConPDU Text8.Text, P, D, T, TXT, 1, E
'Text4.Text = smsalltext
'获得解析后的数据
Text4.SelText = "电话号码：" & P & vbCrLf _
& "日期：" & D & vbCrLf _
& "时间：" & T & vbCrLf _
& "内容：" & TXT & vbCrLf _
& "错误代码：" & E & vbCrLf
'Text4.SelText = TxString
Next i
End If
End If
OpenOnComm
End Sub

Private Sub Text10_Change()
 Timer1.Interval = Val(Text10.Text) * 1000
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
On Error Resume Next
MSComm1.Output = Chr(KeyAscii)
End Sub
Private Sub Form_Load()
On Local Error Resume Next
   MSComm1.PortOpen = False
    MSComm1.CommPort = 1
    MSComm1.InputMode = comInputModeText
     MSComm1.Settings = "57600,N,8,1"
     'MSComm1.InBufferCount = 1
     MSComm1.InBufferSize = 30240
    MSComm1.InputLen = 0    '设置每次从串口缓冲区取的字节为全部
    MSComm1.PortOpen = True '打开串口
    Command8.Caption = "关闭串口"
    'Command8.Value = 0
    Combo1.Text = "57600"
    'CloseOnComm
    Timer1.Enabled = False
    
    MSComm1.Output = "at" & Chr(13) & Chr(10)
    Sleep (800)
    'Text4.Text = StrConv (MSComm1.Input, vbUnicode)
    Dim aafirst As String
    aafirst = MSComm1.Input
    If InStr(aafirst, "OK") = 0 Then
    MsgBox ("AT不通，请检查mode是否连接成功！")
    'Command8.Caption = "打开串口"
    Command1.Enabled = 0
    Command4.Enabled = 0
    Command6.Enabled = 0
    Command7.Enabled = 0
    Command9.Enabled = 0
    Command10.Enabled = 0
     Command2.Enabled = 0
     Command11.Enabled = 0
     Label5.Enabled = 0
    Else
    aafirst = ""
    Text4.SelText = "设备已经连接成功，请测试！" & vbCrLf
    
   ' Command8.Caption = "关闭串口"
      Command1.Enabled = 1
    Command4.Enabled = 1
    Command6.Enabled = 1
    Command7.Enabled = 1
    Command2.Enabled = 1
    Command9.Enabled = 1
    Command10.Enabled = 1
    Command11.Enabled = 1
    Label5.Enabled = 1
    MSComm1.Output = "at+cnmi=1,1,0,0,1" & vbCrLf
    Sleep 300
    MSComm1.Output = "AT+CMGF=0" & vbCrLf
    End If
    Delay 1
    aafirst = MSComm1.Input
    'inData = ""
   OpenOnComm
Open "DataLink.txt" For Append As #1
  
Close #1
End Sub
Private Sub Command1_Click()
On Local Error Resume Next
Command1.Enabled = False
Command2.Enabled = False
Command7.Enabled = False
Command11.Enabled = False
Command4.Enabled = False
Command9.Enabled = False
Command6.Enabled = False
Command10.Enabled = False

 CloseOnComm
 Dim stt1 'As String
 
 Dim atext() As String
Dim i As Integer
atext = Split(Text2.Text, ",")
'For i = 0 To UBound(atext)

 If Text1.Text <> "" Then
    MSComm1.Output = "at+csca=""" & Text1.Text & """" & Chr(13)
    Delay 2
    stt1 = MSComm1.Input
    If InStr(stt1, "OK") = 0 Then
     
       MsgBox "短信中心号码设置不成功，请检查！", vbOKOnly, "发送结果"
       Exit Sub
    End If
 End If
 Delay 1
 MSComm1.Output = "at+cmgf=1" & Chr(13)
 Sleep (600)  'wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
 Dim att 'As String
    att = MSComm1.Input
   ' Text4.Text = StrConv(att, vbUnicode)
    If InStr(att, "OK") <> 0 Then
       For i = 0 To UBound(atext)
         MSComm1.Output = "at+cmgs=""" & atext(i) & """" & Chr(13)
         Delay 2
         MSComm1.Output = Text3.Text & Chr(26)
         Sleep (3200)
    
         Dim stt 'As String
         stt = MSComm1.Input
         If InStr(stt, "+CMGS") <> 0 Then
            Text4.SelText = "发送给" & atext(i) & "成功！" & vbCrLf
         Else
            Text4.SelText = "发送给" & atext(i) & "失败，请检查！" & vbCrLf
         End If
         Sleep (100)
        Next i
        Text4.SelText = "发送完毕！" & vbCrLf
    Else
        MsgBox "短信模式设置不成功，请检查！", vbOKOnly, "发送结果"
    End If
Command1.Enabled = True
Command2.Enabled = True
Command7.Enabled = True
Command11.Enabled = True
Command4.Enabled = True
Command9.Enabled = True
Command6.Enabled = True
Command10.Enabled = True

 OpenOnComm
End Sub
Public Sub CloseOnComm()
MSComm1.RThreshold = 0
MSComm1.InputMode = comInputModeText

End Sub
Public Sub OpenOnComm()
MSComm1.RThreshold = 1
MSComm1.InputMode = comInputModeBinary

End Sub
Public Sub Delay(HowLong As Date)   '延时
   Dim temptime As Date
   temptime = DateAdd("s", HowLong, Now)
    While temptime > Now
        DoEvents '让 windows 去处理其他事
    Wend
End Sub

Private Sub Text1_Change()
Conv
End Sub

Private Sub Text2_Change()

Conv
End Sub

Private Sub Text3_Change()
Conv
End Sub



Private Sub MSComm1_OnComm() '串口中断
On Local Error Resume Next
Static bFlag As Boolean
Static Xbyte As Long
'Dim TxString As String
Select Case MSComm1.CommEvent   '选择事件
Case comEvReceive '接收到字符
     
        Dim InByte() As Byte '定义一个二进制指针放接收到的数据
        InByte = MSComm1.Input '数据转移到指针
        Dim temp As Long
        Dim temp1 As Long
        Dim temp2 As Long
        Dim j As Long
        Dim counttrue As Integer
        counttrue = 1
       
        
         For j = 0 To UBound(InByte) '循环到指针上标
          ''  If ifhex = 1 Then '16进制显示处理
        '  inData = inData & Hex(InByte(j)) & " " '取出一个字节换为16进制显示用

           ' Else:
                  If InByte(j) < 128 And bFlag = 0 Then
                    If InByte(j) = 13 Then
                    inData = inData & vbCr 'Lf
                    Else
                    inData = inData & Chr(InByte(j)) 'ascii码显示处理
                    
                    End If
                  Else '此时为一个中文的前半部
                     If bFlag Then '上次收到半个中文没处理
                     temp1 = Xbyte
                     temp2 = InByte(j)
                     temp = (temp1 * 256 + temp2) - 65536
                     inData = inData & Chr(temp)
                     bFlag = 0
                     Else
                        If j <> UBound(InByte) Then
                        temp1 = InByte(j)
                        temp2 = InByte(j + 1)
                        temp = (temp1 * 256 + temp2) - 65536
                        inData = inData & Chr(temp) ' & "(*" & temp & "*) "
                        j = j + 1 '此次中断收到最后一个字节是前半个中文
                        Else
                        
                        Xbyte = InByte(j) '保存该字节
                        bFlag = 1 '置标志
                        
                        End If
                     End If
                 ' End If
            End If
         
        ' counttrue = 1
        
    Next j

 DoEvents

   ' Delay 1
 ' flag2 = False
 If InStr(inData, "^SYSS") Then
    MSComm1.Output = "AT+CNMI=2,2,0,0,1" & vbCrLf
  
 End If
  If InStr(inData, "+CMTI:") <> 0 And counttrue = 1 Then
        
            Text4.SelText = "新短信，请接收！" & vbCrLf
           ' Delay 1
            counttrue = counttrue + 1
 End If


If Check1.Value And InStr(inData, "+CMT:") <> 0 Then
 CloseOnComm
 Delay 1
 
 inData = MSComm1.Input
If Check2.Value Then
 
 Text4.SelText = inData
 MSComm1.Output = "at+cnma" & vbCrLf
 Exit Sub
End If
 Dim atext() As String
 atext = Split(inData, Chr(13) & Chr(10))
 Text8.Text = atext(1)
 SuperSMS1.ConPDU Text8.Text, P, D, T, TXT, 1, E
'Text4.Text = smsalltext
'获得解析后的数据



'  Text4.SelText = E & vbCrLf
'   MSComm1.Output = "at+cmgf=1" & vbCrLf
'   Sleep (600)
'   MSComm1.Output = "at+cmgl= """ & "REC UNREAD" & """" & vbCrLf
'   Sleep (1000)
'   TxString = MSComm1.Input
'   Text4.SelText = TxString
'   MSComm1.Output = "at+cmgf=0" & vbCrLf
'   Sleep 300
   
'   MSComm1.Output = "at+cnma" & vbCrLf
'   OpenOnComm
'   E = 0
'Else
   
Text4.SelText = "电话号码：" & P & vbCrLf _
& "日期：" & D & vbCrLf _
& "时间：" & T & vbCrLf _
& "内容：" & TXT & vbCrLf _
& "错误代码：" & E & vbCrLf
'保存到TEXT文档
Text8.Text = "电话号码：" & P & vbCrLf _
& "日期：" & D & vbCrLf _
& "时间：" & T & vbCrLf _
& "内容：" & TXT & vbCrLf _
& "错误代码：" & E & vbCrLf
Open "DataLink.txt" For Append As #1
   Print #1, Text8.Text
Close #1

Sleep (400)
MSComm1.Output = "at+cnma" & Chr(13) & Chr(10)
Sleep (600)
  inData = MSComm1.Input
 If InStr(inData, "OK") = 0 Then
    MSComm1.Output = "at+cnma" & Chr(13) & Chr(10)
    Sleep (400)
    inData = MSComm1.Input
 End If
  OpenOnComm
  

  
End If
 
  Text4.SelText = inData '将刚收到的字符串显示出来
    inData = ""
  Text4.SelStart = Len(Text4.Text) '光标置后
    
'End If
Case comEventRxOver '接收缓冲区满的处理
MsgBox "接收缓冲区满了！" '发出警告
End Select
End Sub

Private Sub Timer1_Timer()

Command1_Click

End Sub