asprep.frm

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

    ' http://members.aol.com/btmtz/vb/browsdlg

    drvbitmask& = GetLogicalDrives()
    ' If GetLogicalDrives() succeeds, the return value is a bitmask representing
    ' the currently available disk drives. Bit position 0 (the least-significant bit)
    ' is drive A, bit position 1 is drive B, bit position 2 is drive C, and so on.
    ' If the function fails, the return value is zero.
    ' GetLogicalDriveStrings() could be used here instead,
    ' but it's string buffer would have to be parsed...
    If drvbitmask& Then

        ' Get & search each available drive
        maxpwr% = Int(Log(drvbitmask&) / Log(2))   ' a little math...
        For pwr% = 0 To maxpwr%
            If Running% And (2 ^ pwr% And drvbitmask&) Then _
                Call SearchDirs(Chr$(vbKeyA + pwr%) & ":\")
        Next
    End If

    Running% = False
    UseFileSpec% = False
    mnuFindFiles.Caption = "&自动扫描"
    mnuFolderInfo.Enabled = True
    MousePointer = 0

    Label1.Caption = ""
    Label1.Caption = "扫描结果        文件数：" & TotalFiles% & "    成功恢复文件数： " & """" & TotalBad & """"
    Beep

End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Form_Load()

    ScaleMode = vbPixels
    'PicHeight% = Picture1.Height
    hLB& = List1.hwnd
    ' This speeds things a bit but will consume close to 6MB of memory...!!!
    SendMessage hLB&, LB_INITSTORAGE, 30000&, ByVal 30000& * 200
    Move (Screen.Width - Width) * 0.5, (Screen.Height - Height) * 0.5
    '***********************数据库检索*****************************
 ' ConnString = "Provider=SQLOLEDB.1;Persist   Security   Info=False;User   ID=sa;Initial   Catalog=pubs;Data   Source=NIEXINHOME"
  ConnString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=gs12315;Data Source=10.2.5.201"
    
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    ' Cancels the search (Form1.KeyPreview = True)
    If KeyCode = vbKeyEscape And Running% Then Running% = False
End Sub

Private Sub Form_Resize()
    ' Much faster & cleaner than the Move Method...
    'MoveWindow hLB&, 0, 0, ScaleWidth, ScaleHeight - PicHeight%, True
End Sub

Private Sub Form_Unload(Cancel As Integer)
   '***********************数据库检索*****************************


  '*************************文本文件检索**********************************
    Set Form1 = Nothing
    End
End Sub





Private Sub mnuFolderInfo_Click()
If Text1.Text = "" Then
    MsgBox "请输入搜索的关键字!", vbCritical, "信息提示"
    Text1.SetFocus
    Exit Sub
End If
TotalBad = 0
    ' 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 searchpath$
    On Error Resume Next

    searchpath$ = InputBox("请输入目标路径:", "扫描路径", "C:\")
    ' Doesn't allow relative paths...
    If Len(searchpath$) < 2 Then Exit Sub
    If Mid$(searchpath$, 2, 1) <> ":" Then Exit Sub
    
    ' nornalize path
    If Right$(searchpath$, 1) <> vbBackslash Then searchpath$ = searchpath$ & vbBackslash
    ' Simple little one-line "FolderExists" expression, can be easily adapted to test for files
    If FindClose(FindFirstFile(searchpath$ & vbAllFiles, WFD)) = False Then
        MsgBox searchpath$, vbInformation, "Path is invalid": Exit Sub
    End If

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

    TotalDirs% = 0
    TotalFiles% = 0
    Call SearchDirs(searchpath$)
    
    Running% = False
    mnuFolderInfo.Caption = "&扫描位置"
    'mnuFindFiles.Enabled = True
    'Picture1.Cls
    Label1.Caption = "扫描结果        文件数：" & TotalFiles% & "    符合条件的数据： " & """ & TotalBad & """
    MousePointer = 0

    MsgBox "扫描完成！", vbInformation, "检查提示"
                 
    'MsgBox "Total folders: " & vbTab & TotalDirs% & vbCrLf & _
                 "Total files: " & vbTab & TotalFiles%, , _
                 "Folder Info for: " & searchpath$
    
End Sub
 

' This is were it all happens...

' You can use the values in returned in the
' WIN32_FIND_DATA structure to virtually obtain any
' information you want for a particular folder or group of files.

' This recursive procedure is similar to the Dir$ function
' example found in the VB3 help file...

Private Sub SearchDirs(curpath$)  ' curpath$ is passed w/ trailing "\"
    ' These can't be static!!! They must be
    ' re-allocated on each recursive call.
    Dim dirs%, dirbuf$(), i%
 On Error Resume Next
    ' Display what's happening...
    ' A Timer could be used instead to display status at
    ' pre-defined intervals, saving on PictureBox redraw time...
    '*Picture1.Cls
    '*Picture1.Print "Searching " & curpath$
    Label1.Caption = "正在扫描  " & curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
    '*****************************添加检测函数******************
    
    ' Allows the PictureBox to be redrawn
    ' & this proc to be cancelled by the user.
    ' It's not necessary to have this in the loop
    ' below since the loop works so fast...
    DoEvents
    If Not Running% Then Exit Sub
    
    ' This loop finds *every* subdir and file in the current dir
    hItem& = FindFirstFile(curpath$ & vbAllFiles, WFD)
    If hItem& <> INVALID_HANDLE_VALUE Then
        
        Do
            ' Tests for subdirs only...
            If (WFD.dwFileAttributes And vbDirectory) Then
                
                ' If not a  "." or ".." DOS subdir...
                If Asc(WFD.cFileName) <> vbKeyDot Then
                    ' This is executed in the mnuFindFiles_Click()
                    ' call though it isn't used...
                    TotalDirs% = TotalDirs% + 1
                    ' This is the heart of a recursive proc...
                    ' Cache the subdirs of the current dir in the 1 based array.
                    ' This proc calls itself below for each subdir cached in the array.
                    ' (re-allocating the array only once every 10 itinerations improves speed)
                    If (dirs% Mod 10) = 0 Then ReDim Preserve dirbuf$(dirs% + 10)
                    dirs% = dirs% + 1
                    dirbuf$(dirs%) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                End If
            
            ' File size and attribute tests can be used here, i.e:
            ' ElseIf (WFD.dwFileAttributes And vbHidden) = False Then  'etc...
            
            ' Get a total file count for mnuFolderInfo_Click()
            ElseIf Not UseFileSpec% Then
                TotalFiles% = TotalFiles% + 1
                    Dim FileNames
                    FileNames = curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                If TotalFiles% > 0 And InStr("htm|html|asp|jsp|js|txt|ini|inf|php|asa|css", Right(Trim(FileNames), 3)) > 0 Then
                    SendMessage hLB&, WM_SETREDRAW, 0, 0
                    Call ReplaceInFile(curpath$)
                    SendMessage hLB&, WM_VSCROLL, SB_BOTTOM, 0
                    SendMessage hLB&, WM_SETREDRAW, 1, 0
                End If
            End If
        
        ' Get the next subdir or file
        Loop While FindNextFile(hItem&, WFD)
        
        ' Close the search handle
        Call FindClose(hItem&)
    
    End If

    ' When UseFileSpec% is set mnuFindFiles_Click(),
    ' SearchFileSpec() is called & each folder must be
    ' searched a second time.
    'If UseFileSpec% Then


        ' Turning off painting speeds things quite a bit...
        ' Speed also would be vastly improved if the redrawing
        ' & scrolling were placed in a Timer event...
'******************备注*****************
'        SendMessage hLB&, WM_SETREDRAW, 0, 0
'    'If TotalBad > 0 Then
'        'Call SearchFileSpec(curpath$)
'       Call ReplaceInFile(curpath$)
'    'End If
'        ' Keeps the currently found items scrolled into view...
'        SendMessage hLB&, WM_VSCROLL, SB_BOTTOM, 0
'        SendMessage hLB&, WM_SETREDRAW, 1, 0
'*************************************************
   ' End If
    
    ' Recursively call this proc & iterate through each subdir cached above.
    For i% = 1 To dirs%: SearchDirs curpath$ & dirbuf$(i%) & vbBackslash: Next i%
  
End Sub

'Private Sub SearchFileSpec(curpath$)   ' curpath$ is passed w/ trailing "\"
'' This procedure *only*  finds files in the
'' current folder that match the FileSpec$
'
'    hFile& = FindFirstFile(curpath$ & vbAllFiles, WFD)
'   ' hFile& = FindFirstFile(curpath$ & FileSpec$, WFD)
'    If hFile& <> INVALID_HANDLE_VALUE Then
'            Do
'            ' Use DoEvents here since we're loading a ListBox and
'            ' there could be hundreds of files matching the FileSpec$
'            DoEvents
'            If Not Running% Then Exit Sub
'
'            ' The ListBox's Sorted property is initially set to False.
'            ' Set it to True and see how things slow down a bit...
'            SendMessage hLB&, LB_ADDSTRING, 0, _
'                ByVal curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
'
'        ' Get the next file matching the FileSpec$
'        Loop While FindNextFile(hFile&, WFD)
'
'        ' Close the search handle
'        Call FindClose(hFile&)
'
'   End If
'
'End Sub
Private Sub ReplaceInFile(curpath$)
'检查文件是否被恶意修改过，并把被改文件修复
On Error Resume Next

Dim FileNum As Long, strFileContent As String, strTemp As String, ReplaceStr As String
    FileNum = FreeFile
                    Dim FileName
                    FileName = curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
            If Dir(FileName) <> "" Then
                Open FileName For Input As #FileNum
                While Not EOF(FileNum)
                Dim ifRep As Integer
                    Line Input #FileNum, strTemp
                If InStr(strTemp, Text1.Text) > 0 Then
                    'ReplaceStr = Mid(strTemp, InStr(strTemp, "<iframe src=http://www."), (InStr(strTemp, "</iframe>") + 9 - InStr(strTemp, "<iframe src=http://www.")))
                    'strTemp = Replace(strTemp, ReplaceStr, "", , , vbDatabaseCompare)
                    ifRep = 1
                End If
                   strFileContent = strFileContent & strTemp & vbCrLf
                Wend
                Close #FileNum
'**************************************************************************
                If ifRep = 1 Then
                    'Open FileName For Output As #FileNum
                    'Print #FileNum, strFileContent
                    'Close #FileNum
                    TotalBad = TotalBad + 1
                    
                SendMessage hLB&, LB_ADDSTRING, 0, _
                ByVal curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                End If
                
            End If
End Sub

Private Sub SelOption_Click(Index As Integer)
SeleCode = Index
End Sub