?? frmdial.frm
字號(hào):
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
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -