asprep.frm

自动搜索数据库中所有表,字段,记录 对数据库进行自动比对 搜索替换文本格式文件内容

            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   180
         Left            =   225
         TabIndex        =   21
         Top             =   2790
         Width           =   900
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "替  换  为:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   180
         Left            =   -74865
         TabIndex        =   11
         Top             =   2625
         Width           =   990
      End
      Begin VB.Label Label4 
         Caption         =   "搜索关键字:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   180
         Left            =   -74865
         TabIndex        =   10
         Top             =   2220
         Width           =   990
      End
      Begin VB.Label Label1 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   -74820
         TabIndex        =   6
         Top             =   3135
         Width           =   5730
      End
   End
   Begin VB.CommandButton Command4 
      Caption         =   "退出程序"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   105
      TabIndex        =   1
      Top             =   3750
      Width           =   1455
   End
   Begin VB.PictureBox Picture1 
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2775
      Left            =   45
      Picture         =   "AspRep.frx":328A
      ScaleHeight     =   2775
      ScaleWidth      =   1575
      TabIndex        =   0
      Top             =   495
      Width           =   1575
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "版本：10.1"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   270
      Left            =   360
      TabIndex        =   8
      Top             =   3375
      Width           =   900
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "内容搜索工具"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   240
      Left            =   90
      TabIndex        =   7
      Top             =   135
      Width           =   1440
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
'start:定义数据库检索变量
  Dim cat     As ADOX.Catalog
  Dim conn     As Connection
  Dim rs     As Recordset
  Dim cmd     As Command
  Dim strSql     As String
  Dim fie     As Field
  Dim fiels     As Fields
  Dim ConnString As String
  Dim SeleCode As Integer
  
'end
' Brought to you by Brad Martinez
' http://members.aol.com/btmtz/vb

' Though this example has been optimized for speed,
' it's obviously not as efficient as it could be.
' Consider it a starting point...

' A liberal use of module level variables...
Dim PicHeight%, hLB&, FileSpec$, UseFileSpec%
Dim TotalDirs%, TotalFiles%, Running%, TotalBad%

' These variables are allocated at the module level to save on
' stack space & on variable re-allocation time in SearchDirs().
' They could be declared as Static within their respective procs...
Dim WFD As WIN32_FIND_DATA, hItem&, hFile&, repFile&

' SearchDirs() constants
Const vbBackslash = "\"
Const vbAllFiles = "*.*"
Const vbKeyDot = 46
 
Private Sub Check1_Click()
If Check1.Value = 1 Then
    Text2.Enabled = True
    Text2.SetFocus
Else
    Text2.Text = ""
    Text2.Enabled = False
End If
End Sub

    
Function TableSel()
  Dim i%
      Set conn = New Connection
      conn.ConnectionString = ConnString
      conn.CursorLocation = adUseClient
      conn.Open
      Set cat = New Catalog
      cat.ActiveConnection = conn
      For i = 0 To cat.Tables.Count - 1
        If Check2.Value > 0 Then
            List2.AddItem "[" & cat.Tables(i).Name & "]" & "   " & cat.Tables(i).Type
        Else
            If cat.Tables(i).Type <> "SYSTEM TABLE" Then
                List2.AddItem "[" & cat.Tables(i).Name & "]" & "   " & cat.Tables(i).Type
            End If
        End If
      Next i
          Label7.Caption = i
  End Function
Function ZdSel()
  Dim K
  Dim i%
      Set conn = New Connection
      conn.ConnectionString = ConnString
      conn.CursorLocation = adUseClient
      conn.Open
      Set cat = New Catalog
      cat.ActiveConnection = conn
      For i = 0 To cat.Tables.Count - 1
          List2.AddItem "[" & cat.Tables(i).Name & "]" & "   " & cat.Tables(i).Type
  Dim nTab     As New Table
  Dim ncolumn     As New Column
  Dim j%
      Set nTab = cat.Tables(cat.Tables(i).Name)
      For j = 0 To nTab.Columns.Count - 1
          Set ncolumn = nTab.Columns(j)
          With ncolumn
              'Debug.Print .Name, .Type, .Attributes
              List2.AddItem Left(.Name & "               ", 15) & "|" & Left(.Type & "               ", 15) & "|" & Left(.Attributes & "               ", 15) & "|" & .Precision
          End With
      Next j
      List2.AddItem "----------------------------------------------------------"
      K = K + j
      Next i
  
      Label7.Caption = K

End Function
Function RecSel()

End Function

Private Sub Command2_Click()
List2.Clear
Label7.Caption = ""
Select Case SeleCode
    Case 0
    Call TableSel
    Case 1
    Call ZdSel
    Case 2
    If Text2.Text = "" Then
        MsgBox "请输入要检索的字符！", vbCritical, "信息提示"
    Else
        Call RecSel
    End If
End Select
End Sub

Private Sub mnuFindFiles_Click()

    ' If we're running & we got a click, it's because DoEvents in
    ' either the SearchDirs() or SearchFileSpec() proc let it happen.
    ' Tell the proc to stop. Once SearchDirs() has un-recursed itself
    ' we'll finish off below where we left off...
    If Running% Then: Running% = False: Exit Sub

    Dim drvbitmask&, maxpwr%, pwr%
    On Error Resume Next

    'FileSpec$ = InputBox("Enter a file spec:" & vbCrLf & vbCrLf & _
                                    "Searching will begin at drive A and continue " & _
                                    "until no more drives are found.  " & _
                                    "Click Stop! at any time." & vbCrLf & _
                                    "The * and ? wildcards can be used.", _
                                    "Find File(s)", "*.exe")
    FileSpec$ = "*.*"
    ' A parsing routine could be implemented here for
    ' multiple file spec searches, i.e. "*.bmp,*.wmf", etc.
    ' See the MS KB article Q130860 for information on how
    ' FindFirstFile() does not handle the "?" wildcard char correctly !!

    If Len(FileSpec$) = 0 Then Exit Sub

    MousePointer = 11
    Running% = True
    UseFileSpec% = True
    mnuFindFiles.Caption = "&停止扫描"
    mnuFolderInfo.Enabled = False
    List1.Clear

    ' The following code block is used to demonstrate how
    ' to search every available drive on a system.
    ' See the "Browse for Folder" demo for an example of
    ' selecting individual drives or folders for a search.