install.vbs

6502 c compiler free open source

    ' Generate the filename
    on Error resume next
    set UninstallCtrlFile = FSO.CreateTextFile (UninstallCtrlFileName, true)
    on error goto 0
    if Err.Number <> 0 then
        dim Args(2)
        Args(1) = UninstallCtrlFileName
        Args(2) = Err.Description
        call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
        WScript.Quit (1)
    end if

    ' Write the name of the target directory to the file
    call WriteUninstallCtrlFile ("D " & InstallTarget)

    ' Write the name of the file itself to the file
    call WriteUninstallCtrlFile ("F " & UninstallCtrlFileName)

end sub



'******************************************************************************
' Write to the uninstall control file
'******************************************************************************
sub WriteUninstallCtrlFile (Line)

    on error resume next
    UninstallCtrlFile.WriteLine (Line)
    if Err.Number <> 0 then
        dim Args(2)
        Args(1) = UninstallCtrlFileName
        Args(2) = Err.Description
        call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
        WScript.Quit (1)
    end if

end sub



'******************************************************************************
' Close the uninstall control file
'******************************************************************************
sub CloseUninstallCtrlFile ()

    on error resume next
    UninstallCtrlFile.Close
    if Err.Number <> 0 then
        dim Args(2)
        Args(1) = UninstallCtrlFileName
        Args(2) = Err.Description
        call ErrorMsg (FmtMsg ("MSG_WRITEERR", Args))
        WScript.Quit (1)
    end if

end sub



'******************************************************************************
' Copy the application files
'******************************************************************************
sub RecursiveCopy (Dir, SourcePath, TargetPath)

    dim File, TargetFile, SubDir, SourceName, TargetName, Result, Args(3)

    ' Copy all files in this folder
    for each File in Dir.Files

        ' Generate source and target file names
        SourceName = BuildPath (SourcePath, File.Name)
        TargetName = BuildPath (TargetPath, File.Name)

        ' Copy the file. The error check doesn't seem to work.
        on error resume next
        File.Copy (TargetName)
        on error goto 0
        if Err.Number <> 0 then
            Args(1) = SourceName
            Args(2) = TargetName
            Args(3) = Err.Description
            call ErrorMsg (FmtMsg ("MSG_COPYERR", Args))
            call AbortInfo ()
        end if

        ' Remove the r/o attribute from the target file if set
        set TargetFile = FSO.GetFile (TargetName)
        if TargetFile.Attributes mod 2 = 1 then
            TargetFile.Attributes = TargetFile.Attributes - 1
        end if

        ' Remember this file in the uninstall control file
        call WriteUninstallCtrlFile ("F " & TargetName)
    next

    ' Handle all subdirectories
    for each SubDir in Dir.SubFolders

        ' Update the progress bar with each copied directory
        if PBVal <= 80 then
            call ProgressBar (PBVal + 5)
        end if

        ' Generate the new directory names
        SourceName = BuildPath (SourcePath, SubDir.Name)
        TargetName = BuildPath (TargetPath, SubDir.Name)

        ' Generate the new target dir. Notify the user about errors, but
        ' otherwise ignore them.
        Result = CreateFolder (TargetName)
        if Result <> "" then
            ' Display an error but try to continue
            Args(1) = TargetName
            Args(2) = Result
            call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
        end if

        ' Recursively process files in the subdirectory
        call RecursiveCopy (SubDir, SourceName, TargetName)

        ' Remember the subdirectory in the uninstall control file
        WriteUninstallCtrlFile ("D " & TargetName)

    next
end sub

sub CopyFiles ()

    ' Update the progress bar
    call ProgressBar (10)

    ' Copy all files generating entries in the uninstall control file
    call RecursiveCopy (FSO.GetFolder (InstallSource), InstallSource, InstallTarget)

    ' Update the progress bar
    call ProgressBar (90)
end sub



'******************************************************************************
' Create the registry entries
'******************************************************************************
sub CreateRegEntries ()

    dim Cmd

    ' Create the entry in Systemsteuerung -> Software. Check if the first write
    ' succeeds. If not, we don't have admin rights.
    if RegWriteBin (RegUninstall, 1) <> "" then
        call Abort (GetMsg ("MSG_REGWRITEERR"))
    end if
    call RegWriteStr (RegUninstall & "DisplayName", AppName & " " & Version)
    call RegWriteStr (RegUninstall & "UninstallString", "wscript //nologo " & Uninstaller & " " & UninstallerCmdLine)

end sub



'******************************************************************************
' Function that creates an URL
'******************************************************************************
sub CreateUrl (Name, Url, Description)
    ' Ignore errors
    On Error Resume Next

    dim Link
    set Link = Shell.CreateShortcut (Name)
    Link.TargetPath = Url
    Link.Description = Description
    Link.Save

    ' Allow errors again
    on error goto 0

    ' Write the file name to the uninstall control file
    WriteUninstallCtrlFile ("F " & Name)
end sub



'******************************************************************************
' Function that creates a shortcut
'******************************************************************************
sub CreateShortcut (Name, Exe, Args, Description)
    ' Ignore errors
    On Error Resume Next

    dim Link
    set Link = Shell.CreateShortcut (Name)
    Link.TargetPath  = Exe
    Link.Arguments   = Args
    Link.WindowStyle = 1
    Link.Description = Description
    Link.WorkingDirectory = AppData
    Link.Save

    ' Allow errors again
    on error goto 0

    ' Write the file name to the uninstall control file
    WriteUninstallCtrlFile ("F " & Name)
end sub



'******************************************************************************
' Function that creates the menu entries
'******************************************************************************
sub CreateMenuEntries ()
    dim Folder, Result, Name, Desc, Target, Args(2)

    ' Create the start menu folder.
    Folder = BuildPath (Programs, AppName)
    Result = CreateFolder (Folder)
    if Result <> "" then
        ' Display an error but try to continue
        Args(1) = Folder
        Args(2) = Result
        call ErrorMsg (FmtMsg ("MSG_CREATEERR", Args))
    end if

    ' Create an uninstall shortcut in the menu folder
    Args(1) = AppName
    Desc = FmtMsg ("MSG_REMOVEENTRY", Args)
    Name = BuildPath (Folder, Desc & ".lnk")
    call CreateShortcut (Name, Uninstaller, UninstallerCmdLine, Desc)

    ' Create a documentation shortcut in the menu folder
    Target = BuildPath (InstallTarget, DocIndexFile)
    if FileExists (Target) then
        Args(1) = AppName
        Desc = FmtMsg ("MSG_DOCENTRY", Args)
        Name = BuildPath (Folder, Desc & ".url")
        call CreateUrl (Name, "file://" & Target, Desc)
    end if

    ' Create the shortcut to the announcement in the menu folder
    Target = BuildPath (InstallTarget, AnnouncementFile)
    if FileExists (Target) then
        Desc = GetMsg ("MSG_ANNOUNCEMENT")
        Name = BuildPath (Folder, Desc & ".url")
        call CreateUrl (Name, "file://" & Target, Desc)
    end if

    ' Update the uninstall control file
    call WriteUninstallCtrlFile ("D " & Folder)
end sub



'******************************************************************************
' Add a directory to the system path
'******************************************************************************
sub AddToSysPath (Dir)

    dim Path

    ' Handle errors. Assume failure
    on error resume next

    ' Retrieve the PATH setting
    Path = Shell.RegRead (SysPath)
    if Err.Number <> 0 then
    	' Could not read
        call Abort (GetMsg ("MSG_REGREADERR"))
    end if

    ' Add the new directory to the path
    if (Len (Path) > 0) and (Right (Path, 1) <> ";") then
    	Path = Path + ";"
    end if
    Path = Path + Dir

    ' Write the new path
    call Shell.RegWrite (SysPath, Path, "REG_EXPAND_SZ")
    if Err.Number <> 0 then
    	' Could not set
        call Abort (GetMsg ("MSG_REGWRITEERR"))
    end if
end sub



'******************************************************************************
' Add environment variables
'******************************************************************************
sub AddEnvironment ()

    ' Add CC65_LIB
    if RegWriteStr (SysEnv & "\CC65_LIB", LibDir) <> "" then
        call Abort (GetMsg ("MSG_REGWRITEERR"))
    end if

    ' Add CC65_INC
    if RegWriteStr (SysEnv & "\CC65_INC", IncDir) <> "" then
        call Abort (GetMsg ("MSG_REGWRITEERR"))
    end if

    ' Add the bin directory to the path if it's not already there
    if not DirInPath (BinDir) then
	call AddToSysPath (BinDir)

	' Run the wm_envchange program to notify other running programs
	' of the changed environment. Ignore errors.
	call Run (BuildPath (BinDir, "wm_envchange.exe"), 0)
    end if

end sub



'******************************************************************************
' Function that tells the user that the install was successful
'******************************************************************************
sub Success ()
    call MsgBox (GetMsg ("MSG_SUCCESS"), vbOkOnly + vbInformation, Installer)
end sub



'******************************************************************************
' Main program
'******************************************************************************
sub Main ()

    ' Initialize global variables. This includes the paths used
    call InitializeGlobals ()
    if Dbg then
        call ShowPathsAndLocations ()
    end if

    ' Check that there's something to install
    call CheckFilesToInstall ()

    ' Check that we're running this script as admin
    call CheckAdminRights ()

    ' Check if there is an old installation and offer to remove it
    call CheckOldInstall ()

    ' Check if the source directory does really exist
    call CheckInstallTarget ()

    ' Display the progress bar
    call ProgressBar (0)

    ' Create the uninstall file
    call CreateUninstallCtrlFile ()
    call ProgressBar (2)

    ' Create registry entries
    CreateRegEntries ()
    call Progressbar (5)

    ' Copy the application files (will do automatic progress bar updates)
    call CopyFiles ()

    ' Create the menu entries
    call CreateMenuEntries ()
    call ProgressBar (90)

    ' Add entries to the enviroment
    call AddEnvironment ()
    call ProgressBar (95)

    ' Close the uninstall control file
    call CloseUninstallCtrlFile ()

    ' We're done
    call ProgressBar (100)
    call ProgressBar (-1)
    call Success ()

    ' Return a success code
    WScript.Quit (0)
end sub



'******************************************************************************
' The script body just calls Main...
'******************************************************************************
Main ()