Option Explicit

'Directory in which to install the script (it must end with a "\")
Const INSTALL_LOCATION = "%HOMEDRIVE%%HOMEPATH%\Scripts\vbs\Self Installer\%USERDOMAIN%\"

'When run after install is true, the installed script will be automatically run.
'When set to false, the script file will only be copied to the installation folder. 
Const RUN_AFTER_INSTALL = true

'If this script isn't being run from the install location, install it to that location
'If this script is being run from the install location then execute the main code
If ScriptLocation <> GetInstallLocation Then
    InstallScript RUN_AFTER_INSTALL
Else
    Main
End If


'############################################
' SUB ROUTINES
'############################################

'Main routine
Sub Main
    MsgBox "My file path is " & WScript.ScriptFullName, vbInformation, "Installed Script"
End Sub


'Install the script
Sub InstallScript(p_bRunAfterInstall)
    'Initialise
    Dim objFSO, objShell
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = Wscript.CreateObject("WScript.Shell")
    
    'If the install directory does not exist, create it (using a call out to the DOS command MKDIR
    If Not objFSO.FolderExists(GetInstallLocation) Then ExecCmd "mkdir """ & GetInstallLocation & """"

    'Copy the new script file into the install directory
    objFSO.CopyFile WScript.ScriptFullName, GetInstallLocation, true
    
    'Give the OS some time to copy if it is a bit laggy - seen occasional issues here
    Dim intCounter
    Const WAIT_MS = 100
    Const MAXTIME_MS = 4000
    intCounter = 0
    Do While Not(objFSO.FileExists(InstalledScriptPath) OR  intCounter > (MAXTIME_MS/WAIT_MS))
        WScript.Sleep WAIT_MS
        intCounter = intCounter + 1
    Loop
    'If the script wasn't copied output an error message, otherwise run if required.
    If objFSO.FileExists(InstalledScriptPath) Then
        If p_bRunAfterInstall then objShell.Run """" & InstalledScriptPath & """"
    Else
        MsgBox "Installation timed out.", vbCritical, "Installation"
    End If
End Sub


'Execute a DOS command
Sub ExecCmd(p_strDOSCmd)
    Dim objCommand
    Set objCommand = New clsDOSCommandExecutor
 
    objCommand.ExecuteCommand(p_strDOSCmd)
End Sub


'############################################
' FUNCTIONS
'############################################

'Return the directory the script is in
Function ScriptLocation()
    ScriptLocation = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
End Function


'Return the full path to the installed script
Function InstalledScriptPath()
    InstalledScriptPath = GetInstallLocation & WScript.ScriptName
End Function


'Return the installation directory with environment variables expanded
Function GetInstallLocation()
    GetInstallLocation = SubstituteEnvironmentVariables(INSTALL_LOCATION)
End Function


'Replace environment variables in a string (delimited by %'s) with the expanded values
Function SubstituteEnvironmentVariables(p_strInput)
    Dim objShell
    Dim astrInput, intItem
    Set objShell = Wscript.CreateObject("WScript.Shell")
    
    'Tokenise the input on percentages and initialise the return string
    astrInput = Split(p_strInput, "%")
    SubstituteEnvironmentVariables = ""
    
    'Work through the elements and carry out any substitutions
    For intItem = 0 to (UBound(astrInput))
        'If we're on an odd item it must be an environment variable
        If IsOdd(intItem) Then
            'Expand the environment variable
            SubstituteEnvironmentVariables = SubstituteEnvironmentVariables & objShell.ExpandEnvironmentStrings("%" & astrInput(intItem) & "%")
        Else
            SubstituteEnvironmentVariables = SubstituteEnvironmentVariables & astrInput(intItem)
        End If
    next
End Function


'Determine if a number is odd
Function IsOdd(p_intValue)
    'Set default
    IsOdd = false
    
    'Now check if there's a remainder from modulo 2
    If p_intValue mod 2 = 1 Then IsOdd = true
End Function

'############################################
' CLASSES
'############################################

'DOS command execution class
'Based on http://www.thoughtasylum.com/blog/2009/8/8/dos-command-class-for-vbscript.html
'Slight modification to enforce command extensions to be on as MKDIR will require this.
Class clsDOSCommandExecutor
    Dim objShell, objExec
    Dim strCommand
    Dim strError
    Dim objError
    Dim objOutput
    Dim strOutput
 
    Sub ExecuteCommand(p_strCommand)
        strCommand = "cmd /E:ON /c " & p_strCommand
        Set objShell = CreateObject("Wscript.Shell" )
 
        objShell.Exec(strCommand)
 
        Set objExec = objShell.Exec(strCommand)
 
        Do Until objExec.Status
            Wscript.Sleep 200
        Loop
 
        Set objError = objExec.StdErr
        strError = objError.ReadAll
 
        Set objOutput = objExec.stdOut
        strOutput = objOutput.ReadAll
    End Sub
 
    Function GetOutput()
        GetOutput = strOutput
    End Function
 
    Function GetError()
        GetError = strError
    End Function
 
    Function Failed()
        If strError = "" Then
            Failed = false
        Else
            Failed = true
        End If
    End Function
End Class

Buy me a coffee

Related posts that you may also like to read

• 

  VBScript: Flip Line Endings

  28 Jun 2015

  Recently I was working for a client who had particularly strict controls around access and tools that I could use. Whilst the bulk of the work I was carrying out on their Linux box could be managed using vi, I found it a little limiting when analysing some of the log files the work was producing. On the Windows machine I was using to access the files I only had Windows notepad and this really doesn’t handle Linux file endings well. As a result I put together a quick VBScript to help with this.

  Read More
• 

  Random Files Generator

  26 Aug 2013

  Whilst doing some house keeping on some old VBScript files the other day I came across one for creating test files. I’ve blogged previously about creating test files using my MTF utility and whilst it or fsutil can be very useful, this script filled a particular niche. It was created as part of a test suite of scripts it creates multiple files of a specific size filled with random printable content.

  Read More
• 

  VBScript to Convert Microsoft Office Files (Word, Excel, PowerPoint) to PDF

  20 Dec 2012

  I spend a lot of my time working with Word documents and Excel spreadsheets - it’s in the nature of what I do. I frequently found that I need to create PDF copies of these files (to send out to clients) and eventually I grew tired of having to open the files one by one and select to save each as a PDF. As a result I created a bit of VBScript to automatically convert files for me (in Windows).

  Read More
• 

  Converting ZIP files to 7Z archive file using VBScript and 7-Zip

  29 Nov 2012

  Whilst storage is continuing to get cheaper all the time I occasionally find myself needing to save some space. Usually where some cloud storage and archiving of old material is involved. ZIP files are very convenient for compressing files, but sometimes I need to go a step further. In these cases I opt for the 7z archive file format used in the free and portable software 7-Zip as I’ve always ended up with a smaller archive file.

  Read More