form1.frm

一个MODEM的短信软件

End If
End Sub


Private Sub Combo1_Click()

If MSComm1.PortOpen = 1 Then
MSComm1.PortOpen = 0
MSComm1.Settings = Combo1.Text + ",n,8,1"
'If Combo1.Text = "1200" Then MSComm1.Settings = "1200,,,"

MSComm1.PortOpen = 1
Else
MSComm1.Settings = Combo1.Text + ",n,8,1"
'If Combo1.Text = "1200" Then MSComm1.Settings = "1200,,,"

End If

End Sub
Private Sub combo1_dropdown()
Combo1.Clear
Combo1.AddItem "1200", 0
Combo1.AddItem "2400", 1
Combo1.AddItem "4800", 2
Combo1.AddItem "9600", 3
Combo1.AddItem "19200", 4
Combo1.AddItem "38400", 5
Combo1.AddItem "57600", 6
Combo1.AddItem "115200", 7
End Sub




Private Sub combo2_click()
'On Error Resume Next
On Error GoTo errorhander
If MSComm1.PortOpen Then MSComm1.PortOpen = False
  Command8.Caption = "打开串口"
 Dim SComm As Integer
 
 SComm = Val(Mid(Combo2.Text, 4, 1))
 MSComm1.CommPort = SComm
 MSComm1.PortOpen = True
 If MSComm1.PortOpen Then Command8.Caption = "关闭串口"
 
 Exit Sub
errorhander:
   MsgBox "当前串口被占用或其他错误，请检查！", vbOKOnly, "串口?"
   Resume Next
End Sub

Private Sub Command10_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= """ & "STO UNSENT" & """" & vbCrLf
   Sleep (2000)
   TxString = MSComm1.Input
   Text4.SelText = TxString
Else
MSComm1.Output = "at+cmgf=0" & vbCrLf
Sleep (600)
MSComm1.Output = "at+cmgl=3" & Chr(13) & Chr(10)
Sleep (1600)
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 Command11_Click()
On Local Error Resume Next

CloseOnComm
Dim TxString As String
MSComm1.Output = "at+cmgf=0" & vbCrLf
Sleep (600)
MSComm1.Output = "at+cmgl=4" & Chr(13) & Chr(10)
Sleep (600)
TxString = MSComm1.Input
Text4.SelText = TxString
OpenOnComm
End Sub

Private Sub Command2_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 SInput As String
Dim a As String
Dim atext() As String
Dim i As Integer
atext = Split(Text2.Text, ",")
'Dim s
If Text1.Text <> "" Then
  MSComm1.Output = "at+csca=""" & Text1.Text & """" & Chr(13) & Chr(10)
  Sleep (800)
  SInput = MSComm1.Input
  If InStr(SInput, "OK") = 0 Then
    MsgBox "短信中心设置失败，请重新设置！", vbOKOnly, "发送结果"
    OpenOnComm
    Exit Sub
  End If
  
End If
'Delay 1
MSComm1.Output = "at+cmgf=0" & Chr(13) & Chr(10)
Sleep (800)
'If MSComm1.Input = Chr(13) & Chr(13) & Chr(10) & Chr(79) & Chr(75) & Chr(13) & Chr(10) Then

   a = MSComm1.Input
   If InStr(a, "OK") <> 0 Then
   
    For i = 0 To UBound(atext)
      Text9.Text = atext(i)
      Conv
      MSComm1.Output = "at+cmgs=" & Text6.Text & Chr(13) & Chr(10)
      Delay 3
      MSComm1.Output = Text5.Text & Chr(26)
      Delay 4
      Dim SInputT
      SInputT = MSComm1.Input
      If InStr(SInputT, "+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
OpenOnComm
Command1.Enabled = True
Command2.Enabled = True
Command7.Enabled = True
Command11.Enabled = True
Command4.Enabled = True
Command9.Enabled = True
Command6.Enabled = True
Command10.Enabled = True
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Command4_Click()
'Dim TxInput(1 To 65534) As Byte
On Local Error Resume Next

CloseOnComm
Dim TxString As String
Dim i As Integer
If Check2.Value = 1 Then
   MSComm1.Output = "at+cmgf=1" & vbCrLf
   Sleep (600)
   MSComm1.Output = "at+cmgl= """ & "REC UNREAD" & """" & vbCrLf
   Sleep (1000)
   TxString = MSComm1.Input
   Text4.SelText = TxString
Else
MSComm1.Output = "at+cmgf=0" & vbCrLf
Sleep (600)
MSComm1.Output = "at+cmgl=0" & Chr(13) & Chr(10)
Sleep (1600)
TxString = MSComm1.Input
Text4.SelText = TxString
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 Command6_Click()
On Local Error Resume Next

CloseOnComm
Dim allstr As String
If Check2.Value Then
   MSComm1.Output = "at+cmgf=1" & vbCrLf
   Sleep (600)
   MSComm1.Output = "at+cmgl= """ & "ALL" & """" & vbCrLf
   Sleep (3600)
   allstr = MSComm1.Input
   Text4.SelText = allstr
Else

MSComm1.Output = "at+cmgf=0" & Chr(13) & Chr(10)
Sleep (600)
MSComm1.Output = "at+cmgl=4" & Chr(13) & Chr(10)

Sleep (3800)
Dim smsalltext As String
smsalltext = MSComm1.Input
Dim atext() As String
Dim i As Integer
atext = Split(smsalltext, Chr(13) & Chr(10))
Dim j As Integer

If Len(atext(4)) < 15 Then
  Text4.SelText = "内存为空，无短信" & vbCrLf
Else
For j = 2 To (UBound(atext) - 1) / 2 - 1
 Sleep (100)
Text8.Text = atext(j * 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
Next j
End If
End If
OpenOnComm
End Sub
Sub Conv()

SuperSMS1.SMS_Phone = Trim(Text9.Text)
SuperSMS1.SMS_CSCA = Trim(Text1.Text)
SuperSMS1.SMS_STXT = Trim(Text3.Text)
Text5.Text = SuperSMS1.SMS_SMain
'Text8.Text = SuperSMS1.ANSIText(Text7.Text)
Text6.Text = SuperSMS1.SMS_SLen
End Sub

Private Sub Command5_Click()
Text4.Text = ""
End Sub



Private Sub Command7_Click()
On Local Error Resume Next

CloseOnComm


MSComm1.Output = "at+cmgd=" & Text7.Text & vbCrLf
Dim deltext As String
Delay 1
deltext = MSComm1.Input
If InStr(deltext, "OK") <> 0 Then
   Text4.SelText = "删除短信" & Text7.Text & "成功" & vbCrLf
   deltext = ""
Else
   Text4.SelText = "删除短信" & Text7.Text & "失败，请重新检查" & vbCrLf
    deltext = ""
End If
OpenOnComm
End Sub


Private Sub combo2_dropdown()
On Local Error Resume Next

Dim SCom As Integer
  Dim hKey As Long, ret As Long, lenData As Long, typeData As Long
    Dim Name As String, lenName As Long
    Dim idx As Integer, j As Integer
    Dim SSCom(0 To 50) As String
    ret = RegOpenKey(HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM", hKey)
   ' If ret <> 0 Then Exit Sub
   ' SCom = ret
    ret = 0
    idx = 0
    Dim s As String
    Dim SArr() As String
    
    
    While ret = 0
        lenName = 256
        Name = String(256, Chr(0))
        ret = RegEnumValueAsAny(hKey, idx, Name, lenName, ByVal 0, typeData, _
                                ByVal vbNullString, lenData)
        If ret <> 0 Then
            RegCloseKey hKey
          '  Exit Sub
        End If
        
        lenName = Len(Name)
    
        s = String(lenData, Chr(0))
        RegEnumValueAsAny hKey, idx, Name, lenName, ByVal 0, typeData, ByVal s, lenData

        s = Left(s, InStr(s, Chr(0)) - 1)

        'Debug.Print s
      
      '  Text1.SelText = s
        SSCom(idx) = s
        DoEvents
        
        idx = idx + 1
        SCom = idx
    Wend
    RegCloseKey hKey
    
Combo2.Clear
Dim i As Integer
For i = 0 To SCom - 2
Combo2.AddItem SSCom(i), i
'Combo7.AddItem "com2", 1
Next
End Sub
Private Sub Command8_Click()
'On Error Resume Next
On Local Error Resume Next

CloseOnComm

If InStr(Command8.Caption, "关闭串口") <> 0 Then
 If MSComm1.PortOpen = True Then
   MSComm1.PortOpen = False
   Command8.Caption = "打开串口"
   Command7.Enabled = False
   Command6.Enabled = False
   Command4.Enabled = False
   Command1.Enabled = False
   Command9.Enabled = False
   Command10.Enabled = False
   Command2.Enabled = False
   Command11.Enabled = False
   Label5.Enabled = False
 End If
   
 Else
 
  MSComm1.PortOpen = 1
  Command8.Caption = "关闭串口"
'  If flag2 = True Then