Some Script Code Here

[rory 0]

Use it for whatever you like, its free ..

Nothing to do with CCTV but it may come in handy.

 

Deletes All Files and SubFolders in a Specific Folder or SubFolder. Input box pops up and asks for the Full Path of the folder.

 

Some learning material if anything. Converted from ASP to standalone Vbscript. Copy text into a new text file and save as a .vbs file. If you want the ASP script let me know.

 

 

' 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() 

[rory 0]

Search & Replace Text within Files

 

'' 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() 

[rory 0]

Here's another one for those using classic ASP .. highlites multiple keywords in a search results with either a font color, span background color, or bold text.

 

'::	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

 

 

Example Usage: (With Bold)

Not tested just written from scratch but should work.

 

Live Example here: (BOLD)

http://www.bahamassecurity.com/wb/default.asp?go=search&keyword=Bahamas+Island

(RED FONT)

http://www.knowlesrealty.com/Search.htm?go=-1&keyword=Beach+Island

 

 

'
'// 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")
'