CODE:

' This script was developed by Rory Knowles
' FREEWARE - Produced by BahamasSecurity.com
' Note, save this script as a .vbs file.
 
'---------------------------- 

Option Explicit

'---------------------------- 

'// PROGRAM SETTINGS

Const ProgTitle = "Delete Files & Folders"

'---------------------------- 

'// DECLARATIONS

Dim fso, f
Dim FileCnt
Dim FolderCnt
Dim folderName   

FileCnt = 0
FolderCnt = 0

'---------------------------- 

'// GET FOLDER & PERFORM TASKS

Sub ParseFolder()
    Set fso=CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(folderName)
    Call DeleteFiles(f)
    Call DeleteFolders(f)
    Set f = Nothing
    Set fso = nothing
    Call EndMessage()
End Sub
 
'---------------------------- 

'// CHECK IF FOLDER EXISTS

Function DoesFolderExist()
    Dim fso
    Dim var
    Set fso = CreateObject("Scripting.FileSystemObject")
    If (fso.FolderExists(folderName)) Then
        DoesFolderExist = True   
    end if
    Set fso = nothing
End function
 
'---------------------------- 

'// DELETE FILES

Function DeleteFiles(byVal f)    
    Dim file
    Dim Files   
    Set Files = f.Files
    For Each file In Files
        file.delete
        FileCnt = FileCnt  + 1
    Next
    Set Files = Nothing
End function   

'---------------------------- 

'// DELETE FOLDERS

Function DeleteFolders(byVal f)
    Dim SingleFolder
    Dim SubFolders
    Set SubFolders = f.Subfolders
    For Each SingleFolder in SubFolders
        SingleFolder.delete
        FolderCnt = FolderCnt + 1
    Next
    Set SubFolders = nothing
End function   

'----------------------------   
   
'// FOLDER NOT EXIST

Sub badFolder()
    msgBox("Folder: " & folderName &", does not exist! Operation Cancelled", vbOkOnly, ProgTitle)
End Sub
   
'----------------------------   

'// END MESSAGE

Sub EndMessage()    
    Call MsgBox("Deleted " & FileCnt & _
             " Files and " & FolderCnt & _
             " SubFolders From: " & folderName, _
               vbOkOnly, ProgTitle)
End Sub   

'----------------------------   
     
'// CANCEL BY USER

Sub operationCancelled()    
    Call MsgBox("User Cancelled", vbOkOnly, ProgTitle)
End Sub   

'---------------------------- 
   
'// CHECK INPUT BOX ENTRY

Sub CheckFolderEntry()
    folderName = InputBox("Enter Folder Path (eg: c:\test)", ProgTitle)
    if folderName <>"" then
       if DoesFolderExist() = True then
          call ParseFolder()
       else
          call badFolder()
       end if
    else
       call operationCancelled()
    end if
End Sub
   
'----------------------------

'// START PROGRAM

Sub startRoutines()
    Call CheckFolderEntry()
End Sub
   
'---------------------------- 
   
call startRoutines()

CODE:

'' FREEWARE - Produced by BahamasSecurity.com
' Note, save this script as a .vbs file. 
'---------------------------- 
Public Function DoesFolderExist(byVal folderName)
  dim fso
  dim var
  Set fso = CreateObject("Scripting.FileSystemObject")
  If (fso.FolderExists(folderName)) Then
     DoesFolderExist ="true"   
  end if
  Set fso = nothing
End function
   
'---------------------------- 
   
Sub badFolder(byVal folderName)
  msgBox("Folder: " & folderName &", does not exist! Operation Cancelled")
End Sub
   
'---------------------------- 
   
Sub operationCancelled()
    msgBox("Replace operation cancelled!")
End Sub
   
'---------------------------- 
   
Sub ParseFile(byVal objFile, byVal strOld, byVal strNew, byRef replaceCNT)
 ' Developed by Ryan Trudelle-Schwarz for www.mamanze.com   
   const ForReading = 1
   const ForWriting = 2
   
   Dim objTextStream
   Dim strInclude
   
 ' Grab all the text out of the file.   
   Set objTextStream = objFile.OpenAsTextStream(ForReading)
     strInclude = objTextStream.ReadAll
   objTextStream.Close
   
   Set objTextStream = Nothing
   
 ' Check to see if the string we want to replace is even in the file, if   
 ' not then don't waste the time on replacing it.   
   If InStr(strInclude,strOld) > 0 Then
     
 ' Do the Replace   
   strInclude = Replace(strInclude,strOld,strNew)
   
 ' count how many files replaced 
   replaceCNT = replaceCNT + 1
   
 ' Update the file   
   Set objTextStream = objFile.OpenAsTextStream(ForWriting)
     objTextStream.Write strInclude
   objTextSTream.Close
   
   Set objTextStream = Nothing
   End If
End Sub
   
'---------------------------- 
   
Sub ReplaceFolder(byRef objFolder, byVal strOld, byVal strNew, byRef replaceCNT)
  Dim objFile, objSubFolder
   
 ' Loop through the files and parse each one.   
   For Each objFile in objFolder.Files
     Call ParseFile(objFile, strOld, strNew, replaceCNT)
   next'objFile   
   
 ' Loop through the sub folders and call self on each folder.   
   For Each objSubFolder in objFolder.SubFolders
     Call ReplaceFolder(objSubFolder, strOld, strNew, replaceCNT)
   Next'objSubFolder   
End Sub
   
'---------------------------- 
   
Sub ReplaceAll(byVal strFolder, byVal strOld, byVal strNew, byRef replaceCNT)
   dim objFSO, objFolder
   
 ' Setup the FSO Object   
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   
 ' Get the root folder   
   Set objFolder = objFSO.GetFolder(strFolder)
 ' Do the Replace on the root folder.   
   Call ReplaceFolder(objFolder, strOld, strNew, replaceCNT)
End Sub
   
'----------------------------- 
   
Sub CheckstrNew(byVal strFolder, byVal strOld)
    dim strNew
    strNew = InputBox("New Word:","New Word - Search and Replace")
    if strNew <>"" then
       dim replaceCNT
       replaceCNT = 0
       call ReplaceAll(strFolder, strOld, strNew, replaceCNT)
       if replaceCNT <> 0 then
          msgBox(replaceCNT &" files containing the old word:" & strOld &", were edited with the new word:" & strNew)
       else
          msgBox("No files contained the old word:" & strOld &", nothing was replaced")
       end if
    else
       call operationCancelled()
    end if
End Sub
   
'----------------------------- 
   
Sub CheckstrOld(byVal strFolder)
    dim strOld
    strOld = InputBox("Old Word:","Old Word - Search and Replace")
    if strOld <>"" then
       call CheckstrNew(strFolder, strOld)
    else
       call operationCancelled()
    end if
End Sub
   
'----------------------------- 
   
Sub CheckFolderEntry()
    dim strFolder
    strFolder = InputBox("Enter Folder To Search (eg: c:\test)","Enter Folder - Search and Replace")
    if strFolder <>"" then
       if DoesFolderExist(strFolder) ="true" then
          call CheckstrOld(strFolder)
       else
          call badFolder(strFolder)
       end if
    else
       call operationCancelled()
    end if
End Sub
   
'------------------------------ 
   
Sub startRoutines()
    Call CheckFolderEntry()
End Sub
   
'------------------------------- 
   
call startRoutines()
 

CODE:


'::   FUNCTION:  highlites multiple keywords
'::    from ASP Search Results   
'::       
'::    AUTHOR:  BahamasSecurity.com      
'::    COPYRIGHT:  2004-2006         
'::                                  
'::    RESULT:  Search Result/s         
'::    KEYWORD:  Search Keyword/s         
'::    TYPE:  0 = Bold, 1 = Font, 2 = Span     
'::    COLOR:  #color, color            

Private Function highlightQuery(byVal sResult, _
                        byVal sKeyword, _
                        byVal sType, _
                        byVal sColor)
   Dim c, eKey, eArr
   Dim typeOpen, typeClose
   Dim searchQueryLength
   Dim startPosition
   Dim querySectionToReplace
   Dim highlightQueryTemp
   Dim SearchWordsCount
   Select Case sType
      Case 1
         typeOpen = "<font color=""" & sColor & """>"
         typeClose = "</font>"
      Case 2
         typeOpen = "<span style=""background-color: " & sColor & """>"
         typeClose = "</span>"
      Case Else
         typeOpen = "<b>"
         typeClose = "</b>"
   End Select
   eKey = sKeyword
   eKey = Replace(eKey,"'","")
   eKey = Replace(eKey,"+"," ")
   eArr = Split(eKey," ")
   highlightQueryTemp = sResult
   SearchWordsCount = Ubound(eArr)
   FOR c = 0 TO SearchWordsCount   
      searchQueryLength = LEN(eArr(c))
      startPosition = INSTR(1,highlightQueryTemp,eArr(c),1)
      IF startPosition >= 1 THEN
         querySectionToReplace = MID(highlightQueryTemp,startPosition,searchQueryLength)
         highlightQueryTemp = REPLACE(highlightQueryTemp,querySectionToReplace,typeOpen & querySectionToReplace & typeClose,1)
      END IF
   NEXT
   highlightQuery = highlightQueryTemp
End Function

CODE:

'
'// Example Database = DBFile.mdb
'// Example Table = Table
'// Example Field = Details

Dim strKeyword
Dim objConn, objRs
Dim strResults
strKeyword = Request("keyword")
If strKeyword <> "" Then
   Set objConn = Server.CreateObject("ADODB.Connection")
   objConn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=DBFile.mdb"
   Set objRs = objConn.Execute("Select Details From Table Where Details Like  '%" & strKeyword & "%';")
   If Not objRs.Eof Then
      Do Until objRs.Eof
         If Not IsNull(objRs("Details")) And objRs("Details") <> "" Then
            strResults = objRs("Details")
            Response.Write "<p>" & highlightQuery(strResults, strKeyword, 0, 0) & "</p>"
         End If
         objRs.MoveNext
      Loop
   Else
      Response.Write "<p>No Results Found</p>"
   End If
   objConn.CLOSE
   Set objConn = Nothing
Else
   Response.Write "<p>No Results Found</p>"
End If

'// Example Red Font:
'// strResults = highlightQuery(strResults, strKeyword, 1, "red")
'