📄 程控话单查询.frm
字号:
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 240
TabIndex = 4
Top = 480
Width = 975
End
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = " 详细话单查询"
BeginProperty Font
Name = "楷体_GB2312"
Size = 21.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00404080&
Height = 615
Left = 3960
TabIndex = 18
Top = 240
Width = 3855
End
End
Attribute VB_Name = "frmHDCX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strsql As String
Dim db1 As Database
Dim kk As Integer
Private Sub cmdClose_Click()
Form15.Show
Unload Me
End Sub
Private Sub cmdFind_Click()
gdbpath = App.Path & "\"
Dim tb1 As Recordset
Dim aaa
Dim dbdxzw As Database
Dim qdfXXHD As QueryDef
Dim rsXXHD As Recordset
Dim I As Integer
Dim dbname As String
On Error GoTo ErrorHandler
If Len(Trim(txtDhhm.Text)) = 0 Then
aaa = MsgBox("请输入电话号码！", , "警告")
Exit Sub
Else
If Len(Trim(Text2.Text)) = 0 Then
aaa = MsgBox("请输入密码！", , "警告")
Exit Sub
Else
db1.Execute "drop table pwd_tmp"
db1.Execute "select * into pwd_tmp from dh_pwd where dhhm='" & txtDhhm.Text & "' and pwd='" & Text2.Text & "'"
Set tb1 = db1.OpenRecordset("pwd_tmp", 1)
If Not tb1.EOF Then
tb1.Close
Else
tb1.Close
aaa = MsgBox("密码有误，请重输！", , "警告")
Exit Sub
End If
End If
End If
cmdFind.Enabled = False
cmdClose.Enabled = False
'Command1.Enabled = False
dbname = gdbpath & "Hdk_" & Trim$(Str(Year(Date))) & Trim(Str(ComboMonth.ListIndex + 1)) & ".mdb"
strsql = "SELECT * From smldmod4hb IN " & "'" & dbname & "'" & " WHERE "
Select Case Combo1.ListIndex
Case 0
strsql = strsql + " (flag = '01' or flag = '02' or flag = '03' or flag = '04' or flag = '05' or flag = '07' or flag = '10') "
Case 1
strsql = strsql + " (flag = '08' or flag = '06' or flag = '09' or flag = '11') "
Case 2
strsql = strsql + " (flag = '04' or flag = '07') "
Case 3
strsql = strsql + " flag = '05' "
Case 4
strsql = strsql + " flag = '10' "
Case 5
strsql = strsql + " flag = '01' "
Case 6
strsql = strsql + " flag = '03' "
Case 7
strsql = strsql + " flag = '02' "
End Select
If Len(Trim(txtDhhm.Text)) > 0 Then
strsql = strsql + " and TELNAR = '" & Trim(txtDhhm.Text) & "' "
End If
If Len(Trim(Text3.Text)) > 0 Then
strsql = strsql + " and date >= '" & Trim(Text3.Text) & "' "
End If
If Len(Trim(Text4.Text)) > 0 Then
strsql = strsql + " and date <= '" & Trim(Text4.Text) & "' "
End If
Call CreateQuery1(strsql)
cmdFind.Enabled = True
cmdClose.Enabled = True
MsgBox "查询完毕"
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 3376
Resume Next
Case 3024
aaa = MsgBox("该月数据不存在！", , "警告")
cmdFind.Enabled = True
cmdClose.Enabled = True
End Select
End Sub
Private Sub ComboMonth_Click()
Dim dbname As String
Dim strsql As String
On Error GoTo ErrorHandler
Exit Sub
ErrorHandler:
End Sub
Private Sub Command1_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "1"
Case 1
Text2 = Text2 & "1"
Case 2
Text3 = Text3 & "1"
Case 3
Text4 = Text4 & "1"
End Select
End Sub
Private Sub Command10_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "3"
Case 1
Text2 = Text2 & "3"
Case 2
Text3 = Text3 & "3"
Case 3
Text4 = Text4 & "3"
End Select
End Sub
Private Sub Command11_Click()
If kk = 3 Then
kk = 0
Else
kk = kk + 1
End If
Select Case kk
Case 0
Text1 = "请输入电话号码！"
Case 1
Text1 = "请输入密码！"
Case 2
Text1 = "请输入起始时间！"
Case 3
Text1 = "请输入终止时间！"
End Select
End Sub
Private Sub Command12_Click()
Select Case kk
Case 0
txtDhhm = ""
Case 1
Text2 = ""
Case 2
Text3 = ""
Case 3
Text4 = ""
End Select
End Sub
Private Sub Command2_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "0"
Case 1
Text2 = Text2 & "0"
Case 2
Text3 = Text3 & "0"
Case 3
Text4 = Text4 & "0"
End Select
End Sub
Private Sub Command3_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "8"
Case 1
Text2 = Text2 & "8"
Case 2
Text3 = Text3 & "8"
Case 3
Text4 = Text4 & "8"
End Select
End Sub
Private Sub Command4_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "7"
Case 1
Text2 = Text2 & "7"
Case 2
Text3 = Text3 & "7"
Case 3
Text4 = Text4 & "7"
End Select
End Sub
Private Sub Command5_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "9"
Case 1
Text2 = Text2 & "9"
Case 2
Text3 = Text3 & "9"
Case 3
Text4 = Text4 & "9"
End Select
End Sub
Private Sub Command6_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "5"
Case 1
Text2 = Text2 & "5"
Case 2
Text3 = Text3 & "5"
Case 3
Text4 = Text4 & "5"
End Select
End Sub
Private Sub Command7_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "4"
Case 1
Text2 = Text2 & "4"
Case 2
Text3 = Text3 & "4"
Case 3
Text4 = Text4 & "4"
End Select
End Sub
Private Sub Command8_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "6"
Case 1
Text2 = Text2 & "6"
Case 2
Text3 = Text3 & "6"
Case 3
Text4 = Text4 & "6"
End Select
End Sub
Private Sub Command9_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "2"
Case 1
Text2 = Text2 & "2"
Case 2
Text3 = Text3 & "2"
Case 3
Text4 = Text4 & "2"
End Select
End Sub
Private Sub Form_Load()
gdbpath = App.Path & "\"
Dim dbname As String
Dim strsql As String
Dim dbdxzw As Database
On Error GoTo ErrorHandler
Combo1.AddItem "详话话单"
Combo1.AddItem "市话话单"
Combo1.AddItem "农话话单"
Combo1.AddItem "网话话单"
Combo1.AddItem "信息话单"
Combo1.AddItem "国内话单"
Combo1.AddItem "国际话单"
Combo1.AddItem "港澳话单"
Combo1.ListIndex = 0
ComboMonth.AddItem "一月"
ComboMonth.AddItem "二月"
ComboMonth.AddItem "三月"
ComboMonth.AddItem "四月"
ComboMonth.AddItem "五月"
ComboMonth.AddItem "六月"
ComboMonth.AddItem "七月"
ComboMonth.AddItem "八月"
ComboMonth.AddItem "九月"
ComboMonth.AddItem "十月"
ComboMonth.AddItem "十一月"
ComboMonth.AddItem "十二月"
ComboMonth.ListIndex = Month(Date) - 1
kk = 0
Text1 = "请输入电话号码！"
Set db1 = DBEngine.Workspaces(0).OpenDatabase(gdbpath & "zj.mdb")
Exit Sub
ErrorHandler:
End Sub
Sub CreateQuery(strsql As String)
Dim dbdxzw As Database
Dim qdfXXHD As QueryDef
Dim rsXXHD As Recordset
Dim I As Integer
Set dbdxzw = DBEngine.Workspaces(0).OpenDatabase(gdbpath & "zj.mdb")
For I = 0 To dbdxzw.QueryDefs.Count - 1
If dbdxzw.QueryDefs(I).Name = "qdfXXHD" Then
dbdxzw.QueryDefs.Delete ("qdfXXHD")
Exit For
End If
Next I
Set qdfXXHD = dbdxzw.CreateQueryDef("qdfXXHD", strsql)
Set rsXXHD = qdfXXHD.OpenRecordset
Data1.DatabaseName = gdbpath & "zj.mdb"
Set Data1.Recordset = rsXXHD
Data1.Refresh
End Sub
Sub CreateQuery1(strsql As String)
gdbpath = App.Path & "\"
Dim dbdxzw As Database
Dim qdfXXHD As QueryDef
Dim rsXXHD As Recordset
Dim I As Integer
Dim fd1 As Field
Set dbdxzw = DBEngine.Workspaces(0).OpenDatabase(gdbpath & "zj.mdb")
For I = 0 To dbdxzw.QueryDefs.Count - 1
If dbdxzw.QueryDefs(I).Name = "qdfXXHD" Then
dbdxzw.QueryDefs.Delete ("qdfXXHD")
Exit For
End If
Next I
Set qdfXXHD = dbdxzw.CreateQueryDef("qdfXXHD", strsql)
Set rsXXHD = qdfXXHD.OpenRecordset
dbdxzw.Execute "UPDATE qdfXXHD SET areacode = ' ' WHERE flag>'03'"
dbdxzw.Execute "UPDATE qdfXXHD SET stime = left(stime,6)"
'dbDxzw.Execute "UPDATE qdfXXHD SET endtime = format(cdate(left(date,4)+'-'+mid(date,5,2)+'-'+right(date,2)+' '+left(stime,2)+':'+mid(stime,3,2)+':'+right(stime,2))+etime/24/3600 ,'hhmmss')"
Data1.DatabaseName = gdbpath & "zj.mdb"
Set Data1.Recordset = rsXXHD
Data1.Refresh
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdFind.SetFocus
End If
End Sub
Private Sub Timer1_Timer()
If Label2.Left + Label2.Width < 0 Then
Label2.Left = frmHDCX.ScaleWidth
Else
Label2.Left = Label2.Left - 500
End If
End Sub
Private Sub txtDhhm_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdFind.SetFocus
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdFind.SetFocus
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdFind.SetFocus
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdFind.SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -