frmfind.frm

加上一个GSM模块

VERSION 5.00
Begin VB.Form frmFind 
   Caption         =   "数据查询"
   ClientHeight    =   7515
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11880
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   7515
   ScaleWidth      =   11880
   Begin VB.Frame Frame1 
      Caption         =   "返回数据"
      Height          =   2415
      Left            =   360
      TabIndex        =   0
      Top             =   1560
      Width           =   9855
      Begin VB.TextBox txtAutoRe 
         Height          =   1935
         Left            =   240
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   1
         Top             =   240
         Width           =   9015
      End
   End
   Begin VB.Timer TiDe 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   7920
      Top             =   0
   End
   Begin VB.Timer tiAuto 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   7440
      Top             =   0
   End
End
Attribute VB_Name = "frmFind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim flagAuto As Boolean
Dim smsReStr As String


Public Function smsDecode(rmsg As String)
    Dim tep As String
    Dim temp As String
    Dim i As Integer
    Dim B As Integer
    tep = rmsg
    i = Len(tep)
    If i < 1 Then Exit Function
    B = i / 4
    If i = B * 4 Then
        tep = Left(tep, B * 4)
    Else
        B = B - 1
        tep = Left(tep, B * 4)
    End If
    chg = ""
    For i = 1 To B
        temp = "&H" & Mid(tep, (i - 1) * 4 + 1, 4)
        chg = chg & ChrW(CInt(Val(temp)))
    Next i
    smsReStr = chg
End Function

Public Function GetData() As String
    Dim Count As Integer
    Dim Count1 As Integer
    Dim count2 As Integer
    Dim flag1 As Boolean
    Dim flag2 As Boolean
    Dim Flag3 As Boolean
    Dim flag5 As Boolean
    
    Dim CNlength As Integer
    Dim rP As String
    
    flag1 = False
    flag2 = False
    Flag3 = False
    flag5 = False
    Count = 0
    Count1 = 0
    count2 = 0
    phoneNum = ""
    phoneTime = ""
    receiveStr = ""
    smsAll = ""
    
    frmMDI.comm.InputLen = 1
    'frmMDI.comm.InputLen = 0
    While frmMDI.comm.InBufferCount > 0
        'txtAutoRe.Text = txtAutoRe.Text + frmMDI.comm.Input
        ReDim Preserve arr_return(Count + 1)
        arr_return(Count) = frmMDI.comm.Input
        smsAll = arr_return(Count)
        If Count > 3 Then
            If arr_return(Count - 3) = "+" And arr_return(Count - 2) = "C" And arr_return(Count - 1) = "M" Then
                flag2 = True
                txtAutoRe.Text = txtAutoRe.Text + "come here 1"
            End If
        End If
        If flag2 = True Then
            If Count > 6 Then
                If arr_return(Count - 5) = "0" And arr_return(Count - 4) = "8" And arr_return(Count - 3) = "9" And arr_return(Count - 2) = "1" And arr_return(Count - 1) = "6" And arr_return(Count) = "8" Then
                    Flag3 = True
                    count2 = 6
                End If
            End If
            If Flag3 = True Then
                If count2 > 26 And count2 <= 38 Then
                    phoneNum = arr_return(Count)
                End If
                If count2 = 38 Then
                    txtAutoRe.Text = txtAutoRe.Text + phoneNum
                    CNlength = Len(phoneNum)
                    rP = ""
                    For i = 1 To CNlength - 1 Step 2
                        rP = rP + Mid(phoneNum, i + 1, 1) + Mid(phoneNum, i, 1)
                    Next
                    phoneNum = Left(rP, 11)
                End If
                If count2 > 58 Then
                    receiveStr = arr_return(Count)
                End If
                count2 = count2 + 1
            End If
        End If
                   
        If Count > 4 Then
            If arr_return(Count - 4) = "S" And arr_return(Count - 3) = "M" And arr_return(Count - 1) = "," Then
                newNo(newCount) = arr_return(Count)
                newCount = newCount + 1
            End If
        End If
        Count = Count + 1
    Wend
End Function
Public Function RecTemp() As String
    Dim buf$
    If frmMDI.comm.InBufferCount > 0 Then
        frmMDI.comm.InputLen = 0
        buf = frmMDI.comm.Input
    End If
End Function
Public Function GetData1() As String
    Dim Count As Integer
    Count = 0
    frmMDI.comm.InputLen = 1
    While frmMDI.comm.InBufferCount > 0
        ReDim Preserve arr_return(Count + 1)
        arr_return(Count) = frmMDI.comm.Input
        If Count > 4 Then
            If arr_return(Count - 4) = "S" And arr_return(Count - 3) = "M" And arr_return(Count - 1) = "," Then
                newNo(newCount) = arr_return(Count)
                newCount = newCount + 1
            End If
        End If
        Count = Count + 1
    Wend
End Function

Public Function ReadNo() As String
    If frmMDI.comm.InBufferCount > 0 Then
        Dim Count As Integer
        Count = 0
        frmMDI.comm.InputLen = 1
        While frmMDI.comm.InBufferCount > 0
            ReDim Preserve mess_index1(Count + 1)
            mess_index1(Count) = frmMDI.comm.Input
            If Count > 4 Then
                If mess_index1(Count - 4) = "S" And mess_index1(Count - 3) = "M" And mess_index1(Count - 1) = "," Then
                    newNo(newCount) = mess_index1(Count)
                    newCount = newCount + 1
                End If
            End If
            Count = Count + 1
        Wend
    End If
End Function

Private Sub Form_Load()
    Unload frmInit
    tiAuto.Enabled = True
    intall1 = 0
    noFlag = False
    newData = False
End Sub

Private Sub tiAuto_Timer()
    Dim i As Long
    Dim newString
    i = 0
    intall1 = intall1 + 1
    If newSub < newCount And noFlag = False And intall1 = 1 Then
        frmMDI.comm.Output = "AT+CMGR=" + Hex(newNo(newSub)) + Chr(13) + Chr(10)
        newSub = newSub + 1
        noFlag = True
    ElseIf newSub >= newCount And noFlag = False Then
        If frmMDI.comm.InBufferCount > 0 Then
            Call ReadNo
            intall1 = 0
        Else
            If newSub > 0 Then
                newString = CStr(newSub)
                If newSub < 10 Then
                    frmMDI.comm.Output = "AT+CMGD=" + newString + Chr(13) + Chr(10)
                End If
                If newSub >= 10 Then
                    frmMDI.comm.Output = "AT+CMGD=" + Left(newString, 1) + Right(newString, 1) + Chr(13) + Chr(10)
                End If
                newString = ""
                TiDe.Enabled = True
            End If
            intall1 = 0
        End If
    Else
        i = i + 1
        i = i - 1
        If noFlag = False Then
            intall1 = 0
        End If
    End If
    If noFlag = True And intall1 = 2 Then
        While frmMDI.comm.InBufferCount > 0
            tiAuto.Enabled = False
            noFlag = False
            Flag = False
            Call GetData
            txtAutoRe.Text = txtAutoRe.Text + Chr(13) + Chr(10) + "SIM卡号码：" + phoneNum
            smsDecode (receiveStr)
            txtAutoRe.Text = txtAutoRe.Text + Chr(13) + Chr(10) + "短信内容：" + smsReStr
            
           
                Flag = True
                newData = False
                txtAutoRe.Text = txtAutoRe.Text + Chr(13) + Chr(10) + "接收到的数据正确"
                frmMDI.comm.Output = "AT+CMGD=" + Hex(no) + Chr(13) + Chr(10)
                tiAuto.Enabled = True
                intall1 = 0
        Wend
        intall1 = 0
    End If
End Sub

Private Sub tiDe_Timer()
    If frmMDI.comm.InBufferCount > 0 Then
        TiDe.Enabled = False
        Call GetData1
        newSub = newSub - 1
        newCount = newCount - 1
        'If arr_return(UBound(arr_return) - 4) = "O" And arr_return(UBound(arr_return) - 3) = "K" Then
        txtAutoRe.Text = txtAutoRe.Text + Chr(13) + Chr(10) + "SIM卡上的短信已删除"
        'Else
            'TiDe.Enabled = True
            'frmMDI.comm.Output = "AT+CMGD=" + Hex(no) + Chr(13) + Chr(10)
        'End If
    End If
End Sub