frmmain.frm

手机短心控制接收发射程序,通过串口与手机连接,

'Mscomm1(4)为读已发短信
'Mscomm1(5)为读未发短信
'Mscomm1(6)为读第X短信
'Mscomm1(7)删除短信
'Mscomm1(8)读电话簿
'Mscomm1(9)删除电话簿
'Mscomm1(10)更改电话簿
'Mscomm1(11)新建电话簿
'Mscomm1.tag=12 保存短信
'Mscomm1.tag=13 发送短信

'Mscomm1.tag=14 手机状态＝品牌
'Mscomm1.tag=15 手机状态＝型号
'Mscomm1.tag=16 手机状态＝序列号
'Mscomm1.tag=17 手机状态＝时间
'Mscomm1.tag=18 手机状态＝电量
'Mscomm1.tag=19 手机状态＝信号强度

'Mscomm1.tag=20 远程控制设置
'Mscomm1.tag=21 远程控制控制

Dim strSms(4) As String             '从手机中读出人内容并已折分,strSms(0):存时间或序号，1存号码，2存内容
Private Const comNum = 22         '串口控件的总数目
Private Const phoneNum = 500
Private txtSmsBuffer() As String    '
Dim comStatue As String             '与MsComm1.Tag值对应
Dim popMenuChoose As String         '=smsMenu;=phoneBookMenu
Dim smsDelB As Boolean
Dim ReadSmsX As String
Dim ListViewSel(6) As String


Private Sub DBGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
    Dim strSearch As String
    Dim kValue As String
    If KeyCode >= Asc("0") And KeyCode <= Asc("Z") Then
        kValue = UCase(Chr(KeyCode))
        strSearch = "select * from phonebook where mem like'" & kValue & "*'"
        frmMain.Data1.RecordSource = strSearch
        frmMain.Data1.Refresh
    End If
End Sub

Private Sub DBGrid2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        frmMain.PopupMenu phoneBookD
    End If
End Sub

Private Sub Form_Load()

Dim txtTmp As String
On Error GoTo Err1
    frmInit                             '初始化程序代码
    Pm.Visible = False                  '弹出菜单不可见
    phoneBookP.Visible = False
    phoneBookD.Visible = False
    Me.Pmenu.Item(5).Enabled = False    '了菜单[显示时间]菜单无效,目前无法读取发送短信的时间
    Me.DBGrid1.Visible = False
    Me.ListView1.Visible = True
    'txtTmp = Dir(App.Path & "\Setup.dat")
    'If txtTmp = "Setup.dat" Then
    '    Open App.Path & "\Setup.dat" For Binary As #1
    '        Get #1, 1, comPId
    '    Close #1
    'End If
    comPId = GetSetting(App.EXEName, "设置", "串口", 1)
    
    Data1.DatabaseName = App.Path & "\mytel97.MDB"
    'Data1.RecordSource = "select * from phonebook "
    Data2.DatabaseName = App.Path & "\mytel97.MDB"
    Me.MSComm1.CommPort = comPId

    'Data2.RecordSource = "select * from readsms "
    Me.DBGrid1.Visible = False
    Me.DBGrid2.Visible = False
    comStatue = "commInit"
    Call rs232(comStatue, 0)            '手机初始化
    App.HelpFile = App.Path & "\help.chm"
    App.HelpFile = App.Path & "\sms.chm"

    Exit Sub
Err1:
    MsgBox "错误:" & vbCr & Err.Description, 16, "提示"
End Sub

Private Sub Form_Resize()
    Me.DBGrid1.Top = Me.StatusBar1.Height + 500
    Me.DBGrid1.Left = 2760
    Me.DBGrid1.Height = Me.Height - Me.Toolbar1.Height - Me.StatusBar1.Height - 800
    Me.DBGrid1.Width = Me.Width - 2880
    Me.DBGrid2.Top = Me.StatusBar1.Height + 500
    Me.DBGrid2.Left = 2760
    Me.DBGrid2.Height = Me.Height - Me.Toolbar1.Height - Me.StatusBar1.Height - 800
    Me.DBGrid2.Width = Me.Width - 2880
    Me.TreeView1.Top = Me.StatusBar1.Height + 500
    Me.TreeView1.Height = Me.Height - Me.Toolbar1.Height - Me.StatusBar1.Height - 800
    
    Me.ListView1.Top = Me.StatusBar1.Height + 500
    Me.ListView1.Left = 2760
    Me.ListView1.Height = Me.Height - Me.Toolbar1.Height - Me.StatusBar1.Height - 800
    Me.ListView1.Width = Me.Width - 2880
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
    Unload frmPhoneInfo
    Unload frmCtr
    Unload frmSent
    Unload frmUseSms
    Unload frmTelClassify
    Unload frmSys
    Unload frmSearchTel
    Unload frmPhoneBook
    Unload frmSentInfo
    Unload frmReg
End Sub

Private Sub Hlp_Click(Index As Integer)
On Error Resume Next
Dim RetVal
Select Case Index
    Case 1
    'Shell "hh.exe abc.chm", vbNormalFocus
       'Shell App.Path & "\sms.chm", vbNormalFocus
       SendKeys "{F1}"
    Case 3
        SaveSetting App.EXEName, "Options", "在启动时显示提示", 1
        frmTip.Show 1
    Case 5
        frmReg.Show 1
    Case 7
        frmAbout.Show 1
End Select
End Sub

'LIstView排序
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    If ColumnHeader.Index - 1 = ListView1.SortKey Then
        ListView1.SortOrder = 1 - ListView1.SortOrder
    Else
        ListView1.SortOrder = lvwAscending
        Me.ListView1.SortKey = ColumnHeader.Index - 1
    End If
    Me.ListView1.Sorted = True
End Sub

'ListView选择,把当前行的值送给变量
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    ListViewSel(0) = Item.SubItems(4)       '短信编号
    ListViewSel(2) = Item.SubItems(3)       '短信内容
    ListViewSel(1) = Item.Index             'ListView选择行序号
    ListViewSel(3) = Item.SubItems(1)
    ListViewSel(4) = Item.SubItems(2)
    ListViewSel(5) = Item.Text
End Sub

'ListView1中的子菜单弹出判断
Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        Select Case popMenuChoose
            Case "phoneBookMenuP"
                frmMain.PopupMenu phoneBookP            '弹出短信菜单
            Case "smsMenu"
                frmMain.PopupMenu Pm                    '弹出电话簿菜单
            'Case "phoneBookMenuD"
            '    frmMain.PopupMenu phoneBookD
        End Select
    End If
End Sub

'DbGrid中的子菜单弹出判断
Private Sub DBGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        frmMain.PopupMenu phoneBookD
    End If
End Sub

'串行通信接收
Private Sub MSComm1_OnComm()
On Error Resume Next
    Dim i As Integer
    Dim strTmp As String
    txtSmsBuffer(Val(MSComm1.Tag)) = txtSmsBuffer(Val(MSComm1.Tag)) & MSComm1.Input
    'Text1.Text = txtSmsBuffer(Val(MSComm1.Tag))
    'Exit Sub
    If Val(MSComm1.Tag) < 14 Then Me.StatusBar1.Panels(3).Text = txtSmsBuffer(Val(MSComm1.Tag))

    Select Case MSComm1.Tag
        Case "0"
            i = InStr(1, txtSmsBuffer(Val(MSComm1.Tag)), "OK")
            Me.StatusBar1.Panels(2).Text = IIf(i >= 1, "检测到调制解调器", "连接失败")
        Case "1"
            'Call listViewV(Val(MSComm1.Tag), "+CMGL:", "ReadAll", "短信")
        Case "2"
            Call listViewV(Val(MSComm1.Tag), "+CMGL:", "ReCRead", "已读短信")
        Case "3"
            Call listViewV(Val(MSComm1.Tag), "+CMGL:", "ReCUnRead", "未读短信")
        Case "4"
            Call listViewV(Val(MSComm1.Tag), "+CMGL:", "StoSent", "已发短信")
        Case "5"
            Call listViewV(Val(MSComm1.Tag), "+CMGL:", "StoUnSent", "未发短信")
        Case "6"
            Call listViewV(Val(MSComm1.Tag), "+CMGR:", "ReadX", "第X短信", ReadSmsX)
        Case "7"
            i = InStr(1, txtSmsBuffer(Val(MSComm1.Tag)), Chr(13))
            If i < 1 Then Exit Sub
            If InStr(i + 1, txtSmsBuffer(Val(MSComm1.Tag)), Chr(13)) < 1 Then Exit Sub
            i = InStr(1, txtSmsBuffer(Val(MSComm1.Tag)), "OK")
            If i >= 1 Then
                'MsgBox "所选择短信已成功从手机中删除!", vbOKOnly + vbInformation, "短信删除"
            Else
                smsDelB = True
                MsgBox "不能删除!未选择中或手机中短信已加锁.", vbOKOnly + vbCritical, "短信删除"
            End If
        Case "8"
            Call listViewVpb(Val(MSComm1.Tag), "+CPBR:")    '所有电话簿
        Case "9", "10", "11"
            Select Case MSComm1.Tag
                Case "9"
                    strTmp = "所选择电话号码已成功从手机中删除!"
                Case "10"
                    strTmp = "所选择电话号码已编辑成功!"
                Case "11"
                    strTmp = "新电话号码已成功加入手机中!"
            End Select
            i = InStr(1, txtSmsBuffer(Val(MSComm1.Tag)), Chr(13))
            If i < 1 Then Exit Sub
            If InStr(i + 1, txtSmsBuffer(Val(MSComm1.Tag)), Chr(13)) < 1 Then Exit Sub
            i = InStr(1, txtSmsBuffer(Val(MSComm1.Tag)), "OK")
            If i >= 1 Then
                MsgBox strTmp, vbOKOnly + vbInformation, "提示"
            Else
                MsgBox "不能进行操作!或手机中不存或未选择.", vbOKOnly + vbCritical, "提示"
            End If
        Case "12"         '返回保存短信至手机状态
            strTmp = checkSmsSave(txtSmsBuffer(Val(MSComm1.Tag)))
            frmSentInfo.labRsStatu.Caption = strTmp
        Case "13"         '返回发送存于手机的短信
            frmSentInfo.labRsStatu.Caption = checkSmsSent(txtSmsBuffer(Val(MSComm1.Tag)))
        Case "14", "15", "16", "17", "18", "19"
            Call mobileInfo(Val(MSComm1.Tag) - 14, txtSmsBuffer(Val(MSComm1.Tag)))
        Case 21
            Call plcCtr(txtSmsBuffer(Val(MSComm1.Tag)))
    End Select
    'i = InStr(1, txtSmsBuffer(Val(MSComm1.Tag), "ERROR"))
    'If i > 0 Then Me.StatusBar1.Panels(3).Text = "手机连接错误!"
    PauseWait (50)
    'Sleep 100
End Sub

'检查短信保存状态
Private Function checkSmsSave(ATcmgw As String) As String
    Dim i As Integer
    Dim j As Integer
    Dim txtTmp As String
    i = InStr(1, ATcmgw, "+CMGW:")
    If i < 1 Then Exit Function
    j = InStr(i + 1, ATcmgw, "OK")
    If j < 1 Then Exit Function
    txtTmp = Trim(Mid(ATcmgw, i + 6, j - i - 6 - 4))
    frmSentInfo.smsSaveNo = txtTmp              '将保存于手机上的位置送于frmSentInfo.smsSaveNo，发便发送
    checkSmsSave = "已将短信存于手机:" & txtTmp & "位置上!"
End Function

'检查短信发送状态
Private Function checkSmsSent(ATcmgw As String) As String
    Dim j As Integer
    j = InStr(1, ATcmgw, "OK")
    If j < 1 Then
        checkSmsSent = "短信正在发送中......"
        Exit Function
    End If
        checkSmsSent = "短信已发送完成![OK]"
        Unload frmSentInfo
End Function

'显示手机中的电话簿
Private Sub listViewVpb(Index As Integer, strAT As String)
'On Error Resume Next
    Dim itmX As ListItem
    Dim strTmp As String
    Dim sign1 As Integer
    Dim sign2 As Integer
    Dim sign3 As Integer
    Dim i As Integer
    Dim j As Integer
    Do
    sign1 = InStr(1, txtSmsBuffer(Index), strAT)
    If sign1 < 1 Then                               '判断手机中短信内容为空否
        Exit Sub
    End If
    
    sign2 = InStr(sign1 + 1, txtSmsBuffer(Index), ",")
    
    If sign2 < 1 Then Exit Sub
    strSms(0) = Mid(txtSmsBuffer(Index), sign1 + 6, sign2 - sign1 - 6)     '取序号
    
    sign1 = InStr(sign2 + 1, txtSmsBuffer(Index), ",")
    If sign1 < 1 Then Exit Sub
    strTmp = Mid(txtSmsBuffer(Index), sign2 + 1, sign1 - sign2 - 1)         '取号码
    
    sign2 = InStr(sign1 + 1, txtSmsBuffer(Index), ",")
    If sign2 < 1 Then Exit Sub
    strSms(2) = Mid(txtSmsBuffer(Index), sign1 + 1, sign2 - sign1 - 1)      '取标识
    
    sign1 = InStr(sign2 + 1, txtSmsBuffer(Index), Chr(13))
    If sign1 < 1 Then Exit Sub
    strSms(3) = Mid(txtSmsBuffer(Index), sign2 + 1, sign1 - sign2 - 1)      '取姓名
    txtSmsBuffer(Index) = Right(txtSmsBuffer(Index), Len(txtSmsBuffer(Index)) - sign1 + 5) '去掉已处理的内容
    
    sign1 = InStr(1, strTmp, Chr(34))
    sign2 = InStr(sign1 + 1, strTmp, Chr(34))
    strSms(1) = Mid(strTmp, sign1 + 1, sign2 - sign1 - 1)                   '取精码手机号码
    
'当进行读第X条时，把时间读出后，填入ListView对应的行中
        Set itmX = ListView1.ListItems.Add()
        itmX.Text = strSms(0)
        itmX.SubItems(1) = chrConvert(strSms(3))
        itmX.SubItems(2) = strSms(1)
        itmX.SubItems(3) = strSms(2)
'判断手机中短信内容结束否
    i = InStr(1, txtSmsBuffer(Index), "OK")
    If i > 1 Then
        'MsgBox "电话簿已接收完!", vbOKOnly + vbInformation, "提示"
        Me.StatusBar1.Panels(3).Text = "电话簿已接收完!"
    End If
    Loop
End Sub

'弹出菜单操作
Private Sub pBook_Click(Index As Integer)
On Error Resume Next
Dim i As Integer
Dim rB As Boolean
    Me.StatusBar1.Panels(3).Text = ""
    Select Case Index
        Case 3
            Load frmPhoneBook
            frmPhoneBook.Caption = "新建联系人"
            frmPhoneBook.labNO = ListViewSel(5)
            frmPhoneBook.txtTel = ListViewSel(4)
            frmPhoneBook.txtName = ListViewSel(3)
            frmPhoneBook.Show 1
        Case 4