' makedist.vbs ' ' By: Tony Nelson on 4 Mar 05 ' ' Description: Make a "distributable": make a project backup as a .zip file, ' .zip the executable into my ftp folder, along with the source if requested. ' Rebuildable files are removed from the backup, though the .map and .pdb ' debugging files are kept. The Debug and Release folders are removed from ' the source. Additional folders can be added to the backup (and source). ' ' Usage: makedist exeName projectFolder [otherFolder]... [/s[name]] [/d] [-name]... ' ' Set the current directory to contain the .\Backup folder, and usually ' the project folder. ' ' /s Distribute the source. ' /sname ...naming the .zip file "name". ' ' /d Use the .exe's modified date instead of its version resource for ' the backup folder name suffix. ' ' -name Omit files named "name" or extended ".name", or folders if "\name". ' ' otherFolder will be included in the backup and source distribution. ' ' The .zip'ing is done with Info-Zip's zip.exe from ' <http://www.info-zip.org/pub/infozip/Zip.html> ' ' -- currently, zip.exe is just in the same directory as this script. ' ' -- if things don't work, uncomment the MsgBox call in sub Trace. If "zip ' had nothing to do" either all files were up to date in the zip file or the ' files to archive went to the wrong place. option explicit ' Globals ' const distLoc = "E:\Inetpub\ftproot\" const backupLoc = ".\Backups\" dim excludeFiles, excludeFolders excludeFiles = ":.sbr:.pch:.obj:.res:.idb:.aps:.ncb:.opt:.plg:.bsc:.ilk:" excludeFolders = ":\debug:\release:\backups:" ' dim fso, wshell, scriptName, scriptDir, failed, tmpDestFldr, tmpDistFldr set fso = CreateObject( "Scripting.FileSystemObject" ) set wshell = WScript.CreateObject( "WScript.Shell" ) scriptName = WScript.ScriptName scriptDir = fso.GetParentFolderName( WScript.ScriptFullName ) & "\" failed = false set tmpDestFldr = nothing set tmpDistFldr = nothing sub Trace( msg ) 'MsgBox msg, 0, scriptName & " trace" end sub sub ErrBox( msg ) MsgBox msg, vbCritical, scriptName failed = true end sub function GetArgs( byref fldrs, byref fSource, byref distName, byref fDate ) redim fldrs(0) fSource = false distName = "" fDate = false dim args, gotArgs, i, n set args = WScript.Arguments n = args.count gotArgs = 0 redim fldrs(n-1) for i = 0 to args.count-1 dim larg larg = lcase( args(i) ) if strcomp("/s", left(larg,2)) = 0 then fSource = true distName = mid( args(i), 3 ) elseif strcomp("/d", larg) = 0 then fDate = true elseif strcomp("-", left(larg,1)) = 0 then dim name name = lcase( mid(args(i), 2) ) if name = "" then ' nothing elseif left(name,1) = "\" then excludeFolders = excludeFolders & name & ":" else excludeFiles = excludeFiles & name & ":" end if else fldrs(gotArgs) = args(i) gotArgs = gotArgs + 1 end if next if gotArgs < 2 then ErrBox "Usage: makedist exeName projectDir [otherDirs]... [/s[name]] [/d] [-name]..." & vbcr _ & "eg: makedist ""Lines.exe"" ""Lines & Bubbles"" Common /s" & vbcr _ & " set current directory to contain """ & backupLoc & """ folder" & vbcr _ & " /s = distribute source code [as name]" & vbcr _ & " /d = use executable mod date instead of version number" & vbcr _ & " -name = omit files or \folders named name" GetArgs = false exit function end if redim preserve fldrs(gotArgs-1) GetArgs = true end function sub MakeDistImpl( fldrs, fSource, distName, fDate ) dim proj, exe exe = fldrs(0) proj = fldrs(1) if not fso.FolderExists(proj) then ErrBox "Source folder """ & proj & """ doesn't exist." exit sub end if dim i, fldrNames() redim fldrNames( uBound(fldrs) ) for i = 1 to UBound(fldrs) if not fso.FolderExists(fldrs(i)) then ErrBox "Other folder """ & fldrs(i) & """ doesn't exist." exit sub end if fldrNames(i) = fso.GetFileName(fldrs(i)) next dim exeName, exePath exeName = fso.GetFileName( exe ) exePath = proj & "\Release\" & exe if not fso.FileExists(exePath) then exePath = proj & "\" & exe if not fso.FileExists(exePath) then ErrBox "Project """ & proj & """ doesn't seem to be built." exit sub end if end if if not fso.FolderExists(backupLoc) then ErrBox "The """ & backupLoc & """ folder doesn't exist." & vbcr _ & "Either create it or set the directory to start in in" & vbcr _ & "the shortcut (.lnk) file." exit sub end if ' Set up paths. Use full paths as we change the current directory. ' dim backupFldrPath, destZipPath, distZipPath, exeZipPath dim srcName, destName, suffix, tempFldr ' temporaries srcName = fldrNames(1) if fDate then dim dlm dlm = fso.GetFile(exePath).DateLastModified suffix = Right(Year(dlm), 2) & Right("0" & Month(dlm), 2) & Right("0" & Day(dlm), 2) _ & "_" & Right("0" & Hour(dlm), 2) & Right("0" & Minute(dlm), 2) else suffix = fso.GetFileVersion(exePath) if suffix = "" then ErrBox "No version resource in """ & exe & """." exit sub end if end if destName = srcName & " " & suffix backupFldrPath = fso.GetAbsolutePathName(backupLoc) & "\" & srcName & "\" destZipPath = backupFldrPath & destName & ".zip" if distName = "" then distName = srcName if fso.GetExtensionName(distName) = "" then distName = distName & ".zip" distZipPath = distLoc & distName exeZipPath = distLoc & fso.GetBaseName( exeName ) set tempFldr = fso.GetSpecialFolder(2) set tmpDestFldr = fso.CreateFolder( tempFldr.Path & "\" & fso.GetTempName() ) set tmpDistFldr = fso.CreateFolder( tempFldr.Path & "\" & fso.GetTempName() ) set tempFldr = nothing if fso.FileExists(destZipPath) then ErrBox "Backup """ & destZipPath & """ already exists." exit sub end if ' Done with checks, start making changes ' if not fso.FolderExists(backupFldrPath) then fso.CreateFolder( backupFldrPath ) end if if fSource and fso.FileExists(distZipPath) then fso.DeleteFile( distZipPath ) end if if fso.FileExists(exeZipPath) then fso.DeleteFile( exeZipPath ) end if ' Copy (exclude) to temp folders. All the folder parameters are in a row, so ' a single loop will get them all, even the project folder. ' for i = 1 to UBound(fldrs) CopyFolderExclude fldrs(i), tmpDestFldr.Path & "\" & fldrNames(i), excludeFiles next if fSource then for i = 1 to UBound(fldrs) CopyFolderExclude tmpDestFldr.Path & "\" & fldrNames(i), _ tmpDistFldr.Path & "\" & fldrNames(i), excludeFolders next end if ' Do the zip'ing from the temp folders. Control the current directory so the ' .zip file has only the relevent directory hierarchy. ' dim ocd, e ocd = wshell.CurrentDirectory wshell.CurrentDirectory = tmpDestFldr.Path for i = 1 to UBound(fldrs) e = ZipIt( destZipPath, fldrNames(i) ) if e <> 0 then exit for next wshell.CurrentDirectory = tmpDistFldr.Path if e = 0 and fSource then for i = 1 to UBound(fldrs) e = ZipIt( distZipPath, fldrNames(i) ) if e <> 0 then exit for next end if wshell.CurrentDirectory = ocd wshell.CurrentDirectory = fso.GetAbsolutePathName( fso.GetParentFolderName(exePath) ) if e = 0 then e = ZipIt( exeZipPath, exeName ) wshell.CurrentDirectory = ocd if e <> 0 then dim m(18), msg m(0) = "" m(1) = "" m(2) = "unexpected end of zip file" m(3) = "error in zip file (may be OK)" m(4) = "out of memory" m(5) = "severe error in zip file" m(6) = "entry too large to split, read, or write" m(7) = "invalid comment format" m(8) = "-T integrety test failed" m(9) = "user abort (Ctrl-C)" m(10) = "error with zip temp file" m(11) = "read or seek error (bummers)" m(12) = "zip had nothing to do" m(13) = "missing or empty zip file" m(14) = "write error (bummers)" m(15) = "unable to create file" m(16) = "bad command line parameters" m(17) = "" m(18) = "can't open a file" msg = "" if e >= 0 and e <= ubound(m) then msg = m(e) if msg <> "" then msg = "," & vbcr & msg & "." ErrBox "Trouble zipping, exit code " & e & msg end if end sub sub CopyFolderExclude( src, dest, excludes ) ' ' Copy a folder and its subfolders, excluding files with extensions listed in ' excludes, like XCOPY. Iterate over the files, copying as indicated, and ' then recurse over the folders. dim srcFld, destFld set srcFld = fso.GetFolder( src ) set destFld = fso.CreateFolder( dest ) Trace "copy folder """ & srcFld.Path & """" & vbcr _ & "to """ & destFld.Path & """" & vbcr _ & "excluding """ & excludes & """" dim file, files set files = srcFld.Files for each file in files if instr(excludes, ":." & lcase(fso.GetExtensionName(file.name)) & ":") = 0 _ and instr(excludes, ":" & lcase(file.name) & ":") = 0 then file.Copy( destFld.Path & "\" & file.name ) end if next dim folder, folders set folders = srcFld.SubFolders for each folder in folders if instr(excludes, ":\" & lcase(folder.name) & ":") = 0 then CopyFolderExclude folder.path, dest & "\" & folder.name, excludes end if next end sub function ZipIt( dest, src ) ' return exit code dim cmd cmd = """" & scriptDir & "zip.exe"" -r -q -8 """ & dest & """ """ & src & """" ZipIt = wshell.run( cmd, 0, true ) ' hidden window, wait for completion Trace cmd & vbcr & wshell.CurrentDirectory & vbcr & "exit " & ZipIt end function ' main program ' dim fldrs(), fSource, distName, fDate if GetArgs(fldrs, fSource, distName, fDate) then call MakeDistImpl( fldrs, fSource, distName, fDate ) end if ' Clean up, deleting temp folders. ' if not tmpDestFldr is nothing then tmpDestFldr.Delete( true ) if not tmpDistFldr is nothing then tmpDistFldr.Delete( true ) 'Trace "end" if not failed then wshell.Popup "Done", 1, scriptName end if