frmfind.frm

ado连接数据库的例子,对初学者很有帮助.

VERSION 5.00
Begin VB.Form frmFind 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "查找"
   ClientHeight    =   2055
   ClientLeft      =   3090
   ClientTop       =   6150
   ClientWidth     =   5700
   Icon            =   "frmFind.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2055
   ScaleWidth      =   5700
   StartUpPosition =   2  '屏幕中心
   Begin VB.CheckBox chkMatch 
      Caption         =   "查找文字"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   1320
      Width           =   2175
   End
   Begin VB.CheckBox chkKonfirmasi 
      Caption         =   "显示全部记录"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   1680
      Value           =   1  'Checked
      Width           =   3855
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   4320
      TabIndex        =   6
      Top             =   1200
      Width           =   1215
   End
   Begin VB.CommandButton cmdFindNext 
      Caption         =   "查找下一个"
      Height          =   375
      Left            =   4320
      TabIndex        =   5
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton cmdFindFirst 
      Caption         =   "查找"
      Height          =   375
      Left            =   4320
      TabIndex        =   4
      Top             =   120
      Width           =   1215
   End
   Begin VB.ComboBox cboFind 
      Height          =   315
      Left            =   1200
      TabIndex        =   3
      Top             =   840
      Width           =   3015
   End
   Begin VB.ComboBox cboField 
      Height          =   315
      Left            =   1200
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   360
      Width           =   3015
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "查找的内容"
      Height          =   255
      Left            =   30
      TabIndex        =   2
      Top             =   840
      Width           =   1125
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "要查找的字段"
      Height          =   255
      Left            =   30
      TabIndex        =   0
      Top             =   360
      Width           =   1125
   End
End
Attribute VB_Name = "frmFind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim cnn As ADODB.Connection
Dim WithEvents rs As ADODB.Recordset
Attribute rs.VB_VarHelpID = -1

Dim adoField As ADODB.Field
Dim mark As Variant
Dim intCount As Integer
Dim intPosition As Integer
Dim bFound As Boolean
Dim strFind As String, strFindNext As String
Dim strResult As String
Dim bCancel As Boolean


Private Sub cboField_Click()
  If cboField.Text = "(All Fields)" Then
     chkMatch.Value = 0
     chkMatch.Enabled = False
  Else
     chkMatch.Enabled = True
  End If
End Sub

Private Sub cboFind_Change()
  If Len(Trim(cboFind.Text)) > 0 Then
     cmdFindFirst.Enabled = True
     cmdFindFirst.Default = True
  Else
     cmdFindFirst.Enabled = False
     cmdFindNext.Enabled = False
  End If
End Sub

Private Sub cboFind_Click()
  If Len(Trim(cboFind.Text)) > 0 Then
     cmdFindFirst.Enabled = True
     cmdFindFirst.Default = True
  Else
     cmdFindFirst.Enabled = False
  End If
End Sub

Private Sub cboField_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then
     cboFind.SetFocus
     SendKeys "{Home}+{End}"
  End If
End Sub


Private Sub cmdFindFirst_Click()
Dim strFound As String
Dim i As Integer
'If criteria is not (All Fields)
If Trim(cboField.Text) <> "(All Fields)" Then
  On Error GoTo Message
  intCount = 0
  CheckDouble
  adoFind.MoveFirst
  bFound = False 'Not found yet
  Do While adoFind.EOF <> True
     DoEvents
     If bCancel = True Then 'If use interrupt by clicking
                            'Cancel button...
        Exit Sub            '... exit from this procedure
     End If
     
     If chkMatch.Value = 0 Then  'Not match whole word
       If InStr(UCase(adoFind.Fields(cboField.Text)), UCase(cboFind.Text)) > 0 Then
          DoEvents
          intCount = intCount + 1
          DoEvents
          'Get the absolute position
          intPosition = adoFind.AbsolutePosition
          'We found it, update bFound now
          bFound = True
       End If
     Else 'Match whole word only
       If UCase(adoFind.Fields(cboField.Text)) = UCase(cboFind.Text) Then
          DoEvents
          intCount = intCount + 1
          DoEvents
          'Get the absolute position
          intPosition = adoFind.AbsolutePosition
          'We found it, update bFound now
          bFound = True
       End If
     End If
     
     If intCount = 1 Then 'If this is the first found
        bFound = True 'Update bFound
        Exit Do       'Exit from this looping, because
                      'this is only the first time
     End If
     DoEvents
     adoFind.MoveNext
  Loop
  'Jika we found and intCount <> 0
  If bFound = True And intCount <> 0 Then
     'cmdFindNext ready
     cmdFindNext.Enabled = True
     'Display what position we found...
     strFound = "Found '" & cboFind.Text & _
                 "' in record number " & adoFind.AbsolutePosition & vbCrLf
     'This will get the name of field
     For i = 0 To adoFind.Fields.Count - 1
       'Get just field name that we need, but "ChildCMD"
       If adoFind.Fields(i).Name = "ChildCMD" Then
          Exit For
       End If
       'Get all data in record we found
       strFound = strFound & vbCrLf & _
            adoFind.Fields(i).Name & ": " & _
            vbTab & adoFind.Fields(i).Value
     Next i
  End If
  'If chkKonfirmasi was checked by user and data found
  If chkKonfirmasi.Value = 1 And bFound = True Then
     'Display in messagebox
     MsgBox strFound, vbInformation, "Found"
  End If
  If (adoFind.EOF) Then  'If pointer in end of recordset
     adoFind.MoveLast    'move to the last record
     bFound = False      'so, we haven't found it yet
     'Display messagebox we haven't found it
     MsgBox "'" & cboFind.Text & "' not found " & _
            "in field '" & cboField.Text & "'.", _
            vbExclamation, "Finished Searching"
     'cmdFindNext is not active because we haven't found
     'in cmdFindFirst
     cmdFindNext.Enabled = False
     Exit Sub
  End If
  Exit Sub
Else 'If user select (All Fields)
  FindFirstInAllFields '<-- call this procedure
  Exit Sub
End If
Message:
  MsgBox Err.Number & " - " & Err.Description
End Sub

Private Sub cmdFindNext_Click()
Dim strFound As String
Dim i As Integer
'If user select criteria: (All Fields)
If Trim(cboField.Text) <> "(All Fields)" Then
  On Error GoTo Message
  'First of all, we haven't found it, yet...
  bFound = False
  Do While adoFind.EOF <> True
     DoEvents
     If bCancel = True Then 'If use interrupt by clicking
                            'Cancel button...
        Exit Sub            '... exit from this procedure
     End If
     
     If chkMatch.Value = 0 Then  'Not match whole word
       'In FindNext, we compare the intPosition variable
       'with AbsolutePosition. If they are not same
       'then we found it
       If (InStr(UCase(adoFind.Fields(cboField.Text)), _
              UCase(cboFind.Text)) > 0) And _
              intPosition <> adoFind.AbsolutePosition Then
          DoEvents
          'Update counter position
          intCount = intCount + 1
          DoEvents
          'Get the absolute position
          intPosition = adoFind.AbsolutePosition
          'We found it, update bFound now
          bFound = True
       End If
     Else 'Match whole word only
       If UCase(adoFind.Fields(cboField.Text)) = _
              UCase(cboFind.Text) And _
              intPosition <> adoFind.AbsolutePosition Then
          DoEvents
          'Update counter position
          intCount = intCount + 1
          DoEvents