'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Copy Cd to Disk ' ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Option Explicit Const WINDOW_HANDLE = 0 Const NO_OPTIONS = 0 Const FOF_CREATEPROGRESSDLG = &H0& Const REQUIREDSPACE = 755000000 Const DriveTypeRemovable = 1 Const DriveTypeFixed = 2 Const DriveTypeNetwork = 3 Const DriveTypeCDROM = 4 Const DriveTypeRAMDisk = 5 Dim objShell Dim objFolder, objFolderItem, objDestFolder Dim objPath Dim fso, f1 Dim driveSource, driveDestination Set objShell = CreateObject("Shell.Application") Set fso = CreateObject("Scripting.FileSystemObject") Set objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, "Select a destination folder:", NO_OPTIONS, "C:\Program Files\CT5") Set objFolderItem = objFolder.Self objPath = objFolderItem.Path Set driveDestination = fso.GetDrive(fso.GetDriveName(objPath)) If driveDestination.AvailableSpace < REQUIREDSPACE Then Wscript.Echo "So sorry, not enough free space on drive " & driveDestination.DriveLetter Else Set driveSource = fso.GetDrive(GetSourceDrive(fso)) Set objDestFolder = objShell.NameSpace(objPath) objDestFolder.CopyHere driveSource.DriveLetter & ":\*.*", FOF_CREATEPROGRESSDLG MakeDesktopShortcut fso, "Chinese Treasures", objPath & "\index.html", objPath & "\dbs\images\favicon.ico" End If Function GetSourceDrive(FSO) Dim Drives Dim Drive Dim f1 On error resume Next Set Drives = FSO.Drives For Each Drive In Drives If Drive.IsReady And (Drive.DriveType = DriveTypeCDROM) Then if FSO.FileExists(Drive.DriveLetter & ":\index.html") then Exit For End If End If Next GetSourceDrive = Drive.DriveLetter End Function Function MakeDesktopShortcut(FSO, name, target, targetIcon ) Dim WSHShell Set WSHShell = WScript.CreateObject("WScript.Shell") Dim Shortcut,DesktopPath,StartupPath DesktopPath = WSHShell.SpecialFolders("Desktop") Set Shortcut = WSHShell.CreateShortcut(DesktopPath & "\" & name & ".lnk") Shortcut.TargetPath = target Shortcut.IconLocation = targetIcon StartupPath = FSO.GetParentFolderName( target ) If FSO.FolderExists( StartupPath ) then Shortcut.WorkingDirectory = StartupPath End If Shortcut.Save End Function