form1.frm

ＰＣ和ＧＳＭ模块利用串口通信

Dim strcontent As String
Dim strcounter As String
Private Sub Command1_Click()
If MSComm1.PortOpen = False Then
   MSComm1.PortOpen = True
End If
MSComm1.Output = "AT+CMGR=" & Text1.Text & vbCr
flag = 2
End Sub

Private Sub Command2_Click()
strbuffer = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
End Sub

Private Sub Command3_Click()
Dim strshoujihao As String
   strshoujihao = ""
   If Len(Trim$(shoujihao.Text)) = 11 Or Len(Trim$(shoujihao.Text)) = 14 Then
      shoujihao.Text = Trim$(shoujihao.Text)
      For i = 1 To Len(shoujihao.Text)
          If Len(Hex(AscW(Mid(shoujihao.Text, i, 1)))) = 1 Then
               strshoujihao = strshoujihao & "000" & Hex(AscW(Mid(shoujihao.Text, i, 1)))
          ElseIf Len(Hex(AscW(Mid(shoujihao.Text, i, 1)))) = 2 Then
                strshoujihao = strshoujihao & "00" & Hex(AscW(Mid(shoujihao.Text, i, 1)))
          ElseIf Len(Hex(AscW(Mid(shoujihao.Text, i, 1)))) = 3 Then
                strshoujihao = strshoujihao & "0" & Hex(AscW(Mid(shoujihao.Text, i, 1)))
          Else
               strshoujihao = strshoujihao & Hex(AscW(Mid(shoujihao.Text, i, 1)))
          End If
      Next
   Else
       MsgBox "手机号不正确，请重新输入！"
       Exit Sub
   End If
   strshoujihao = Trim$(LCase(strshoujihao))
   strcontent = ""
   If Trim$(content.Text) <> "" Then
      content.Text = Trim$(content.Text)
      For i = 1 To Len(content.Text)
          If Len(Hex(AscW(Mid(content.Text, i, 1)))) = 1 Then
               strcontent = strcontent & "000" & Hex(AscW(Mid(content.Text, i, 1)))
          ElseIf Len(Hex(AscW(Mid(content.Text, i, 1)))) = 2 Then
                strcontent = strcontent & "00" & Hex(AscW(Mid(content.Text, i, 1)))
          ElseIf Len(Hex(AscW(Mid(content.Text, i, 1)))) = 3 Then
                strcontent = strcontent & "0" & Hex(AscW(Mid(content.Text, i, 1)))
          Else
               strcontent = strcontent & Hex(AscW(Mid(content.Text, i, 1)))
          End If
      Next
   Else
       MsgBox "内容为空，请输入短信内容！"
       Exit Sub
   End If
   strcontent = Trim$(LCase(strcontent))
  ' Text2.Caption = "AT+CMGS=" & strshoujihao & vbCr & strcontent & Chr$(26) & vbCrLf
   MSComm1.Output = "AT+CMGS=" & strshoujihao & vbCr
   Timer1.Enabled = True
  ' delays 80
   'MSComm1.Output = strcontent
   'delays 50
   'MSComm1.Output = Chr$(26) & vbCrLf
   zhuangtai.Caption = "正在发送..."
   flag = 1
End Sub

Private Sub Command4_Click()
zhuangtai.Caption = ""
End Sub

Private Sub Command5_Click()
MSComm1.Output = "AT+CMGD=" & Trim(Text1.Text) & vbCr
End Sub

Private Sub Command6_Click()
Text2.Text = ""
strnew = ""
End Sub



Private Sub Form_Load()
MSComm1.CommPort = 1
MSComm1.Settings = "9600,N,8,1"
MSComm1.InputLen = 0
MSComm1.InBufferCount = 0
If MSComm1.PortOpen = False Then
   MSComm1.PortOpen = True
End If
End Sub

Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
Case comEvReceive
Dim strtempe As String
strtempe = MSComm1.Input
strnew = strnew & strtempe
Text2.Text = Text2.Text & strtempe
Text2.SelStart = Len(Text2.Text)
If InStr(strnew, "+CMTI:") And ((Mid(strnew, InStr(strnew, "+CMTI:") + 13, 1) = vbCr) Or (Mid(strnew, InStr(strnew, "+CMTI:") + 14, 1) = vbCr)) Then
  ' strnew = ""
   flag = 3
End If
If flag = 1 Then
   If InStr(strnew, "OK") Then
      flag = 0
      zhuangtai.Caption = "发送成功！"
      strnew = ""
    ElseIf InStr(strnew, "ERROR") Then
      flag = 0
      zhuangtai.Caption = "发送失败！"
      strnew = ""
    End If
End If
If flag = 2 Then
   If InStr(strnew, "OK" & vbCrLf) Then
        flag = 0
     '   Text2.Text = strnew
        process strnew
        strnew = ""
    End If
End If
If flag = 3 Then
  ' flag = 0
 ' Text3.Text = strnew
   If Mid(strnew, InStr(strnew, ",") + 2, 1) = vbCr Then
       strcounter = Mid(strnew, InStr(strnew, ",") + 1, 1)
       Text6.Text = Text6.Text & vbCrLf & vbCrLf & strcounter
       Text6.SelStart = Len(Text6.Text)
   Else
       strcounter = Mid(strnew, InStr(strnew, ",") + 1, 2)
       Text6.Text = Text6.Text & vbCrLf & vbCrLf & strcounter
       Text6.SelStart = Len(Text6.Text)
   End If
   strnew = ""
MSComm1.Output = "AT+CMGR=" & strcounter & vbCr
flag = 4
End If
If flag = 4 Then
'Do
'strbuffer = strbuffer & MSComm1.Input
'Loop Until InStr(strbuffer, "OK" & vbCrLf)
If InStr(strnew, "OK" & vbCrLf) Then
   '  Text2.Text = strnew
     process strnew
     strbuffer = ""
     strnew = ""
     flag = 0
  '   Form2.Text1.Text  = Form2.text1.Text  & vbCrLf & Text5.Text
  Form2.Show
End If
End If
End Select
End Sub
Private Sub process(str As String)
Dim counterstart As Long
Dim countermid As Long
Dim counterend As Long
Dim ucs2str As String
Dim zhongwenstr As String
Dim i As Integer
Dim sum As Long
Dim strsmh As String
counterstart = InStr(str, "READ") + 7
countermid = InStr(str, ",,") + 3
counterend = InStr(str, "OK" & vbCrLf)
strsmh = Mid$(str, counterstart, countermid - counterstart - 4)
sum = 0
zhongwenstr = ""
For i = 1 To Len(strsmh)
    Select Case Mid(strsmh, i, 1)
    Case "0"
         sum = sum * 16 + 0
    Case "1"
         sum = sum * 16 + 1
    Case "2"
         sum = sum * 16 + 2
    Case "3"
         sum = sum * 16 + 3
    Case "4"
         sum = sum * 16 + 4
    Case "5"
         sum = sum * 16 + 5
    Case "6"
         sum = sum * 16 + 6
    Case "7"
         sum = sum * 16 + 7
    Case "8"
         sum = sum * 16 + 8
    Case "9"
         sum = sum * 16 + 9
    Case "a", "A"
         sum = sum * 16 + 10
    Case "b", "B"
         sum = sum * 16 + 11
    Case "c", "C"
         sum = sum * 16 + 12
    Case "d", "D"
         sum = sum * 16 + 13
    Case "e", "E"
         sum = sum * 16 + 14
    Case "f", "F"
         sum = sum * 16 + 15
    End Select
    If (i Mod 4) = 0 Then
        zhongwenstr = zhongwenstr & ChrW(sum)
        sum = 0
    End If
    Next i
    Text3.Text = Text3 & vbCrLf & vbCrLf & zhongwenstr
    Text3.SelStart = Len(Text3.Text)
Text4.Text = Text4.Text & vbCrLf & vbCrLf & Mid(str, countermid, 17)
Text4.SelStart = Len(Text4.Text)
ucs2str = Mid(str, countermid + 23, counterend - 27 - countermid)
sum = 0
zhongwenstr = ""
For i = 1 To Len(ucs2str)
    Select Case Mid(ucs2str, i, 1)
    Case "0"
         sum = sum * 16 + 0
    Case "1"
         sum = sum * 16 + 1
    Case "2"
         sum = sum * 16 + 2
    Case "3"
         sum = sum * 16 + 3
    Case "4"
         sum = sum * 16 + 4
    Case "5"
         sum = sum * 16 + 5
    Case "6"
         sum = sum * 16 + 6
    Case "7"
         sum = sum * 16 + 7
    Case "8"
         sum = sum * 16 + 8
    Case "9"
         sum = sum * 16 + 9
    Case "a", "A"
         sum = sum * 16 + 10
    Case "b", "B"
         sum = sum * 16 + 11
    Case "c", "C"
         sum = sum * 16 + 12
    Case "d", "D"
         sum = sum * 16 + 13
    Case "e", "E"
         sum = sum * 16 + 14
    Case "f", "F"
         sum = sum * 16 + 15
    End Select
    If (i Mod 4) = 0 Then
        zhongwenstr = zhongwenstr & ChrW(sum)
        sum = 0
    End If
    Next i
    Form2.Text1.Text = Form2.Text1.Text & vbCrLf & zhongwenstr
    Form2.Text1.SelStart = Len(Form2.Text1.Text)
    Text5.Text = Text5.Text & vbCrLf & vbCrLf & zhongwenstr
    Text5.SelStart = Len(Text5.Text)
    flag = 0
End Sub
Private Sub delays(counter As Long)
For i = 1 To counter
    For j = 1 To 1000
        DoEvents
    Next j
Next i
End Sub

Private Sub Timer1_Timer()
 MSComm1.Output = strcontent
 Timer1.Enabled = False
 Timer2.Enabled = True
End Sub

Private Sub Timer2_Timer()
MSComm1.Output = Chr$(26)
Timer2.Enabled = False
End Sub