CD Inventory Tool

with Visual Basic Script

You know how it goes : You've messed up your system, you're reinstalling it, and you suddenly realize you need to install that driver / tool / cute litte program /... You know you have it on CD somewhere, but which one ? You know you should have had them organized long time ago, but ... Yeah.

This Silly Software Inventory Tool creates a text file that lists the directories on your CD's. If the directory names are descriptive, this text file is a rudimentary inventory that you can look through yourself, or let a search / find / ... command do the work for you. You may even want to try and use the output file as a starting point to create a CD database.

This is a Visual Basic Script. This tool was originally a MS-DOS batch file (a bat file), and uou can still see the DOS influence. The VB script is rather just a way of adding some buttons for users to click on, make it a bit more interactive, user-friendly, less text-oriented.

There's a link to the original batch files at The Silly Software Company

	Const ForAppending = 8
	Title="Silly CD Inventory Tool"
	Set objFSO = CreateObject("Scripting.FileSystemObject")

'try to get CD drive letter
	CDdriveletter=""
	'first try WMI
	'Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	'Set colItems = objWMIService.ExecQuery("Select * from Win32_CDROMDrive")
	'For Each objItem in colItems
	'	If CDdriveletter = "" Then
	'		CDdriveletter = objItem.Drive
	'	Else
	'		CDdriveletter = CDdriveletter & " " & objItem.Drive
	'	End If
	'Next
	'Set colItems = Nothing
	'Set objWMIService = Nothing

'If that didn't work, assume CD drive is last drive (using FileSystemObject)
	If CDdriveletter = "" Then
		Set colDrives = objFSO.Drives
		For Each objDrive in colDrives
			CDdriveletter = objDrive.DriveLetter &":\"
	    	Next
	End If
	Set colDrives = Nothing
	Set objDrive = Nothing

'Finally, allow user to change/input driveletter
	Prompt ="give drive letter for CD-rom"
	CDdriveletter = InputBox (Prompt, Title, CDdriveletter)

	CDdriveletter = Left(CDdriveletter,1) & ":\"
	CDcount = 0
	Continue = 1
	DefaultName="cdlist.txt"

'Loop for multiple CD's in 1 session

Do While Continue = 1

	CDcount = CDcount+1
	MsgBox "Put the CD in drive " & CDdriveletter & ", then click [OK]"

	'Write title etc
	Prompt ="give a name to this CD"
	DefaultCDName="CD " & CDcount & "- "
	strCDname = InputBox (Prompt, Title, DefaultCDName)

'get name for inventory text file (allows separate files for each CD)
	Prompt = "Give a (path)name for the file where you want to keep the inventory." _
		& vbCrLf & "You can also keep the proposed file and add to it"

	strFileName = InputBox (Prompt, Title, DefaultName)
	DefaultName = strFileName 'next time

'enumerating folders
'I'm convinced that the MS-DOS DIR command does a good job at listing folders, 
'and is easier than recursively loop trough all folders to find all subfolders, 
'and their subfolders, etc, 'while you even don't know how many levels you have to go through ...
'so we create a temporary list with DIR (via the command.com /C switch), 
'and use that to create our inventory

	Set WSHShell=CreateObject("Wscript.Shell")
	CommandString= "command /C DIR " & CDdriveletter & " /B /ON /AD /S > %TEMP%\cdlist"
	WSHShell.Run CommandString
	MsgBox "Please wait while MS-DOS reads your CD ...", vbOkOnly, Title
	Set WSHShell=Nothing
	
'use temporary list as input to allow string manipulation for definitive list

	Set objFolder=objFSO.getspecialfolder(2)	'this is temp directory
	strInputFile = objFolder.Path & "\cdlist"
	Set objFolder = Nothing

	Set objOutputFile = objFSO.OpenTextFile(strFileName, ForAppending, True)
	objOutputFile.WriteLine("")
	objOutputFile.WriteLine("")
	objOutputFile.WriteLine(strCDname)
	objOutputFile.WriteLine("---------------------------------------------------")
	
	'list cdname, guess software name, show path without drive letter
	Set objInputFile = objFSO.OpenTextFile(strInputFile, 1)
	Do Until objInputFile.AtEndOfStream
		strInput = objInputFile.ReadLine

		'manipulate input a bit
		'strip 2 charachters (drive letter) from path
		strInput= Right(strInput,((Len(strInput))-2))

		'assume that 2 bottom-level directories describe the software therein
		pos =  Len(strInput)+1
		count   =  0
		div = 0
		do while pos > 0  AND count < 2 
			pos=pos - 1
			div=div+1
			char=Right(Left(strInput,pos),1)
			if char = "\" then
				count=count+1
			end if
		loop
		strGuessName=Right(strInput,div)

		' comma-delimited entries, can be used to create other file formats
		strOutput= CDcount & ", " & strCDname & "," & strGuessName & "," & strInput
		objOutputFile.WriteLine(strOutput)
	Loop
	objInputFile.Close
	objOutputFile.Close

'repeat with same drive letter, all the rest interactive. 

	Reply = MsgBox ("Do another CD ?", vbYesNo, Title)
	If Reply = 7 Then	''No'
		Continue = 0
	End If

Loop


'cleanup and exit
	objFSO.DeleteFile(strInputFile)
	Set objOutputFile = Nothing
	Set objInputFile = Nothing
	Set objFSO = Nothing
	Prompt="Finished." & vbCrLf & "You can find your cd list in " & strFileName
	MsgBox Prompt, vbOkOnly, Title