frmdial.frm

监控类的开发

Private Sub ComboCard2_Click()
  If Trim(comboCard2.Text) = "" Or comboCard2.Text = "-" Then
    chkCard2.Value = 0
  Else
    If Trim(comboCard1.Text) <> "" Then
      chkCard2.Value = 1
    End If
  End If
End Sub

Private Sub comboCard2_GotFocus()
  nFocusNo = 3
End Sub

Private Sub comboAccount2_GotFocus()
  nFocusNo = 4
End Sub

Private Sub DG_CallIn_Click()
    On Error Resume Next
    
    With AdodcDial.Recordset
        If .RecordCount < 1 Then Exit Sub
        If Trim(![Phone]) <> "" And chkPhone.Value = 1 Then
            txtPhone.Text = Trim(![Phone])
        End If
    End With
End Sub

Private Sub DG_CallIn_GotFocus()
  nFocusNo = 6
End Sub

Private Sub DG_CallIn_HeadClick(ByVal ColIndex As Integer)
  Dim nID As Integer
  On Error Resume Next
    
  With AdodcDial
    If .Recordset.RecordCount < 1 Then Exit Sub
    nID = .Recordset![ID]
    
    If ColIndex = 3 Or ColIndex = 4 Then  'Phone + Name -> Date+Time
      .RecordSource = "select * from CallIn order by [" + _
        .Recordset.Fields(ColIndex).Name + "],[Date],[Time]"
    Else
      .RecordSource = "select * from CallIn order by [" + _
        .Recordset.Fields(ColIndex).Name + "]"
    End If
    .CommandType = adCmdUnknown
    .Refresh
    
    If ColIndex = 0 Then Exit Sub
    With .Recordset
      Do While ![ID] <> nID And Not .EOF
        .MoveNext
      Loop
    End With
  End With
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
    'this procedure receives the callbacks from the System Tray icon.
    Dim Result As Long
    Dim msg As Long
    'the value of X will vary depending upon the scalemode setting
    If Me.ScaleMode = vbPixels Then
        msg = x
    Else
        msg = x / Screen.TwipsPerPixelX
    End If
    
    Select Case msg
        Case WM_LBUTTONUP        '514 restore form window
            If Me.WindowState = vbNormal Then
                Me.WindowState = vbMinimized
                Me.Hide
            Else
                Me.WindowState = vbNormal
                Result = SetForegroundWindow(Me.hWnd)
                Me.Show
            End If
        Case WM_RBUTTONUP        '517 display popup menu
            Result = SetForegroundWindow(Me.hWnd)
            Me.PopupMenu Me.mPopupSys
    End Select
End Sub

Private Sub Form_Resize()
    'this is necessary to assure that the minimized window is hidden
    If Me.WindowState = vbMinimized Then Me.Hide
End Sub

Private Sub lblOrderID_Click()
  If nGridShow = SHOW_PHONEBOOK Then
    AdjustNumber AdodcDial, 0
  Else
    AdjustNumber AdodcDial, 1
  End If
End Sub

Private Sub mPopExit_Click()
  'called when user clicks the popup menu Exit command
  Unload Me
End Sub

Private Sub mPopMiniTool_Click()
  On Error Resume Next
  ShowReceive
  frmReceive.lblTime.ForeColor = vbBlack
End Sub

Private Sub mPopSound_Click()
  If nSound = 1 Then
    nSound = 0
    StatusBar1.Panels(5).Text = "N"
    mPopSound.Checked = False
  Else
    nSound = 1
    StatusBar1.Panels(5).Text = "S"
    mPopSound.Checked = True
  End If
  
  SaveSetting App.Title, "Value", "Sound", Str(nSound)
End Sub

Private Sub t_Dial_Test_Timer()
    'only for Dial or Test
    Dim strTmp As String
    On Error Resume Next
    
    strTmp = "Dialing, please wait ... "
    If nStatus = STATUS_DIAL Then
        If StatusBar1.Panels(1).Text = strTmp Then
            StatusBar1.Panels(1).Text = strStatusBar
            shpSignal.FillColor = vbBlack
        Else
            StatusBar1.Panels(1).Text = strTmp
            shpSignal.FillColor = vbGreen
        End If
    End If
    
    If nStatus = STATUS_TEST Then
        nTestNo = nTestNo + 1
        If nTestNo <= PORT_NUM Then
            SetPortNoAndTest nTestNo
        Else
            CloseMsComm MSComm1, 50
            StatusBar1.Panels(1).Text = "Test Error!"
            t_Dial_Test.Enabled = False
            cmdDial.Enabled = False
            nStatus = STATUS_IDLE
            MsgBox "There is no Modem or the Modem is powered off!", _
                    vbExclamation + vbOKOnly, "Test Error"
            ChangeIcon ICON_OFF
        End If
    End If
End Sub

Private Sub DG_PhoneBook_Click()
    On Error Resume Next
    
    With AdodcDial.Recordset
        If .RecordCount < 1 Then Exit Sub
        If IsNull(![Phone]) Then Exit Sub
      
        If chkPhone.Value = 1 Then
            txtPhone.Text = Trim(![Phone])
            If IsNull(![Area]) Then Exit Sub
            txtPhone.Text = Trim(![Area]) + "-" + txtPhone.Text
        End If
    End With
End Sub

Private Sub DG_PhoneBook_GotFocus()
 nFocusNo = 5
End Sub

Private Sub DG_PhoneBook_HeadClick(ByVal ColIndex As Integer)
  Dim nID As Integer
  On Error Resume Next
    
  With AdodcDial
    If .Recordset.RecordCount < 1 Then Exit Sub
    nID = .Recordset![ID]
    .RecordSource = "select * from PhoneBook order by [" + _
      .Recordset.Fields(ColIndex).Name + "]"
    .CommandType = adCmdUnknown
    .Refresh
    
    If ColIndex = 0 Then Exit Sub
    With .Recordset
      Do While ![ID] <> nID And Not .EOF
        .MoveNext
      Loop
    End With
  End With
End Sub

Private Sub Form_Load()
  On Error Resume Next
  
  Initialize
  App.Title = "Dialer"

    With AdodcDial
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataPath + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select * from PhoneBook order by [ID]"
        .Refresh
        With .Recordset
            If .RecordCount > 0 Then
                .MoveFirst
            
                If Trim(![Phone]) <> "" Then
                    txtPhone.Text = Trim(![Phone])
                    chkPhone.Value = 1
                    If Trim(![Area]) <> "" Then
                        txtPhone.Text = Trim(![Area]) + "-" + txtPhone.Text
                    End If
                End If
            End If
        End With
    End With

  nTestNo = Val(GetSetting(App.Title, "Value", "Port", ""))
  If nTestNo > 0 Then
    MSComm1.CommPort = nTestNo
  End If
  
  txtPassword1.Text = GetSetting(App.Title, "Value", "Pwd1", "")
  txtPassword2.Text = GetSetting(App.Title, "Value", "Pwd2", "")
  
  strStartTime = Format(Time, "H:MM:SS")
  strRingTime = "23:59:59"
  shpSignal.FillColor = vbBlack
  
  With nID
    .cbSize = Len(nID)
    .hWnd = Me.hWnd
    .uId = vbNull
    .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    .uCallBackMessage = WM_MOUSEMOVE
    .hIcon = Me.Icon
    .szTip = "Dialer" & vbNullChar
  End With
  Shell_NotifyIcon NIM_ADD, nID
  
  nSound = Val(GetSetting(App.Title, "Value", "Sound", ""))
  If nSound = 1 Then
    StatusBar1.Panels(5).Text = "S"
    mPopSound.Checked = True
  Else
    StatusBar1.Panels(5).Text = "N"
    mPopSound.Checked = False
  End If
  
  Me.Caption = "Dialer -- Phone Book"
  StatusBar1.Panels(3).Text = Format(Date, "dddd")
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Dim strTmp As String
  Dim strDate As String
  On Error Resume Next

  CloseMsComm MSComm1, 50
  
  tComm.Enabled = False
  t_Dial_Test.Enabled = False
  
  Unload frmReceive
  
  'this removes the icon from the system tray
  Shell_NotifyIcon NIM_DELETE, nID
End Sub

Private Sub lblEnlargeID_Click()
  If nGridShow = SHOW_PHONEBOOK Then
    EnlargeNumber AdodcDial, 0
  Else
    EnlargeNumber AdodcDial, 1
  End If
End Sub

Private Sub MSComm1_OnComm()
    Dim vInBuffer As Variant
    Dim strRecChars As String
    Dim strPath As String
    Dim nLoc As Integer
    Dim strTmp As String
    On Error Resume Next
    
    If MSComm1.CommEvent = comEvReceive Then
        If nStatus = STATUS_NOW Then Exit Sub
        
        If bStartComm = False Then strInBuffers = ""
        vInBuffer = MSComm1.Input
        strRecChars = HexCharsToString(VariantToHexChars(vInBuffer))
        strInBuffers = strInBuffers + strRecChars
        
        If nStatus = STATUS_IN And InStr(1, strInBuffers, "ATS", vbTextCompare) = 0 _
                               And InStr(1, strInBuffers, "OK", vbTextCompare) = 0 Then
            If InStr(1, strInBuffers, "RING", vbTextCompare) <> 0 Then
                If bStartComm = False Then
                    nRingTimes = 0
                    strPhoneNo = ""
                    strStartCallTime = Format(Time, "HH:MM:SS")
                End If
            
                StatusBar1.Panels(1).Text = strInBuffers
                
                strRingTime = Format(Time, "H:MM:SS")
                nRingTimes = FeatureCount(UCase(strInBuffers), "RING")
                
                strPath = App.Path + "\Ring.wav"
                If nSound = 1 And CheckFile(strPath) Then
                    PlaySound strPath, 0, SND_ASYNC
                End If
            
                'Maybe strPhoneNo is error ,but at last, is correct!
                strTmp = OnlyOneSegChar(strInBuffers, vbCrLf, True)
                nLoc = InStr(1, strInBuffers, "NMBR", vbTextCompare)
                If nLoc <> 0 Then
                    strTmp = Mid(strInBuffers, nLoc)
                    strTmp = GetNoString(strTmp, vbCrLf, 0)
                    strTmp = GetNoString(strTmp + "=", "=", 1)
                    strPhoneNo = Trim(strTmp)
                End If
                
                ShowReceive
                frmReceive.lblTime.ForeColor = vbRed
            End If
        End If
        
        If nStatus = STATUS_TEST Then
            nStatus = STATUS_IDLE
            t_Dial_Test.Enabled = False
            SaveSetting App.Title, "Value", "Port", Str(nTestNo)
            shpSignal.FillColor = vbGreen
            StatusBar1.Panels(1).Text = "Test OK!"
            CloseMsComm MSComm1, 50
            
            MsgBox "The valid port is COM" + Trim(Str(nTestNo)) + "!", _
                    vbInformation + vbOKOnly, "Test OK"
            StatusBar1.Panels(1).Text = "Idle"
            If cmdDial.Enabled = False Then cmdDial.Enabled = True
            shpSignal.FillColor = vbBlack
            ChangeIcon ICON_OFF
        End If
        
        If bStartComm = False Then
            bStartComm = True
        End If
        
        If bStartComm = True Then
            tComm.Enabled = False
            tComm.Enabled = True
        End If
      
    End If
End Sub

Private Sub tComm_Timer()
    Dim strHead As String
    Dim strTail As String
    Dim strName As String
    On Error Resume Next
    
    tComm.Enabled = False
    bStartComm = False
    
    Select Case nStatus
        Case STATUS_IN
            If InStr(1, strInBuffers, "ERROR", vbTextCompare) <> 0 Then
                MsgBox "Caller ID function is not supported by the modem!", _
                        vbCritical + vbOKOnly, "Dialer"
                CloseMsComm MSComm1, 50
                cmdIn.Enabled = False
                Exit Sub
            End If
          
            If InStr(1, strInBuffers, "ATS", vbTextCompare) <> 0 Or _
                InStr(1, strInBuffers, "OK", vbTextCompare) <> 0 Then
                strInBuffers = ""
               
                nGridShow = SHOW_CALLIN
                ShowGrid
        
                shpSignal.FillColor = vbGreen
                StatusBar1.Panels(1) = "Wait for calling in..."
                ChangeIcon ICON_ON
               
                tComm.Interval = RING_INTERVAL
                Exit Sub
            End If
        
            nRecTimes = nRecTimes + 1
            ShowReceive
            frmReceive.lblTime.ForeColor = vbBlue
            
            nGridShow = SHOW_CALLIN
            ShowGrid
            'AdjustNumber AdodcDial, 0
            
            strName = FindLastName(strPhoneNo)
            With AdodcDial.Recordset
                .AddNew
                
                ![ID] = .RecordCount
                ![Date] = Format(Date, "yyyy-mm-dd")
                ![Time] = strStartCallTime
                ![Phone] = IIf(strPhoneNo <> "", strPhoneNo, "0")
                ![Name] = IIf(strName <> "", strName, "Anonymous")
                ![Rings] = nRingTimes
                
                .Update
                .Requery
                .MoveLast
            End With
        
            cmdIn_Click     'Reset system for better performance.
      
        Case STATUS_DIAL
            If InStr(strInBuffers, "#") > 0 Then
                strHead = GetLeftString(strInBuffers, "#")
                strTail = NextString(strInBuffers, "#")
                strTail = NextString(strTail, "#")
                strStatusBar = strHead + "#,******#" + strTail
            Else
                strStatusBar = strInBuffers
            End If
          
            If InStr(1, strInBuffers, "AT", vbTextCompare) = 0 Then
                StatusBar1.Panels(1).Text = strInBuffers
                t_Dial_Test.Enabled = False
            End If
         
            If InStr(1, strInBuffers, "OK", vbTextCompare) <> 0 Then
                shpSignal.FillColor = vbGreen
                ChangeIcon ICON_ON
            End If
    End Select
End Sub

Private Sub txtPhone_Change()
    Dim txtTmp As String
    On Error Resume Next
    txtTmp = Trim(txtPhone.Text)
    If comboCard1.Text <> "" And comboCard2.Text <> "" And _
        comboCard1.Text <> "-" And comboCard2.Text <> "-" Then
        '201 etc.
        chkCard1.Value = 1
        If Mid(txtTmp, 1, 1) = "0" Then
            chkCard2.Value = 1
        Else
            chkCard2.Value = 0
        End If
    End If
    If comboCard1.Text <> "" And comboCard1.Text <> "-" And _
         (comboAccount1.Text = "" Or comboAccount1.Text = "-") Then
        'for home use
        chkCard2.Value = 0
        If Mid(txtTmp, 1, 1) = "0" Then
            chkCard1.Value = 1
        Else
            chkCard1.Value = 0
        End If
    End If
End Sub