soj1.frm

用vb写的motorola手机短消息管理软件

   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。



MSComm1.Output = "AT+CMGF=1" & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。



MSComm1.Output = "AT+CSCS=" & Chr(34) & "UCS2" + Chr(34) & Chr$(13) ' 确保

   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。

MSComm1.Output = "AT+CPMS=" & Chr(34) & "IM" + Chr(34) & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。

MSComm1.Output = "AT+MMGL=" & Chr(34) & "REC READ" + Chr(34) & Chr$(13) ' 确保

   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
  
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。

i = Len(buffer)
   ' 关闭串行端口。
Dim M As Integer
Dim aa() As String
Dim z As Integer
Dim x_begin, x_end As Integer
Dim str1 As String
Dim str2 As String
Dim datetime1, smstext, status, telephone As String
Dim db As Database
Dim rs As Recordset
        
    ' Open the database.
    Set db = OpenDatabase(App.Path & "\mysms.mdb")

    ' Open the recordset.
    Text1 = buffer
        
   M = Searchrecord(buffer, "+MMGL:", aa(), 5)
For i = 1 To M - 1

MSComm1.Output = "AT+CMGR=" & aa(i) & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer = buffer & MSComm1.Input
   Loop Until InStr(buffer, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。
  str1 = buffer
   x_begin = InStr(1, str1, Chr(34))   '段消息方式
   x_end = InStr(x_begin + 1, str1, Chr(34))
   str2 = Mid$(str1, x_begin + 1, x_end - x_begin - 1)
   str1 = Mid$(str1, x_end + 1)
   
   status1 = str2
   
   
   x_begin = InStr(1, str1, Chr(34))   '段消息号码
   x_end = InStr(x_begin + 1, str1, Chr(34))
   str2 = Mid$(str1, x_begin + 1, x_end - x_begin - 1)
   str1 = Mid$(str1, x_end + 1)
   
   telephone1 = str2
  
  
   x_begin = InStr(1, str1, Chr(34))   '段消息日期
   x_end = InStr(x_begin + 1, str1, Chr(34))
   str2 = Mid$(str1, x_begin + 1, x_end - x_begin - 1)
   str1 = Mid$(str1, x_end + 1)
   
  datetime1 = str2
  
   
   '短消息内容
    x = InStr(1, str1, "OK")
    str2 = Left(str1, x - 1)
    str2 = Mid(str2, 3, Len(str2) - 4) '去掉短消息的起始和结束符
      
  smstext1 = chg(str2)
  
   Dim j As Integer
   j = 0
  Set rs = db.OpenRecordset("SMS")
  rs.Index = "DATETIME"
  rs.Seek "=", datetime1
  If rs.NoMatch Then
        j = j + 1
        rs.AddNew
        rs!status = status1
        rs!DateTime = datetime1
        rs!telephone = telephone1
        rs!smstext = smstext1
        rs.Update
    rs.Close
       End If
       
       Next i
db.Close
  MSComm1.PortOpen = False
  MsgBox "接受文件夹共有 " & M - 1 & "短消息被处理" & "其中新添加短消息" & j & "条"
End Sub

Private Sub savesend_Click()
Dim k As Integer
Dim obj1 As String
' 保存输入子串的缓冲区
    '   Dim buffer As String
   ' 使用 COM1。
   MSComm1.CommPort = commonport
   ' 9600 波特，无奇偶校验，8 位数据，一个停止位。
   MSComm1.Settings = "9600,N,8,1"
   ' 当输入占用时，
   ' 告诉控件读入整个缓冲区。
    'MSComm1.InputLen = 0
   ' 打开端口。
   MSComm1.PortOpen = True
   ' 将 attention 命令送到调制解调器。
   MSComm1.Output = "ATV1Q0" & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   'buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。
   
   MSComm1.Output = "ATV1Q0" & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   'buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。



MSComm1.Output = "ATE0" & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
 buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。



MSComm1.Output = "AT+CMGF=1" & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。



MSComm1.Output = "AT+CSCS=" & Chr(34) & "UCS2" + Chr(34) & Chr$(13) ' 确保

   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。

MSComm1.Output = "AT+CPMS=" & Chr(34) & "OM" + Chr(34) & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。

MSComm1.Output = "AT+CMGL=" & Chr(34) & "ALL" + Chr(34) & Chr$(13) ' 确保

   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
  
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。

i = Len(buffer)
   ' 关闭串行端口。
Dim M As Integer
Dim aa() As String
Dim z As Integer
Dim x_begin, x_end As Integer
Dim str1 As String
Dim str2 As String
Dim smstext, status, telephone As String
Dim db As Database
Dim rs As Recordset
 Dim j As Integer
   j = 0
    ' Open the database.
    Set db = OpenDatabase(App.Path & "\mysms.mdb")

    ' Open the recordset.
    
        
   M = Searchrecord(buffer, "+CMGL:", aa(), 4)
For i = 1 To M - 1

MSComm1.Output = "AT+CMGR=" & aa(i) & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = 0
   Do
      DoEvents
   buffer = buffer & MSComm1.Input
   Loop Until InStr(buffer, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。
  str1 = buffer
   x_begin = InStr(1, str1, Chr(34))   '段消息方式
   x_end = InStr(x_begin + 1, str1, Chr(34))
   str2 = Mid$(str1, x_begin + 1, x_end - x_begin - 1)
   str1 = Mid$(str1, x_end + 1)
   
   status1 = str2
   
   
   x_begin = InStr(1, str1, Chr(34))   '段消息号码
   x_end = InStr(x_begin + 1, str1, Chr(34))
   str2 = Mid$(str1, x_begin + 1, x_end - x_begin - 1)
   str1 = Mid$(str1, x_end + 1)
   
   telephone1 = str2
  
     
   '短消息内容
    x = InStr(1, str1, "OK")
    str2 = Left(str1, x - 1)
    str2 = Mid(str2, 3, Len(str2) - 4) '去掉短消息的起始和结束符
      
  smstext1 = chg(str2)
  
  
  Set rs = db.OpenRecordset("SMSSEND")
 ' rs.Index = "smstext"
 ' rs.Seek "=", smstext1
  'If rs.NoMatch Then
        j = j + 1
        rs.AddNew
        rs!status = status1
        rs!telephone = telephone1
        rs!smstext = smstext1
        rs.Update
    rs.Close
     '  End If
       
       Next i
db.Close
  MSComm1.PortOpen = False
  MsgBox "发送文件夹共有 " & M - 1 & "短消息被处理"
  
End Sub

Private Sub search_Click()
Dim i As Integer
' 保存输入子串的缓冲区
    '   Dim buffer As String
   ' 使用 COM1。
  For i = 1 To 7
      On Error Resume Next
      MSComm1.CommPort = i
       ' 9600 波特，无奇偶校验，8 位数据，一个停止位。
         MSComm1.Settings = "9600,N,8,1"
       ' 当输入占用时，
       ' 告诉控件读入整个缓冲区。
       'MSComm1.InputLen = 0
       ' 打开端口。
       MSComm1.PortOpen = True
                '打开错误处理
       'MSComm1.PortOpen = Not MSComm1.PortOpen
        If Err Then GoTo next1
      ' 将 attention 命令送到调制解调器。
       MSComm1.Output = "ATQ0V1E0" & Chr$(13) ' 确保
       ' 调制解调器以"OK"响应。
       ' 等待数据返回到串行端口。
       '    buffer = ""
       Timer1.Enabled = True
       delayflag = False
       Do
       DoEvents
      buffer = buffer & MSComm1.Input
      If delayflag Then
      Exit Do
      End If
     
     Loop Until InStr(buffer, "OK" & vbCrLf)
       If InStr(buffer, "OK" & vbCrLf) Then
          Exit For
          Else
       MSComm1.PortOpen = False
      End If
next1:    Next i
commonport = i
 MSComm1.Output = "AT+GMM" & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
    Do
      DoEvents
   buffer = buffer & MSComm1.Input
   Loop Until InStr(buffer, "OK" & vbCrLf)
   Label3.Caption = buffer
    MSComm1.PortOpen = False
ERRORCOM:    '   MSComm1.CommEvent = 0
delayflag = False
End Sub
Private Sub MSComm1_OnComm()
   Select Case MSComm1.CommEvent
   ' Handle each event or error by placing
   ' code below each case statement

' 错误
      Case comEventBreak   ' 收到 Break。
       Case comEventCDTO   ' CD (RLSD) 超时。
      Case comEventCTSTO   ' CTS Timeout。
      Case comEventDSRTO   ' DSR Timeout。
      Case comEventFrame   ' Framing Error
      Case comEventOverrun   '数据丢失。
      Case comEventRxOver '接收缓冲区溢出。
      Case comEventRxParity ' Parity 错误。
      Case comEventTxFull   '传输缓冲区已满。
      Case comEventDCB   '获取 DCB] 时意外错误

   ' 事件
      Case comEvCD   ' CD 线状态变化。
      Case comEvCTS   ' CTS 线状态变化。
      Case comEvDSR   ' DSR 线状态变化。
      Case comEvRing   ' Ring Indicator 变化。
      Case comEvReceive   ' 收到 RThreshold # of
      Case comEvSend   ' 传输缓冲区有 Sthreshold 个字符                     '
                     '
      Case comEvEOF   ' 输入数据流中发现 EOF 字符
                     '
   End Select
End Sub


Private Sub Timer1_Timer()
delayflag = True
End Sub