📄 frmstatus.frm
字号:
VERSION 5.00
Begin VB.Form FrmStatus
BackColor = &H00E0E0E0&
BorderStyle = 4 'Fixed ToolWindow
Caption = "Status"
ClientHeight = 3120
ClientLeft = 45
ClientTop = 285
ClientWidth = 7320
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3120
ScaleWidth = 7320
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.FileListBox F1
Height = 285
Left = 5775
TabIndex = 15
Top = 390
Visible = 0 'False
Width = 300
End
Begin VB.CommandButton Command1
Caption = "Close"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 5985
MaskColor = &H00E0E0E0&
Style = 1 'Graphical
TabIndex = 14
Top = 2595
Width = 1215
End
Begin VB.Label Label15
BackStyle = 0 'Transparent
Caption = $"FrmStatus.frx":0000
ForeColor = &H000000FF&
Height = 420
Left = 45
TabIndex = 16
Top = 2565
Width = 5805
End
Begin VB.Line Line4
X1 = 120
X2 = 7200
Y1 = 2475
Y2 = 2475
End
Begin VB.Line Line3
BorderColor = &H00FFFFFF&
BorderWidth = 2
X1 = 120
X2 = 7185
Y1 = 2490
Y2 = 2490
End
Begin VB.Line Line2
X1 = 135
X2 = 7215
Y1 = 1530
Y2 = 1530
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
BorderWidth = 2
X1 = 135
X2 = 7200
Y1 = 1545
Y2 = 1545
End
Begin VB.Label Label14
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label14"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1620
TabIndex = 13
Top = 2415
Visible = 0 'False
Width = 690
End
Begin VB.Label Label13
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label13"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1620
TabIndex = 12
Top = 2085
Width = 690
End
Begin VB.Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label12"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1620
TabIndex = 11
Top = 1740
Width = 690
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label11"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1620
TabIndex = 10
Top = 1155
Width = 690
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label10"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1620
TabIndex = 9
Top = 810
Width = 690
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label9"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 1620
TabIndex = 8
Top = 480
Width = 585
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "Label8"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 450
Left = 1620
TabIndex = 7
Top = 75
Width = 5460
End
Begin VB.Label Label7
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackColor = &H00808080&
BackStyle = 0 'Transparent
Caption = "Total Records :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Left = 120
TabIndex = 6
Top = 1155
Width = 1335
End
Begin VB.Label Label6
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackColor = &H00808080&
BackStyle = 0 'Transparent
Caption = "Total Tables :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Left = 255
TabIndex = 5
Top = 810
Width = 1200
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackColor = &H00808080&
BackStyle = 0 'Transparent
Caption = "Last Update :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Left = 285
TabIndex = 4
Top = 2070
Width = 1170
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackColor = &H00808080&
BackStyle = 0 'Transparent
Caption = "Time Taken :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Left = 315
TabIndex = 3
Top = 2385
Visible = 0 'False
Width = 1140
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackColor = &H00808080&
BackStyle = 0 'Transparent
Caption = "Total Keyword :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Left = 105
TabIndex = 2
Top = 1710
Width = 1350
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackColor = &H00808080&
BackStyle = 0 'Transparent
Caption = "Last Update :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Left = 285
TabIndex = 1
Top = 465
Width = 1170
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackColor = &H00808080&
BackStyle = 0 'Transparent
Caption = "Database :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Left = 510
TabIndex = 0
Top = 60
Width = 945
End
End
Attribute VB_Name = "FrmStatus"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Fs As New FileSystemObject
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
On Error GoTo myer1
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
Dim db As Database
Dim rs As Recordset
Dim Str1 As String
Dim Ttable As Integer
Dim Trecord As Single
Dim i As Integer
Str1 = GetSetting("DataSearch", "Data", "Path")
'F1.FileName = Str1
If Str1 = "" Then
MsgBox "Database Path Not Found, Select a database first, Use Set Databse and select main access database from where you want to search"
Unload Me
Exit Sub
Label9.Caption = ""
Label10.Caption = ""
Label11.Caption = ""
Label12.Caption = ""
Label13.Caption = ""
Label14.Caption = ""
Else
Set db = OpenDatabase(Str1)
Ttable = db.TableDefs.Count - 7
For i = 0 To db.TableDefs.Count - 1
If db.TableDefs(i).Name <> "MSysACEs" And db.TableDefs(i).Name <> "MSysObjects" And db.TableDefs(i).Name <> "MSysQueries" And db.TableDefs(i).Name <> "MSysRelationships" And db.TableDefs(i).Name <> "MSysModules" And db.TableDefs(i).Name <> "MSysModules2" Then
Set rs = db.OpenRecordset(db.TableDefs(i).Name)
If rs.RecordCount > 0 Then
rs.MoveLast
Trecord = Trecord + rs.RecordCount
End If
End If
Next
Dim db1 As Database
Dim rs1 As Recordset
Set db1 = OpenDatabase(App.Path & "\keywords.mdb")
Set rs1 = db1.OpenRecordset("wordlist")
If rs1.RecordCount < 1 Then
MsgBox "You First create the keyword list, Follow this step to create keywords: " & vbCrLf & vbCrLf & "1. Click Set Database and specify a main Access Database from where you want to search." & vbCrLf & "2. Click Make/Update keywords and click Yes to continue" & vbCrLf & vbCrLf & "====================================================================" & vbCrLf & " Mail me for any query at sfmiraroad@hotmail.com"
Unload Me
Exit Sub
End If
rs1.MoveLast
Label8.Caption = Str1
Label9.Caption = FileDateTime(Str1)
Label10.Caption = Ttable
Label11.Caption = Trecord
Label12.Caption = rs1.RecordCount
Label13.Caption = FileDateTime(App.Path & "\keywords.mdb")
If FileDateTime(Str1) > FileDateTime(App.Path & "\keywords.mdb") Then
Label15.Visible = True
Else
Label15.Visible = False
End If
End If
Exit Sub
myer1:
If Err.Number = 3024 Then
MsgBox "Please set the path of main Access database, from Set Database option"
Else
MsgBox "Problem : " & Err.Description
End If
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -