frmextensivesearch.frm

vc++的部分比较经典的源码

                If Mid(Txt, K, 1) = " " Then StartCount = K + 1: S = K + 1: C1 = 0: Exit For
                C1 = C1 + 1
                Xx(X) = Mid(Txt, S, C1)
                
            Next
            X = X + 1
            If X >= C Then
            GoTo bottom2
            Else
            GoTo top2
            End If
bottom2:

    'declare the variable for each pocket of array
    'you can use array for it
    'if you use array then code will become smaller
    Dim S1 As String, S2 As String, S3 As String, S4 As String, S5 As String
    Dim S6 As String, S7 As String, S8 As String, S9 As String, S10 As String
    Dim S11 As String, S12 As String, S13 As String, S14 As String, S15 As String
    Dim S16 As String, S17 As String, S18 As String, S19 As String, S20 As String
    Dim SqlStr1 As String
    
    End If
    
    'third search condition
    'check the value of variable if not empty concat with previous one help of AND and Like operator
    If Option2.Value = True Then
        S1 = Xx(0): If Len(S1) > 0 Then SqlStr1 = SqlStr1 & " keyword like " & "'* " & S1 & " *'"
        S2 = Xx(1): If Len(S2) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S2 & " *'"
        S3 = Xx(2): If Len(S3) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S3 & " *'"
        S4 = Xx(3): If Len(S4) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S4 & " *'"
        S5 = Xx(4): If Len(S5) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S5 & " *'"
        S6 = Xx(5): If Len(S6) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S6 & " *'"
        S7 = Xx(6): If Len(S7) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S7 & " *'"
        S8 = Xx(7): If Len(S8) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S8 & " *'"
        S9 = Xx(8): If Len(S9) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S9 & " *'"
        S10 = Xx(9): If Len(S10) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S10 & " *'"
        S11 = Xx(10): If Len(S11) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S11 & " *'"
        S12 = Xx(11): If Len(S12) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S12 & " *'"
        S13 = Xx(12): If Len(S13) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S13 & " *'"
        S14 = Xx(13): If Len(S14) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S14 & " *'"
        S15 = Xx(14): If Len(S15) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S15 & " *'"
        S16 = Xx(15): If Len(S16) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S16 & " *'"
        S17 = Xx(16): If Len(S17) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S17 & " *'"
        S18 = Xx(17): If Len(S18) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S18 & " *'"
        S19 = Xx(18): If Len(S19) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S19 & " *'"
        S20 = Xx(19): If Len(S20) > 0 Then SqlStr1 = SqlStr1 & " and keyword like " & "'* " & S20 & " *'"
        SqlStr = "Select * from wordlist where " & SqlStr1 & " order by keyword"
        Set rs = db.OpenRecordset(SqlStr)
    
    End If
    'Forth search condition
    'check the value of variable if not empty concat with previous one help of OR and Like operator
    If Option3.Value = True Then
        S1 = Xx(0): If Len(S1) > 0 Then SqlStr1 = SqlStr1 & " keyword like " & "'* " & S1 & " *'"
        S2 = Xx(1): If Len(S2) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S2 & " *'"
        S3 = Xx(2): If Len(S3) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S3 & " *'"
        S4 = Xx(3): If Len(S4) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S4 & " *'"
        S5 = Xx(4): If Len(S5) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S5 & " *'"
        S6 = Xx(5): If Len(S6) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S6 & " *'"
        S7 = Xx(6): If Len(S7) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S7 & " *'"
        S8 = Xx(7): If Len(S8) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S8 & " *'"
        S9 = Xx(8): If Len(S9) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S9 & " *'"
        S10 = Xx(9): If Len(S10) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S10 & " *'"
        S11 = Xx(10): If Len(S11) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S11 & " *'"
        S12 = Xx(11): If Len(S12) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S12 & " *'"
        S13 = Xx(12): If Len(S13) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S13 & " *'"
        S14 = Xx(13): If Len(S14) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S14 & " *'"
        S15 = Xx(14): If Len(S15) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S15 & " *'"
        S16 = Xx(15): If Len(S16) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S16 & " *'"
        S17 = Xx(16): If Len(S17) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S17 & " *'"
        S18 = Xx(17): If Len(S18) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S18 & " *'"
        S19 = Xx(18): If Len(S19) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S19 & " *'"
        S20 = Xx(19): If Len(S20) > 0 Then SqlStr1 = SqlStr1 & " or keyword like " & "'* " & S20 & " *'"
        SqlStr = "Select * from wordlist where " & SqlStr1 & " order by keyword"
        Set rs = db.OpenRecordset(SqlStr)
    
    End If
    'display the message box for according to the search result.
    If rs.RecordCount > 0 Then
        rs.MoveLast
        Rec = rs.RecordCount
        If Rec > 2000 Then
            MsgBox "Search Critaria meets " & Rec & " Results" & vbCrLf & vbCrLf & " The maximum display of result is 2000, you should redefine your search conddition for next search."
                PB1.Value = 0
                PB1.Visible = False
                MF1.Visible = False
                Label10.Caption = ""
            Exit Sub
        End If
        If Rec > 500 And Rec <= 2000 Then
            If MsgBox("Search Critaria meets " & Rec & " Results" & vbCrLf & vbCrLf & "You can redefine your search conddition for next search, Do you want to continue", vbYesNo + vbExclamation + vbDefaultButton2) = vbNo Then
                PB1.Value = 0
                PB1.Visible = False
                MF1.Visible = False
                Label10.Caption = ""
                Exit Sub
            End If
        End If
       
        MF1.Visible = True
        'PB1.Value = 0
        PB1.Value = 15
        MF1.Visible = True
        Label11.Visible = False
        'PB1.Value = 20
        MF1.Rows = Rec + 1
        MF1.Cols = 5
        MF1.ColWidth(0) = 1000                      'display the search result
        MF1.ColWidth(1) = 5000                      'We Use MsHFlexGrid for display
        MF1.ColWidth(2) = 2000
        MF1.ColWidth(3) = 2000
        MF1.ColWidth(4) = 1000
        Dim i As Single
        MF1.Row = 0
        MF1.Col = 0
        MF1.Text = "Sr."
        
        MF1.Row = 0
        MF1.Col = 1
        MF1.Text = "Result"
        
        MF1.Row = 0
        MF1.Col = 2
        MF1.Text = "In Table"
        
        MF1.Row = 0
        MF1.Col = 3
        MF1.Text = "In Field"
        
        MF1.Row = 0
        MF1.Col = 4
        MF1.Text = "In Record"
        For i = 1 To Rec
            If (PB1.Value + 85 / Rec) < 100 Then
                PB1.Value = PB1.Value + 85 / Rec
            End If
            rs.MoveFirst
            rs.Move i - 1
            MF1.Row = i
            MF1.Col = 0
            MF1.Text = i
            
            MF1.Row = i
            MF1.Col = 1
            MF1.Text = rs(0)
            
            MF1.Row = i
            MF1.Col = 2
            MF1.Text = rs(1)
            
            MF1.Row = i
            MF1.Col = 3
            MF1.Text = rs(2)

            MF1.Row = i
            MF1.Col = 4
            MF1.Text = rs(3)
        Next
        Label10.Caption = "Found " & Rec & " Match"
    Else
        MF1.Visible = False                 'display message for no result
        Label11.Visible = True
        Label11.Caption = "Sorry No Match Found for " & Text1.Text & ", try to some other search condition"
        Label10.Caption = ""
    End If
    PB1.Value = 100
    PB1.Visible = False
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
    Command1_Click
End If
End Sub

Private Sub Form_Load()
Dim i As Integer
For i = 0 To 3
    Shape2(i).BackColor = &HE0E0E0
Next
PB1.Visible = False
Label11.Visible = False
Option1.Value = True
Check1.Value = 1
Label10.Caption = ""
End Sub

Private Sub Label1_Click(Index As Integer)
On Error Resume Next
If Index = 1 Then
    'for set path of database
    Load FrmSetDatabase
    FrmSetDatabase.Show 1
End If
If Index = 2 Then
    'for status
    Load FrmStatus
    FrmStatus.Show 1
End If
If Index = 3 Then
    'for help
    Load FrmHelp
    FrmHelp.Show
End If
If Index = 0 Then
    'creating key words
    'confirmation from user by message box
    'set the path of keyword database
    'open recordset
    'set the path of main database
    'count the nos. of table
    If MsgBox("It will delete all the previous keywords, it takes several minutes depends on system resources." & vbCrLf & vbCrLf & "Last update on " & FileDateTime(App.Path & "\keywords.mdb") & vbCrLf & vbCrLf & "Are you want to continue now.", vbInformation + vbYesNo, "Creating Keywords") = vbYes Then
        Label10.Caption = "Wait ... Creating Key Words"
        MF1.Visible = False
        PB1.Visible = True
        PB1.Value = 1
        Dim db As Database
        Dim rs As Recordset
        Set db = OpenDatabase(App.Path & "\keywords.mdb")
        Set rs = db.OpenRecordset("select * from wordlist")
        Dim db1 As Database
        Dim rs1 As Recordset
        Dim Str1 As String
        Dim i As Integer
        Dim j As Integer
        Dim K As Integer
        Dim Rec As Integer
        Dim Fec As Integer
        
        Str1 = GetSetting("DataSearch", "Data", "Path")
        If Str1 = "" Then
            MsgBox "Select a database for making keyword, Use Set Database option for selecting a main access database for searching"
            Exit Sub
        End If
        Set db1 = OpenDatabase(Str1)
        If rs.RecordCount > 0 Then
            db.Execute ("delete from wordlist")
            Set rs = db.OpenRecordset("select * from wordlist")
        End If
        Dim Inc As Double
        Inc = 99 / (db1.TableDefs.Count - 7)
        For i = 0 To db1.TableDefs.Count - 1    'loop through all the table expect the MSys table
            If db1.TableDefs(i).Name <> "MSysACEs" And db1.TableDefs(i).Name <> "MSysObjects" And db1.TableDefs(i).Name <> "MSysQueries" And db1.TableDefs(i).Name <> "MSysRelationships" And db1.TableDefs(i).Name <> "MSysModules" And db1.TableDefs(i).Name <> "MSysModules2" And db1.TableDefs(i).Name <> "MSysAccessObjects" Then
                Set rs1 = db1.OpenRecordset(db1.TableDefs(i).Name)
                    If rs1.RecordCount > 0 Then
                        rs1.MoveLast
                        Rec = rs1.RecordCount
                        Fec = rs1.Fields.Count
                            For j = 0 To Rec - 1 'loop through all records in each table
                                rs1.MoveFirst
                                rs1.Move j
                                For K = 0 To Fec - 1 'loop through all field gor each record
                                    If (PB1.Value + Inc / ((Rec - 1) * (Fec - 1))) < 100 Then 'this is for progressbar
                                        PB1.Value = PB1.Value + Inc / ((Rec - 1) * (Fec - 1))
                                    End If
                                    If rs1(K) <> vbNullString Then          'check empty data
                                        rs.AddNew                           'add new record
                                        rs(0) = rs1(K)
                                        rs(1) = db1.TableDefs(i).Name
                                        rs(2) = rs1.Fields(K).Name
                                        rs(3) = j + 1
                                        rs.Update                           'update
                                    End If
                                Next
                            Next
                        End If
                End If
            Next
    End If
    PB1.Value = 100
    PB1.Visible = False
    SaveSetting "DataSearch", "Data", "KeyDate", CStr(Now) 'save the time of update
    Label10.Caption = "Finish ... "
    If rs.RecordCount < 1 Then
    Label10.Caption = "Problem in Path ... Not a valid database"
        MsgBox "You should specify path of a valid Access Database which having at least one table, use Set Database option for specify the path of Main Database"
        Label10.Caption = ""
        Exit Sub
    End If
    MsgBox rs.RecordCount & " Key Words created successfully" 'confirmation
    Label10.Caption = ""
End If
End Sub

Private Sub label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'for top menu with some highlight effect by mouse movement
Dim i As Integer
For i = 0 To 3
    If i = Index Then
        Shape2(Index).BackColor = &HFFFFFF
        Label1(Index).ForeColor = vbBlue
        Label1(Index).FontUnderline = True
    Else
        Shape2(i).BackColor = &HE0E0E0
        Label1(i).ForeColor = vbBlack
        Label1(i).FontUnderline = False
    End If
Next
End Sub

Private Sub MF1_dblClick()
'open the Dataform
'set the table name record no.

Dim Str1 As String
Dim Str2 As String
Dim str3 As String
Str1 = MF1.TextMatrix(MF1.Row, 2)
Str2 = MF1.TextMatrix(MF1.Row, 1)
str3 = MF1.TextMatrix(MF1.Row, 4)
TableName = Str1
RecordNo = str3
If MsgBox("Are you want to open Record No. " & str3 & " of table " & Str1, vbYesNo + vbExclamation) = vbYes Then
    Load FrmDataView
    FrmDataView.Show 1
End If
End Sub

Private Sub Option2_Click()
Check1.Enabled = False
Check2.Enabled = False
End Sub
Private Sub Option3_Click()
Check1.Enabled = False
Check2.Enabled = False
End Sub
Private Sub Option1_Click()
Check1.Enabled = True
Check2.Enabled = True
End Sub