frmextensivesearch.frm

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

      TabIndex        =   7
      Top             =   705
      Width           =   2790
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "S"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   26.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C000C0&
      Height          =   615
      Left            =   6390
      TabIndex        =   6
      Top             =   30
      Width           =   285
   End
   Begin VB.Line Line3 
      BorderColor     =   &H00FF00FF&
      X1              =   5265
      X2              =   7545
      Y1              =   75
      Y2              =   75
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00C000C0&
      BorderWidth     =   2
      X1              =   5265
      X2              =   7530
      Y1              =   150
      Y2              =   150
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00800080&
      BorderWidth     =   3
      X1              =   5250
      X2              =   7515
      Y1              =   225
      Y2              =   225
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "data base    earch"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   18
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   420
      Left            =   4890
      TabIndex        =   5
      Top             =   180
      Width           =   2595
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Extensive "
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   18
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800080&
      Height          =   420
      Left            =   3780
      TabIndex        =   4
      Top             =   -75
      Width           =   1545
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Help"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   3
      Left            =   11085
      TabIndex        =   3
      Top             =   75
      Width           =   420
   End
   Begin VB.Shape Shape2 
      BackColor       =   &H0080FFFF&
      BackStyle       =   1  'Opaque
      Height          =   1260
      Index           =   3
      Left            =   10800
      Shape           =   4  'Rounded Rectangle
      Top             =   -855
      Width           =   945
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Status"
      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
      Index           =   2
      Left            =   9960
      TabIndex        =   2
      Top             =   75
      Width           =   570
   End
   Begin VB.Shape Shape2 
      BackColor       =   &H0080FFFF&
      BackStyle       =   1  'Opaque
      Height          =   1260
      Index           =   2
      Left            =   9750
      Shape           =   4  'Rounded Rectangle
      Top             =   -855
      Width           =   945
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Set the Database"
      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
      Index           =   1
      Left            =   8025
      TabIndex        =   1
      Top             =   75
      Width           =   1500
   End
   Begin VB.Shape Shape2 
      BackColor       =   &H0080FFFF&
      BackStyle       =   1  'Opaque
      Height          =   1260
      Index           =   1
      Left            =   7920
      Shape           =   4  'Rounded Rectangle
      Top             =   -855
      Width           =   1725
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Make / Update Key Words"
      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
      Index           =   0
      Left            =   255
      TabIndex        =   0
      Top             =   75
      Width           =   2295
   End
   Begin VB.Shape Shape2 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   1  'Opaque
      Height          =   1260
      Index           =   0
      Left            =   135
      Shape           =   4  'Rounded Rectangle
      Top             =   -855
      Width           =   2535
   End
   Begin VB.Shape Shape4 
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00404040&
      Height          =   1695
      Left            =   555
      Shape           =   4  'Rounded Rectangle
      Top             =   585
      Width           =   10800
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00E0E0E0&
      BackStyle       =   1  'Opaque
      Height          =   2505
      Left            =   -30
      Top             =   -30
      Width           =   12525
   End
End
Attribute VB_Name = "FrmExtensiveSearch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()
Me.Refresh
Label10.Caption = "Wait ... Search is on for " & Text1.Text
Label11.Visible = False
    MF1.Visible = False
    MF1.Refresh
If Text1.Text = "" Or Text1.Text = " " Then 'check the serch string not for blank
    MsgBox "Please Enter a Search String"
    Text1.SetFocus
    Exit Sub
End If
    PB1.Visible = False
    Dim db As Database
    Dim rs As Recordset
    Dim Str1 As String
    Dim SqlStr As String
    Dim RSS As Recordset
    Dim Rec As Single
    Set db = OpenDatabase(App.Path & "\keywords.mdb")
    Set RSS = db.OpenRecordset("wordlist")
    If RSS.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 [e-mail]"
       Label10.Caption = ""
    Exit Sub
    End If
     PB1.Visible = True
    PB1.Value = 5
    'first serch condition with whole word only checked simple sql statement using where condition
    If Option1.Value = True And Check1.Value = 1 Then
        SqlStr = "Select * from wordlist where keyword = " & "'" & Text1.Text & "'" & " order by keyword"
        Set rs = db.OpenRecordset(SqlStr)
    End If
    
    'Second serch condition with whole word only unchecked simple sql statement using where condition and like operator
    If Option1.Value = True And Check1.Value = 0 Then
        SqlStr = "Select * from wordlist where keyword like " & "'*" & Text1.Text & "*'" & " order by keyword"
        Set rs = db.OpenRecordset(SqlStr)
    End If
    
    If Option2.Value = True Or Option3.Value = True Then
    'check the space if more than one space entered then convert them into single space
    'add a blank space at the last of the string
    'remove space from left
    Dim Txt As String
    Txt = Text1.Text
    If Len(Txt) > 250 Then
        MsgBox "Please Enter Small String for Search, Maximum character is 250"
        Exit Sub
    End If
        Dim X3 As String
        Dim i1 As Integer
        X3 = Trim(Txt)
        If X3 = "" Or X3 = " " Then 'check search string blank space or empty
            MsgBox "Please enter a Search string"
            PB1.Value = 0
            PB1.Visible = False
            Exit Sub
        End If
            For i1 = 50 To 2 Step -1
                X3 = Replace(X3, Space(i1), " ")
            Next
        Txt = X3 & " "
        
        'count the nos. of word by counting the space
        'seperate each word
        'put each word in the pocket of array Xx
        'we use maximum nos. of word is 20
        'you can increase it by changing the suffix, also change the nos of varible declearation later on..
        Dim K As Integer
        Dim Xx(20) As String
        Dim NewPos As Integer
        Dim StartCount As Integer
        Dim C As Integer
        Dim C1 As Integer
        Dim L As Integer
        Dim X As Integer
        Dim S As Integer
        Dim j As Integer
            C = 0
            K = 0
            NewPos = 0
            StartCount = 0
            C1 = 0
            S = 0
            X = 0
            L = Len(Txt)
            For K = 1 To L
                If Mid(Txt, K, 1) = " " Then
                C = C + 1
                End If
            Next
            If C > 20 Then ' checking the nos. of maximum words
                MsgBox "Please Enter a small search string, Maximum capacity is 20 words"
                Exit Sub
            End If
            StartCount = 1
            S = 1
top2:
            For K = StartCount To L