sms_database.frm

VB做的一个短信收发的例子,功能比较强大,可以好好参考

 TxtReq.Text = GetSetting(App.Title, "setting", "SN", "Jv}<@(\`533L!*C")
 SMS1.SerialNumber = TxtReq.Text  '请和销售商联系。或致电021-68753549
 
 
 SMS1.CommPort = GetSetting(App.Title, "system", "Port", 1)

 ret = SMS1.InitComm
 
 If ret = False Then
    MsgBox "打开串口" & SMS1.CommPort & "错误"
  End If
  
   SMS1.SendReport = True   '需要状态报告
   
 TxtID.Text = "产品序号：" & SMS1.ProductID
  Set Rd = New ADODB.Recordset
 CURpage = listInGrid(1) '在网格里显示接收到的短消息
 
 
 
 TxtNum.Text = GetSetting(App.Title, "system", "LastNum", "")
 TxtNr.Text = GetSetting(App.Title, "system", "LastNr", "上海蓝峰电子技术有限公司" & vbCrLf & "Tel:[phone]" & vbCrLf & "Email: DLXW@ china.com")
 
Exit Sub
err1:
 MsgBox Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
'
'结束，关闭串口
 SaveSetting App.Title, "setting", "SN", TxtReq.Text
SMS1.EndComm

'数据库关闭
If Rd.State <> adStateClosed Then
 Rd.Close
End If
Set Rd = Nothing
conn.Close
Set conn = Nothing


  SaveSetting App.Title, "system", "LastNum", TxtNum.Text
    SaveSetting App.Title, "system", "LastNR", TxtNr.Text
 

End Sub



Private Sub SMS1_OnComm()
'整个程序中只用了 事件4000（接收到短消息），8880（发送短消息完成）
Dim s
Dim ret As String
Dim Recv
Dim iEvent As Integer
iEvent = SMS1.CommEvent
'Text1.Text = Text1.Text & "触发" & iEvent & vbCrLf
Select Case iEvent 'SMS1.CommEvent

   ' Errors
      Case 1001 'comEventBreak   ' A Break was received.
      Case 1004 'comEventFrame   ' Framing Error
      Case 1006 'comEventOverrun   ' Data Lost.
      Case 1008 'comEventRxOver   ' Receive buffer overflow.
      Case 1009 'comEventRxParity   ' Parity Error.
      Case 1010 'comEventTxFull   ' Transmit buffer full.
      Case 1011 'comEventDCB   ' Unexpected error retrieving DCB]
      Case 5 'comEvCD   ' Change in the CD line.
      Case 3 'comEvCTS   ' Change in the CTS line.
      Case 4 'comEvDSR   ' Change in the DSR line.
      Case 6 'comEvRing   ' Change in the Ring Indicator.
      Case 2 'comEvReceive   ' Received RThreshold # of
         '接收到字符在这里判断            ' chars.
         
     
      Case 8880  'SendSMSWithoutRet发送成功
        
        Recv = Split(SMS1.LastSentSMS, "|")   '形式：   '37|电话号码:[phone]|3|
       
       conn.Execute ("update smssend set sms_state=1,sms_fssj= '" & Now() & "' ,sms_report=" & Recv(0) & " where id=" & "0" & Recv(2))
       
        If Len(Text1.Text) > 1000 Then
           Text1.Text = ""
        End If
        
        Text1.Text = Text1.Text & vbCrLf & "连续发送短消息，最近发送完成:" & SMS1.LastSentSMS
        Text1.SelStart = Len(Text1.Text)
       
       
      Case 8884  'SendSMSWithoutRet发送出错
        Text1.Text = Text1.Text & vbCrLf & "以下短消息经过重复发送依旧出错" & SMS1.LastSentSMS
        
         Recv = Split(SMS1.LastSentSMS, "|")
        '37|电话号码:[phone]|3|
       
         '增加一次错误次数
         
         conn.Execute ("update smssend set sms_state='0',error_times = error_times+1 where id=" & "0" & Recv(2))
        
         If Len(Text1.Text) > 1000 Then
           Text1.Text = ""
        End If
        
        Text1.Text = Text1.Text & vbCrLf & "以下短消息经过重复发送依旧出错" & SMS1.LastSentSMS
        Text1.SelStart = Len(Text1.Text)
        
       ' Recv = Split(SMS1.LastSentSMS, ",")  '37|电话号码:[phone]|3|
'       Recv = Split(SMS1.LastSentSMS, "|")
'       '37|电话号码:[phone]|3|
'       conn.Execute ("update smssend set sms_state=1,sms_report=" & Recv(0) & " where id=" & "0" & Recv(2))
        '返回形式： 短消息id|号码|内容
      Case 9999  '自动直接送达的短消息 通知
        Debug.Print SMS1.NewSMS
        
        ''        Text1.Text = Text1.Text & vbCrLf & "新短消息:" & SMS1.NewSMS
        
        

      Case 4000
       'sim卡中短消息数目内容提示
        '如果有这个事件产生，可以用read_sms去读取所有短消息
        Text1.Text = Text1.Text & vbCrLf & " Sim卡中短消息数目" & SMS1.NewSMS
        Debug.Print "Sim卡中短消息数目" & SMS1.NewSMS
         SMS1.DelayTime = 60
        
         ret = SMS1.Read_SMS(4, 1)
         
         
          s = Split(ret, vbTab)  '每条短消息 以TAB键分割
         For i = 0 To UBound(s)
          If s(i) <> "" Then
                Debug.Print "  接受内容" & s(i)
                ssms = Split(s(i), "|")
                 For j = 0 To UBound(ssms)
                   If ssms(j) <> "" Then
                     Debug.Print "  消息内容:" & ssms(j)
                            If InStr(ssms(j), "电话号码:") Then '以"电话号码:"为判断标志
                               SMSrecv.SMStime = ""
                              SMSrecv.SmsFrom = ""
                               SMSrecv.smsNR = ""
                               SMSrecv.SMStime = Replace(ssms(j - 1), "时间(有效期):", "")
                               SMSrecv.SmsFrom = Replace(ssms(j), "电话号码:", "")
                               SMSrecv.smsNR = ssms(j + 1)
                               SMSrecv.smsNR = SMSrecv.smsNR ' Left(SMSrecv.smsNR, Len(SMSrecv.smsNR) - 2) ' 去掉vbcrlf
                               If Left(SMSrecv.smsNR, 5) = "状态报告:" Then  '如果是状态报告 则插入到发送表中，仅修改状态报告时间 ，查询时如果有状态报告时间则说明有状态报告回执
                               '接受内容02|状态:99|时间(有效期):04-03-23 01:53:54|电话号码:[phone]|状态报告:91,00,13917577175,04-03-23 01:53:54,04-03-23 01:53:54
                               '状态报告
                                   smsReport = Split(SMSrecv.smsNR, ",")
                                   conn.Errors.Clear
                                   conn.Execute "update smssend set  sms_reportstate='" & smsReport(1) & "' ,sms_reportsj='" & CDate(smsReport(4)) & "' where  sms_report='" & Replace(smsReport(0), "状态报告:", "") & "'"
                                   If conn.Errors.Count > 0 Then
                                   Debug.Print "err" & Err.Description
                                   Else
                                   Debug.Print " sms report update ok"
                                   End If
                                   
                                   Exit For  '结束
                               End If
                               '如果不是状态报告 则插入接收表内
                               If Not IsDate(SMSrecv.SMStime) Then
                                 SMSrecv.SMStime = Now()
                               End If
                               conn.Errors.Clear
                               conn.Execute "insert into smsRecv(sms_num,sms_nr,sms_sj) values('" & SMSrecv.SmsFrom & "','" & Left(SMSrecv.smsNR & "", 160) & "','" & SMSrecv.SMStime & "')"
                               If conn.Errors.Count > 0 Then
                                  Debug.Print "err" & Err.Description
                               Else
                                  Debug.Print " sms insert ok"
                               End If
                               
                               '
                               
                               '
                               
                               
                               CURpage = listInGrid(1) '刷新输入内容 自动回到第一行
                              
                               Exit For
                               
                            End If
                   End If
                 Next
          End If
         Next
         '处理短消息内容
         
         
        '即可以从ret里读取内容 也可以从事件号9888里读取到所有短消息信息
        'Text1.Text = "读取SIM卡中的短消息并删除:" & ret
        SMS1.DelayTime = 10
        If Len(Text1.Text) > 1000 Then
           Text1.Text = ""
        End If
        Text1.Text = Text1.Text & vbCrLf & "读取SIM卡中的短消息并删除:" & ret
        Text1.SelStart = Len(Text1.Text)
     
     '*******************************************************************
     '************以下内容你也可以不用处理
        Case 7777
        '发送出错，接收到了ERROR"
'       MsgBox "发送出错"
      Case 6666
        '发送可能出错，指定延时内 没有接收到OK或ERROR回音"
'        MsgBox "发送可能出错，指定延时内 没有接收到OK或ERROR回音"
      Case 8888
         '短消息发送完成 "
        
       
        '更新状态为已发!
        '        Text1.Text = Text1.Text & vbCrLf & "短消息发送完成:ID=" & SMS1.NewSMS
        '        conn.Execute ("update smssend set sms_state=1 where id=" & SMS1.NewSMS)
   
         Case 9998
      
      
        '接收到状态报告
        '形式如下:
        '状态报告:77,00,13918855535,04-02-18 11:26:17,04-02-18 11:26:17
        '状态报告：ID，状态，对方号码,发送时间，接收时间
''        If SMS1.NewSMS <> "" Then
''        Recv = Split(SMS1.NewSMS, "|")
''        'conn.Execute "update smssend set  "
''        Text1.Text = Text1.Text & vbCrLf & "状态报告:" & SMS1.NewSMS
''        End If
                  
      
      Case 9888  ' 读取SIM卡中所有短消息完成通知
         '
         Debug.Print "读取SIM卡中所有短消息事件:" + SMS1.NewSMS
         '内容如下形式:
         '索引:02|状态:0|时间(有效期):04-03-27 01:32:21|电话号码:[phone]|ADJAA
'         Text1.Text = Text1.Text + vbCrLf & "读取SIM卡中所有短消息事件:" + SMS1.NewSMS + "。" + SMS1.InputInfo
'
'         Recv = Split(SMS1.NewSMS, "|")
      Case 9777  '读取SIM卡中一条短消息完成通知
        '
         Debug.Print "读取SIM卡中一条短消息事件:" + SMS1.NewSMS; 内容如下形式:
         '时间(有效期):04-03-27 01:30:27|电话号码:[phone]|sms test abcd
'         Text3.Text = Text3.Text & vbCrLf & "读取SIM卡中一条SMS事件:" & SMS1.NewSMS
      Case 9666
        '
        '读短消息  出错
      
     
      Case 5555
        'sms1.OUTPUT="AT" & VBCRLF 后返回的字符 ,其他AT指令返回的字符
        'Debug.Print " 其他AT指令" & sms1.InputInfo
        'Text3.Text = Text3.Text & sms1.InputInfo
   Case 2000  '通常是没有SIM或者入网有问题
   Text1.Text = Text1.Text & vbCrLf & "GSM MODEM" & Index & "未入网"
   iRegState = iRegState + 1
   If iRegState >= 3 Then  '重新启动设备
    SMS1.Refresh
      iRegState = 0
   End If
   Case 2007
   Text1.Text = Text1.Text & vbCrLf & "GSM MODEM" & Index & "没有响应"
   If iRegState >= 3 Then
    SMS1.Refresh
     iRegState = 0
   End If
   
   Case 2001
   
   Text1.Text = Text1.Text & vbCrLf & "GSM MODEM" & Index & "已入网"
   End Select
End Sub


Private Sub Label5_Click()
ShellExecute Me.hwnd, vbNullString, "http://www.lanfeng.com", vbNullString, vbNullString, 1
End Sub

Private Sub MSGrid1_DblClick()
 If MSGrid1.Row > 0 And MSGrid1.TextMatrix(MSGrid1.Row, 1) <> "" Then
     MsgBox "号码：" & MSGrid1.TextMatrix(MSGrid1.Row, 1) & vbCrLf & "内容：" & MSGrid1.TextMatrix(MSGrid1.Row, 2) & vbCrLf & "时间：" & MSGrid1.TextMatrix(MSGrid1.Row, 3), vbInformation, "短消息"
     Else
  End If
End Sub


Private Function listInGrid(Optional ByVal pageno As Integer = 1) As Integer
 '
 Dim i As Integer
  Rd.Open "select * from smsRecv order by id desc", conn, 1, 1
 i = 1
 Dim s As String
 s = MSGrid1.FormatString
 
 MSGrid1.Clear
 MSGrid1.FormatString = s
 If Not (Rd.BOF And Rd.EOF) Then
   Rd.PageSize = 20
   If pageno < 1 Then pageno = 1
   If pageno > Rd.PageCount Then
 
    pageno = Rd.PageCount
   End If
   Rd.AbsolutePage = pageno
  
   
   Do While i <= 20 And Not Rd.EOF
       MSGrid1.TextMatrix(i, 0) = i + (pageno - 1) * Rd.PageSize
       MSGrid1.TextMatrix(i, 1) = Rd("sms_num") & ""
       MSGrid1.TextMatrix(i, 2) = Rd("sms_nr") & ""
       MSGrid1.TextMatrix(i, 3) = Rd("sms_sj") & ""
   i = i + 1
   Rd.MoveNext
   Loop
      
   
   
 Else
 End If
 Rd.Close
 listInGrid = pageno

End Function

Private Sub Timer1_Timer()
Set Rd = conn.Execute("select * from smssend WHERE   sms_state='0'   and error_times<10") '查出最新记录的ID，作为发送标志
  If Not (Rd.EOF And Rd.BOF) Then
   Do While Not Rd.EOF
    iid = Rd(0)
    
  If SMS1.SendSMSWithoutRet(Rd.Fields("sms_num") & "", Rd.Fields("sms_nr") & "", Rd.Fields("id")) Then      'iid主要为了在发送完成事件产生时 识别哪条短消息发送完成了。方便在数据库中 更新发送状态标志
        Debug.Print " 数据库 "; Rd.Fields("sms_num") & ""; Rd.Fields("sms_nr") & ""; Rd.Fields("id"); "放入发送缓冲区完成！"
        conn.Errors.Clear
        conn.Execute ("update smssend set sms_state='3' where id=  " & Rd.Fields("id") & "")
        If conn.Errors.Count > 0 Then
          Debug.Print " 修改出错"
        Else
          Debug.Print " 修改OK"
        End If
  End If
    Rd.MoveNext
   Loop
  End If
  Rd.Close
End Sub