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