CdSlurper - A script for bulk reading files from CDs/DVDs to disk

CdSlurper is used for copying files from CD/DVD to disk. It waits for a CD/DVD to be inserted, copies the files from the CD/DVD to a disk directory, ejects the CD/DVD and waits for the next CD/DVD to be inserted.

Example of how to call the script:

cscript.exe /nologo CdSlurper.vbs D C:\temp

The first argument of the script (D) is the CD/DVD drive letter. The second argument (C:\temp) is the path of the target directory. An example batch file for calling the script is included in the ZIP file.

File for download: CdSlurper.vbs.zip

' CdSlurper.vbs
'
' A script for bulk reading files from CDs/DVDs to disk.
'
' This script waits for a CD/DVD to be inserted, copies the files
' from the CD/DVD to a disk directory, ejects the CD/DVD and
' waits for the next CD/DVD to be inserted.
'
' Author: Christian d'Heureuse (www.source-code.biz)
' License: GNU/LGPL (http://www.gnu.org/licenses/lgpl.html)
' Version: 2009年01月20日
Option Explicit
Dim StdIn: Set StdIn = WScript.StdIn
Dim StdOut: Set StdOut = WScript.StdOut
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim sha: Set sha = CreateObject("Shell.Application")
Dim CdDriveLetter
Dim TargetDir
Dim CdDrive
Dim CdSerialNumber: CdSerialNumber = Null
Dim CdVolumeName : CdVolumeName = Null
Main
Sub Main
 Init
 Do
 WaitForNewCd
 CopyCdFiles
 EjectCd
 Loop
 End Sub
Sub Init
 GetParms
 Set CdDrive = fso.GetDrive(CdDriveLetter)
 If CdDrive.DriveType  4 Then Err.Raise vbObjectError,, "Drive " & CdDriveLetter & ": is not a CD/DVD drive."
 End Sub
Sub GetParms
 If WScript.Arguments.Length  2 Then Err.Raise vbObjectError,, "Invalid number of command line arguments."
 CdDriveLetter = WScript.Arguments(0)
 If Len(CdDriveLetter)  1 Then Err.Raise vbObjectError,, "Invalid drive letter argument."
 TargetDir = WScript.Arguments(1)
 End Sub
Sub WaitForNewCd
 Do
 If DetectNewCd Then Exit Do
 StdOut.Write "."
 WScript.Sleep 1000
 Loop
 StdOut.WriteLine
 End Sub
Function DetectNewCd
 If Not CdDrive.IsReady Then Exit Function
 Dim NewSerialNumber: NewSerialNumber = CdDrive.SerialNumber
 Dim NewVolumeName: NewVolumeName = CdDrive.VolumeName
 if NewSerialNumber = CdSerialNumber And NewVolumeName = CdVolumeName Then Exit Function
 CdSerialNumber = NewSerialNumber
 CdVolumeName = NewVolumeName
 DetectNewCd = True
 End Function
Sub CopyCdFiles
 Dim CdRoot: Set CdRoot = CdDrive.RootFolder
 If CdRoot.SubFolders.Count  0 Then _
 StdOut.WriteLine "*** Warning: CD/DVD contains folders and they are ignored!": Beep
 Dim Files: Set Files = CdRoot.Files
 Dim File
 For Each File In Files
 Dim TargetFileName: TargetFileName = fso.BuildPath(TargetDir, File.Name)
 If fso.FileExists(TargetFileName) Then
 StdOut.WriteLine "*** Warning: File already exists in target directory: """ & File.Name & """": Beep
 Else
 StdOut.WriteLine File.Name
 File.Copy TargetFileName
 End If
 Next
 End Sub
Sub EjectCd
 Dim ssfDrives: ssfDrives = 17
 Dim Drive: Set Drive = sha.Namespace(ssfDrives).ParseName(CdDriveLetter & ":\")
 Drive.InvokeVerb("E&ject")
 End Sub
Sub Beep
 StdOut.write chr(7)
 End Sub

Author: Christian d'Heureuse (www.source-code.biz, www.inventec.ch/chdh)
Index