' 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