Script for indexing & searching data CDs

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Script for indexing & searching data CDs

Logged in as: Guest

arrSession:exec spGetSession 2,16,46541

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Script for indexing & searching data CDs
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Script for indexing & searching data CDs - 5/2/2007 1:53:36 AM

markmcrobie

Posts: 314
Score: 0
Joined: 12/12/2006
Status: offline

Ok, here's a script that will index the file & path names of files on a CD, give the disc a unique number, and keep a text file of the contents of the disc, then allow searching of these text files.

If you run it with a disc in that's not been indexed before, it'll write the contents to a text file and then tell you which number to label the disc with.

If you run it with a disc in that's been indexed before, it'll open the text file of that disc

If you run it with no disc in, it'll let you search for a term across all the indexes, and return the disc numbers of discs which have file names matching your search.

You need to set objPath to the letter of your CD drive.

You need to change objCDFolder to whatever folder you want the text files to be saved in. Within this folder you need a sub folder called Index, and within sub folder Index you need a text file called index.txt. This text file *must* have 1 line to start with, and that line must start with a zero and then a comma, then anything you like. For example mine's reads:

0,Index

Also there *must* be a carriage return after the 1st line. In other words with the text file open in notepad, and the cursor at the end of the word "Index", you should be able to use the down arrow on your keyboard to bring the cursor down to line 2, no less, no more.

Here's the code, suggestions, comments and criticism greatly appreciated:

Option Explicit 'Force all variables to be declared
'Declare all the variables
Dim fso, objPath, objFolder, colFiles, objCDFolder, objShell, strFile
Dim strName, intLength, Subfolder, intCount, strTotal, intSize, objTextFile
Dim File,  booSearch, objIndexFile
'Used when working with text files
Const ForReading = 1
Const ForAppending = 8
'Create the FSO and Shell, set the CD drive letter, and set the path to the main folder
Set objShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
objPath = "E:\"
Set objCDFolder = fso.GetFolder("S:\SSN Berthing\CD")
'If no disc is inserted, go straight to the Search sub
If Not fso.FolderExists(objPath) Then
Search
End If
'Create more objects
Set objFolder = fso.GetFolder(objPath)
Set colFiles = objFolder.Files
intCount = colFiles.Count 'Used to count the number of files in the root of the CD drive
intSize = objFolder.Size 'Used to get the total size of all files on the CD, including in sub folders
ShowSubfolders fso.GetFolder(objPath) 'Call a function that loops through all the sub folders (if any)
strTotal = Hex(intCount) & "-" & Hex(intSize) & "-" & Hex(intLength) 'Work out the unique ID for the inserted disc
'If the disc has been indexed before, open it's text file.  If not, write it's contents to a new text file
'by looping through the files, then calling a recursive function to deal with any subfolders, then create
'an entry in the index
If fso.FileExists(objCDFolder & "\" & GetIndexNum(strTotal) & ".txt") Then
objShell.Run "notepad " & objCDFolder & "\" & GetIndexNum(strTotal) & ".txt"
Else
MsgBox "Index created at " & objCDFolder & "\" & GetIndex & ".txt" & VbCrLf & VbCrLf &_
"Please label this disc number " & GetIndex & "." & VbCrLf & VbCrLf & "Do not eject the disc until you receive a message saying 'Done'"_
,64,"New disc"
Set objTextFile = fso.CreateTextFile(objCDFolder & "\" & GetIndex & ".txt")
Set objIndexFile = fso.OpenTextFile(objCDFolder & "\Index\index.txt",ForAppending)
 
For Each strFile in colFiles
 strName = Right(fso.GetFile(strFile),Len(fso.GetFile(strFile))-3)
 objTextFile.WriteLine(strName)
Next
ListSubFolders fso.GetFolder(objPath)
objIndexFile.WriteLine(GetIndex & "," & strTotal)
MsgBox "Done",0,"CD Indexer"
End If
'Recursive function that loops through all the sub folders, calculating total file name lengths
Function ShowSubFolders(Folder)
Dim intSubFolderCount

For Each strFile in objFolder.Files
 strName = fso.GetBaseName(strFile)
 intLength = intLength + Len(strName)
Next
   For Each Subfolder in Folder.SubFolders
    intSubFolderCount = intSubFolderCount + 1
       Set objFolder = fso.GetFolder(Subfolder.Path)
       Set colFiles = objFolder.Files
       intCount = intCount + colFiles.Count
 For Each strFile in objFolder.Files
  strName = fso.GetBaseName(strFile)
  intLength = intLength + Len(strName)
 Next
 ShowSubFolders Subfolder
   Next
ShowSubFolders = intCount
End Function
'Recursive function that loops through all the sub folders, writing their contents to the text file
Function ListSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
 Set objFolder = fso.GetFolder(Subfolder.Path)
    Set colFiles = objFolder.Files
  For Each strFile in objFolder.Files
   strName = Right(fso.GetFile(strFile),Len(fso.GetFile(strFile))-3)
   objTextFile.WriteLine(strName)
  Next
 ListSubFolders Subfolder
   Next
End Function
'Sub to ask the user to search the text files for a string.  Calls a function if Yes.
Sub Search
booSearch = MsgBox ("Do you want to search for a file on a disc?",36,"Search")
If booSearch = 6 Then MsgBox SearchFiles,,"Search Results"
WScript.Quit
End Sub
'Function that searches through the text files for a user's string.  Converts everything to upper case to avoid
'missing matches due to wrong case
Function SearchFiles
Dim strSearchWord, oList, FoundFile, strDicContents
 
 If Not fso.FolderExists(objCDFolder) Then
   SearchFiles = "Folder Not Found"
   Exit Function
 End If

If fso.GetFolder(objCDFolder).Files.Count > 0 Then 
   strSearchWord = UCase(InputBox("Search file/path name for:","Enter search criteria"))
   If strSearchWord = "" Then
    WScript.Quit
   Else
    Set oList = CreateObject("Scripting.Dictionary")
    
      For Each FoundFile In fso.GetFolder(objCDFolder).Files
       If UCase(fso.GetExtensionName(FoundFile)) = "TXT" Then 
         If InStr(UCase(fso.OpenTextFile(FoundFile,1).ReadAll),strSearchWord) <> 0 Then
          FoundFile = fso.GetBaseName(FoundFile)
           oList.Add oList.Count, FoundFile
         End If 
       End If 
      Next
    strDicContents = Join(oList.Items)
    If strDicContents = "" Then
     SearchFiles = "No matches"
    Else
     SearchFiles = "Your search:" & VbCrLf & VbCrLf & strSearchWord & VbCrLf & VbCrLf & "was found on the following discs:"_
     & VbCrLf & VbCrLf & Join(oList.Items,", ")
    End If
  End If
 Else 
   SearchFiles = "No Files Found"
End If
End Function
'Function to get the next index number
Function GetIndex
Dim f,rall, myArray, myArray2
Set f = fso.OpenTextFile("S:\SSN Berthing\CD\Index\index.txt",ForReading)
rall = f.ReadAll
Set f = Nothing
myArray = Split(rall,VbCrLf) 'Create array and split on the CRLF
ReDim Preserve myArray(UBound(myArray)-1) 'Remove the last (blank) line of the text file from the array
myArray2 = Split(myArray(UBound(myArray)),",") 'Find the last entry in the array
GetIndex = myArray2(0)+1 'Add 1 to the first column
End Function
'Function to get the index number of the inserted disc
Function GetIndexNum(strTotal) 
  Dim objDict : Set objDict = CreateObject("Scripting.Dictionary")
  Dim objFile : Set objFile = fso.OpenTextFile("S:\SSN Berthing\CD\Index\index.txt", ForReading)
  Dim arrTemp : arrTemp = Split(objFile.ReadAll, VbCrLf)
  Dim i, arrTemp2
  For i = 0 To UBound(arrTemp)
      If Not arrTemp(i) = "" Then
          arrTemp2 = Split(arrTemp(i), ",")
          objDict.Add arrTemp2(1), arrTemp2(0)
      End If
  Next
  GetIndexNum = objDict(strTotal)
End Function

Post #: 1

RE: Script for indexing & searching data CDs - 5/7/2007 11:09:48 PM

markmcrobie

Posts: 314
Score: 0
Joined: 12/12/2006
Status: offline

Improved version:

'******************************************************************************************************************************************
'*                                                                                                                                        *
'* This script is used to index the contents of CD's.  To use, you must create a folder where the indexes will be saved (as text files).  *
'* Then set objCDFolder to this folder.  Within this folder you will need 2 subfolders - one called Index and one called Databse.         *
'* Within the Index subfolder you'll need a text file called index.txt.  The first line of this text file must read "0,Index" (no quotes) *
'* and MUST have a carriage return after the word Index.                         *
'*                                    *
'* Also set objPath to the letter of the CD/DVD drive you will be using.                  *
'*                                    *
'* It also makes use of TNO's excellent Array Expansion Component, which you must install for this script to work properly.  You can      *
'* download it here: [link=http://www.thenewobjective.com/website/development/]http://www.thenewobjective.com/website/development/[/link].                  *
'*                                                                      *
'* Thanks to all the folks at VBScript Forum ([link=http://www.visualbasicscript.com/]http://www.visualbasicscript.com/[/link]) who helped.                                              *                                   *
'*                                    *
'* � Mark McRobie, Version 1.0.1, 08 May 2007.                            *
'*                                    *
'******************************************************************************************************************************************
Option Explicit 'Force all variables to be declared
'Declare all the variables
Dim fso, objPath, objFolder, colFiles, objCDFolder, objShell, strFile, strName, intLength, Subfolder, intCount, strTotal, intSize
Dim objTextFile, File, booSearch, objIndexFile, objDatabaseFile, sall, tall, inputarray, inputarray2, strFile2, JS, strOpenFile, booExit
Dim allSearch, searchlist, foundindex, foundcount
'Used when working with text files
Const ForReading = 1
Const ForAppending = 8
booExit = False
'Create the FSO and Shell, set the drive letter, and set the path to the main folder.  And set a reference to the Array Expansion Component
Set objShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
objPath = "E:\"
Set objCDFolder = fso.GetFolder("S:\SSN Berthing\CD")
Set JS = CreateObject("JS.Array")
'If no disc is inserted, go straight to the SearchFiles function
If Not fso.FolderExists(objPath) Then
allSearch = SearchFiles
Do While Not booExit
strOpenFile = InputBox(allSearch & VBCrLf & VBCrLf & "To open one of these files, enter the number.  To exit, leave blank or click cancel."_
,"Search Results")
If strOpenFile <> "" Then
 For Each foundindex In searchlist
  If strOpenFile = foundindex Then
   foundcount = foundcount + 1
  End If
 Next
 If foundcount > 0 Then
  objShell.Run "notepad " & objCDFolder & "\" & strOpenFile & ".txt"
  foundcount = 0
 Else
  MsgBox "Please enter a valid number from the search results",48,"Error"
 End If
Else
 booExit = True
End If
Loop
WScript.Quit
End If
'Create more objects
Set objFolder = fso.GetFolder(objPath)
Set colFiles = objFolder.Files
intCount = colFiles.Count 'Used to count the number of files in the root of the CD drive
intSize = objFolder.Size 'Used to get the total size of all files on the CD, including in sub folders
ShowSubfolders fso.GetFolder(objPath) 'Call a function that loops through all the sub folders (if any)
strTotal = Hex(intCount) & "-" & Hex(intSize) & "-" & Hex(intLength) 'Work out the unique ID for the inserted disc
'If the disc has been indexed before, open it's text file.  If not, write it's contents to a new text file
'by looping through the files, then calling a recursive function to deal with any subfolders, then create
'an entry in the index
If fso.FileExists(objCDFolder & "\" & GetIndexNum(strTotal) & ".txt") Then
objShell.Run "notepad " & objCDFolder & "\" & GetIndexNum(strTotal) & ".txt"
Else
MsgBox "Index created at " & objCDFolder & "\" & GetIndex & ".txt" & VbCrLf & VbCrLf &_
"Please label this disc number " & GetIndex & "." & VbCrLf & VbCrLf & "Do not eject the disc until you receive a message saying 'Done'"_
,64,"New disc"
Set objTextFile = fso.CreateTextFile(objCDFolder & "\" & GetIndex & ".txt")
Set objIndexFile = fso.OpenTextFile(objCDFolder & "\Index\index.txt",ForAppending)
Set objDatabaseFile = fso.CreateTextFile(objCDFolder & "\Database\" & GetIndex & ".txt")
For Each strFile in colFiles
 strName = Right(fso.GetFile(strFile),Len(fso.GetFile(strFile))-3)
 objTextFile.WriteLine(strName)
Next
ListSubFolders fso.GetFolder(objPath)
objIndexFile.WriteLine(GetIndex & "," & strTotal)
Set objTextFile = fso.OpenTextFile(objCDFolder & "\" & GetIndex - 1 & ".txt",ForReading)
sall = objTextFile.ReadAll
tall = Replace(sall,"_"," ")
Set objTextFile = Nothing
inputarray = Split(tall,VBCrLf)
inputarray2 = Split(UniqueTextFile(inputarray),VbCrLf)
JS.Sort inputarray2,0

For Each strFile2 in inputarray2
 objDatabaseFile.WriteLine(strFile2)
Next

MsgBox "Done",0,"CD Indexer"
End If
'Recursive function that loops through all the sub folders, calculating total file name lengths
Function ShowSubFolders(Folder)
Dim intSubFolderCount
For Each strFile in objFolder.Files
 strName = fso.GetBaseName(strFile)
 intLength = intLength + Len(strName)
Next
   For Each Subfolder in Folder.SubFolders
    intSubFolderCount = intSubFolderCount + 1
       Set objFolder = fso.GetFolder(Subfolder.Path)
       Set colFiles = objFolder.Files
       intCount = intCount + colFiles.Count
 For Each strFile in objFolder.Files
  strName = fso.GetBaseName(strFile)
  intLength = intLength + Len(strName)
 Next
 ShowSubFolders Subfolder
   Next
ShowSubFolders = intCount
End Function
'Recursive function that loops through all the sub folders, writing their contents to the text file
Function ListSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
 Set objFolder = fso.GetFolder(Subfolder.Path)
    Set colFiles = objFolder.Files
  For Each strFile in objFolder.Files
   strName = Right(fso.GetFile(strFile),Len(fso.GetFile(strFile))-3)
   objTextFile.WriteLine(strName)
  Next
 ListSubFolders Subfolder
   Next
End Function
'Function that searches through the text files for a user's string.  Converts everything to upper case to avoid
'missing matches due to wrong case
Function SearchFiles
Dim strSearchWord, oList, FoundFile, strDicContents, myArr
 If Not fso.FolderExists(objCDFolder) Then
   SearchFiles = "Folder Not Found"
   Exit Function
 End If   
 If fso.GetFolder(objCDFolder).Files.Count > 0 Then 
   strSearchWord = UCase(InputBox("Search file/path name for:","Enter search criteria"))
   If strSearchWord = "" Then
    WScript.Quit
   Else
    Set oList = CreateObject("Scripting.Dictionary")
     For Each FoundFile In fso.GetFolder(objCDFolder & "\Database").Files
      If UCase(fso.GetExtensionName(FoundFile)) = "TXT" Then 
        If InStr(UCase(fso.OpenTextFile(FoundFile,1).ReadAll),strSearchWord) <> 0 Then
         FoundFile = fso.GetBaseName(FoundFile)
          oList.Add oList.Count, FoundFile
        End If 
      End If 
     Next
      
     myArr = oList.Items
     JS.Sort myArr,2
    strDicContents = Join(myArr)
    If strDicContents = "" Then
     SearchFiles = "No matches"
    Else
     SearchFiles = "Your search:" & VbCrLf & VbCrLf & strSearchWord & VbCrLf & VbCrLf & "was found on the following discs:"_
     & VbCrLf & VbCrLf & Join(myArr,", ")
     searchlist = myArr
    End If
   End If
 Else 
   SearchFiles = "No Files Found"
End If
End Function
'Function to get the next index number
Function GetIndex
Dim f,rall, myArray, myArray2, myIndex
Set f = fso.OpenTextFile("S:\SSN Berthing\CD\Index\index.txt",ForReading)
rall = f.ReadAll
Set f = Nothing
myArray = Split(rall,VbCrLf) 'Create array and split on the CRLF
ReDim Preserve myArray(UBound(myArray)-1) 'Remove the last (blank) line of the text file from the array
myArray2 = Split(myArray(UBound(myArray)),",") 'Find the last entry in the array
GetIndex = myArray2(0)+1 'Add 1 to the first column
End Function
'Function to get the index number of the inserted disc
Function GetIndexNum(strTotal) 
  Dim objDict, i, arrTemp2, objFile, arrTemp
  Set objDict = CreateObject("Scripting.Dictionary")
  Set objFile = fso.OpenTextFile("S:\SSN Berthing\CD\Index\index.txt", ForReading)
  arrTemp = Split(objFile.ReadAll, VbCrLf)
  For i = 0 To UBound(arrTemp)
      If Not arrTemp(i) = "" Then
          arrTemp2 = Split(arrTemp(i), ",")
          objDict.Add arrTemp2(1), arrTemp2(0)
      End If
  Next
  GetIndexNum = objDict(strTotal)
End Function
'Function to compact the text file into unique words only
Function UniqueTextFile(inputarray)
Dim objDict, RegEx, i, colMatches, objMatch, strTemp
Set objDict = CreateObject("Scripting.Dictionary")
Set RegEx = New RegExp
RegEx.Pattern = "(\w)*"
RegEx.IgnoreCase = True
RegEx.Global = True
For i = 0 To UBound(inputarray)
 Set colMatches = RegEx.Execute(inputarray(i))
 For Each objMatch In colMatches
  strTemp = objMatch.Value
  If Not strTemp = "" And Not objDict.Exists(strTemp) Then
   objDict.Add strTemp, strTemp
        End If
 Next
Next
UniqueTextFile = Join(objDict.Items, VbCrLf)
End Function

(in reply to markmcrobie)

Post #: 2

If you found our site useful please link to us <a href="http://www.visualbasicscript.com">VisualBasicScript.com</a>.

All Forums >> [Scripting] >> Post a VBScript >> Script for indexing & searching data CDs

Page: [1]

Jump to:

New Messages	No New Messages
Hot Topic w/ New Messages	Hot Topic w/o New Messages
Locked w/ New Messages	Locked w/o New Messages

Post New Thread

Reply to Message

Post New Poll

Submit Vote

Delete My Own Post

Delete My Own Thread

Rate Posts