frmmain.frm

监控类的开发

      Begin VB.TextBox txtSend 
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   1080
         TabIndex        =   7
         Top             =   240
         Width           =   6495
      End
      Begin VB.Label Label2 
         Caption         =   "结果"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   4200
         TabIndex        =   16
         Top             =   840
         Width           =   375
      End
      Begin VB.Label Label5 
         Caption         =   "短信内容"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   240
         TabIndex        =   10
         Top             =   360
         Width           =   735
      End
      Begin VB.Label Label4 
         Caption         =   "对方手机"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   240
         TabIndex        =   6
         Top             =   840
         Width           =   735
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "串口操作"
      Height          =   735
      Left            =   240
      TabIndex        =   1
      Top             =   120
      Width           =   3255
      Begin VB.CommandButton cmdClose 
         Caption         =   "关闭"
         Height          =   375
         Left            =   2280
         TabIndex        =   4
         Top             =   240
         Width           =   615
      End
      Begin VB.CommandButton cmdOpen 
         Caption         =   "打开"
         Height          =   375
         Left            =   1560
         TabIndex        =   0
         Top             =   240
         Width           =   615
      End
      Begin VB.ComboBox cmbCOM 
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   360
         Left            =   720
         TabIndex        =   2
         Top             =   240
         Width           =   735
      End
      Begin VB.Label Label1 
         Alignment       =   2  'Center
         Caption         =   "COM"
         Height          =   255
         Left            =   240
         TabIndex        =   3
         Top             =   360
         Width           =   495
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub DisplayGroup()
    With Adodc1
        .RecordSource = "select * from SMS_Send order by [ID]"
        .Refresh
    End With
    
    DG_Group.ZOrder
    AdjustNumber Adodc1, 0
    Frame5.Caption = "群发电话簿"
End Sub

Private Sub DisplaySMS()
    With Adodc1
        .RecordSource = "select * from SMS order by [Date],[Time]"
        .Refresh
    End With
    
    DG_SMS.ZOrder
    Frame5.Caption = "短信管理"
End Sub

Private Sub DisplayBook()
    With Adodc1
        .RecordSource = "select * from SIM order by [Location]"
        .Refresh
    End With
    
    DG_Book.ZOrder
    Frame5.Caption = "SIM卡电话簿"
End Sub

Private Sub ProcessCMGL(strData As String)
    Dim I  As Integer
    Dim strTmp As String
    Dim nLoc As Integer
    Dim strDate As String
    Dim strTime As String
    Dim strMark As String
    Dim strPhone As String
    Dim strContent As String
    
    With Adodc1
        Do While True
            strTmp = GetNoString(strData, vbCrLf, I)
            strTmp = DelAllSubChars(strTmp, Chr(&H22))
            strTmp = OnlyOneSegChar(strTmp, vbCrLf, True)
            
            If InStr(1, strTmp, "OK") <> 0 Or strTmp = "" Then Exit Do
            If InStr(1, strTmp, "+CMGL:") <> 0 Then
                strTmp = NextString(strTmp, ":")
                strTmp = InsertSpecialChar(strTmp, "+", ",")
                nLoc = Val(GetNoString(strTmp, ",", 0))
                
                strMark = GetNoString(strTmp, ",", 1)
                Select Case strMark
                    Case "REC READ"
                        strMark = "已读"
                    Case "REC UNREAD"
                        strMark = "未读"
                    Case "STO UNSENT"
                        strMark = "未发"
                    Case "STO SENT"
                        strMark = "已发"
                End Select
                strPhone = GetNoString(strTmp, ",", 2)
                strDate = GetNoString(strTmp, ",", 3)
                strTime = GetNoString(strTmp, ",", 4)
                
                I = I + 1
                strTmp = GetNoString(strData, vbCrLf, I)
                If (CheckLegalChars(strTmp, HEX_CHAR_SET) = True) And (Len(strTmp) Mod 4 = 0) Then
                    strContent = UnicodeCharsToString(strTmp)
                Else
                    strContent = strTmp
                End If
                
                .RecordSource = "select * from SMS where [Date]='" + _
                                 strDate + "' and [Time]='" + strTime + _
                                 "' order by [Date],[Time]"
                .Refresh
                With .Recordset
                    If .RecordCount < 1 Then
                        .AddNew
                        ![Date] = strDate
                        ![Time] = strTime
                        ![Location] = nLoc
                        ![Phone] = strPhone
                        ![Content] = strContent
                        ![Mark] = strMark
                        .Update
                        .Requery
                    End If
                End With
            End If
            
            I = I + 1
        Loop
    End With
    
    DisplaySMS
End Sub

Private Sub ProcessCPBR(strData As String)
    Dim I  As Integer
    Dim strTmp As String
    Dim nLoc As Integer
    Dim strPhone As String
    Dim strName As String
    
    With Adodc1
        Do While True
            strTmp = OnlyOneSegChar(strData + vbCrLf, vbCrLf, True)
            strTmp = GetNoString(strTmp, vbCrLf, I)
            'Debug.Print strData
            strTmp = DelAllSubChars(strTmp, Chr(&H22))
            
            If InStr(1, strTmp, "OK") <> 0 Or strTmp = "" Then Exit Do
            If InStr(1, strTmp, "+CPBR:") <> 0 Then
                strTmp = NextString(strTmp, ":")
                nLoc = Val(GetNoString(strTmp, ",", 0))
                strPhone = GetNoString(strTmp, ",", 1)
                strName = UnicodeCharsToString(GetNoString(strTmp + ",", ",", 3))
                
                .RecordSource = "select * from SIM where [Location]=" + _
                                 ts(nLoc) + " order by [Location]"
                .Refresh
                With .Recordset
                    If .RecordCount < 1 Then
                        .AddNew
                        ![Location] = nLoc
                        ![Phone] = strPhone
                        ![Name] = strName
                        .Update
                        .Requery
                    End If
                End With
            End If
            
            I = I + 1
        Loop
    End With
    
    DisplayBook
End Sub

Private Sub cmdAdd_Click()
    Adodc1.Recordset.AddNew
End Sub

Private Sub cmdAdjust_Click()
    AdjustNumber Adodc1, 0
End Sub

Private Sub cmdAll_Click()
    MSComm1.Output = "AT+CMGF=1;+CMGL=" + Chr(&H22) + "ALL" + Chr(&H22) + vbCr
    nModemStatus = CMGL_STATUS
End Sub

Private Sub cmdCallerID_Click()
    MSComm1.Output = "AT+CLIP=1" + vbCr
End Sub

Private Sub cmdCard_Click()
    MSComm1.Output = "AT+CPBS=" + Chr(&H22) + "SM" + Chr(&H22) + ";+CPBR=?" + vbCr
    nModemStatus = SMS_CARD_STATUS
End Sub

Private Sub cmdClear_Click()
    txtSend.Text = ""
    txtMB.Text = ""
    txtSMSResult.Text = ""
    txtReply.Text = ""
    txtTest.Text = ""
End Sub

Private Sub cmdClose_Click()
    With MSComm1
        If .PortOpen = True Then
            .PortOpen = False
            cmdOpen.Enabled = True
            cmdClose.Enabled = False
        End If
    End With
    
    nModemStatus = CLOSE_STATUS
End Sub

Private Sub cmdClsSIM_Click()
    If txtCapacity.Text = "" Then
        MsgBox "请先读取SIM卡的基本信息!", vbExclamation + vbOKOnly, "提示"
        Exit Sub
    End If
    
    If bClearSim = False Then
        bClearSim = True
        nSimNo = 1
    End If
    MSComm1.Output = "AT+CPBW=" + ts(nSimNo) + vbCr
    nModemStatus = CLEAR_SIM_STATUS
End Sub

Private Sub cmdDel_Click()
    With Adodc1.Recordset
        If .EOF Or .BOF Or .RecordCount < 1 Then Exit Sub
        MSComm1.Output = "AT+CMGD=" + ts(![Location]) + vbCr
        nModemStatus = CMGD_STATUS
    End With
End Sub

Private Sub cmdDelGroup_Click()
    Dim nRet As Integer
    With Adodc1.Recordset
        If (Not .EOF) And (Not .BOF) And (.RecordCount > 0) Then
            If IsNull(![ID]) Then Exit Sub
            nRet = MsgBox("确信删除序号为" + ts(![ID]) + "的记录吗?", vbQuestion + vbYesNo, "提示")
            If nRet = 7 Then Exit Sub
            .Delete
            .Requery
        End If
    End With
End Sub

Private Sub cmdGet_Click()
    nModemStatus = CSCA_STATUS
    MSComm1.Output = "AT+CSCS=" + Chr(&H22) + "GSM" + Chr(&H22) + ";+CSCA?" + vbCr
End Sub

Private Sub cmdGroup_Click()
    With Adodc1.Recordset
        If .RecordCount < 1 Then
            MsgBox "群发电话簿为空!", vbExclamation + vbOKOnly, "提示"
            Exit Sub
        End If
        
        If txtSend.Text = "" Then
            MsgBox "短信内容为空!", vbExclamation + vbOKOnly, "提示"
            Exit Sub
        End If
        
        If bGroup = False Then
            .MoveFirst
            bGroup = True
        End If
        
        strPDU = GetPDU("", ![Phone], txtSend.Text)
        strPDU_Len = Trim(Str((Len(strPDU) / 2 - 1)))
        
        MSComm1.Output = "AT+CMGF=0;+CMGS=" + strPDU_Len + vbCr
        'Debug.Print ">AT+CMGF=0;+CMGS=" + strPDU_Len + vbCr
        nModemStatus = SMS_SEND0_STATUS
        txtSMSResult.Text = ""
    End With
End Sub

Private Sub cmdNum_Click()
    EnlargeNumber Adodc1, 0
End Sub

Private Sub cmdOpen_Click()
    MSComm1.CommPort = Val(cmbCOM.Text)
        
    OpenAndAdjustPort MSComm1
    If Err.Number <> 0 Then
        MsgBox Error$, vbCritical + vbOKOnly
        GoTo END_MARK
    End If
    
    txtReply.Text = ""
    MSComm1.Output = "AT+CSCS=" + Chr(&H22) + "GSM" + Chr(&H22) + vbCr
    cmdOpen.Enabled = False
    cmdClose.Enabled = True
END_MARK:
End Sub

Private Sub cmdReadSIM_Click()
    If txtCapacity.Text = "" Then
        MsgBox "请先读取SIM卡的基本信息!", vbExclamation + vbOKOnly, "提示"
        Exit Sub
    End If
    
    MSComm1.Output = "AT+CSCS=" + Chr(&H22) + "UCS2" + Chr(&H22) + _
                     ";+CPBR=1," + txtCapacity.Text + vbCr
    nModemStatus = CPBR_STATUS
End Sub

Private Sub cmdSend_Click()
    If txtMB.Text = "" Then