MassMailer/tools/launch.vbs

' Launch the HTA only after the configured MDB passes a real connection check.
Option Explicit

Dim fs, shell, source, settings, desired, current, root, hostPath, dbPath
Dim db, rows, schemaVersion, htaPath, exitCode, checkOnly, childCommand, child, configPath
Set fs = CreateObject("Scripting.FileSystemObject")
Set shell = CreateObject("WScript.Shell")
source = fs.BuildPath(fs.GetParentFolderName(WScript.ScriptFullName), "common.vbs")
ExecuteGlobal fs.OpenTextFile(source, 1).ReadAll

checkOnly = (WScript.Arguments.Count > 0)
configPath = ConfigFilePath()
If checkOnly Then
    If LCase(WScript.Arguments(0)) <> "check" Or WScript.Arguments.Count > 2 Then
        StopWithError "Usage: launch.vbs [check [config path]]"
    End If
    If WScript.Arguments.Count = 2 Then configPath = WScript.Arguments(1)
End If

On Error Resume Next
Set settings = LoadConfig(configPath)
If Err.Number <> 0 Then StopWithError "Configuration: " & Err.Description
dbPath = ResolveDbPath(settings)
If Err.Number <> 0 Then StopWithError "Database path: " & Err.Description
On Error GoTo 0

desired = LCase(settings("DB_BITNESS"))
current = HostBitness()
If current <> desired Then
    hostPath = TargetHost(desired, current)
    If Not fs.FileExists(hostPath) Then StopWithError "Missing " & desired & " script host: " & hostPath
    childCommand = Quote(hostPath) & " //nologo " & Quote(WScript.ScriptFullName)
    If checkOnly Then childCommand = childCommand & " check " & Quote(configPath)
    Set child = shell.Exec(childCommand)
    WScript.Echo child.StdOut.ReadAll
    If Not child.StdErr.AtEndOfStream Then WScript.Echo child.StdErr.ReadAll
    exitCode = child.ExitCode
    WScript.Quit exitCode
End If

If Not fs.FileExists(dbPath) Then StopWithError "MDB not found: " & dbPath & _
    vbCrLf & "Run tools\init-db.vbs once in the configured " & desired & " host."
On Error Resume Next
Set db = CreateObject("ADODB.Connection")
db.Open "Provider=" & settings("DB_PROVIDER") & ";Data Source=" & dbPath & ";"
If Err.Number <> 0 Then StopWithError "Cannot open MDB with " & settings("DB_PROVIDER") & _
    " in " & desired & " host: " & Err.Description
Set rows = db.Execute("SELECT [SchemaVersion] FROM [AppMeta]")
If Err.Number <> 0 Then StopWithError "MDB schema check failed: " & Err.Description
If rows.EOF Then StopWithError "MDB AppMeta is empty"
schemaVersion = CLng(rows.Fields("SchemaVersion").Value)
If Err.Number <> 0 Then StopWithError "Invalid MDB schema version"
If schemaVersion <> 1 Then StopWithError "Unsupported MDB schema version: " & schemaVersion
rows.MoveNext
If Not rows.EOF Then StopWithError "MDB AppMeta has multiple version rows"
rows.Close
db.Close
On Error GoTo 0

root = ProjectRoot()
htaPath = fs.BuildPath(root, "MassMailer.hta")
If Not fs.FileExists(htaPath) Then StopWithError "HTA not found: " & htaPath
hostPath = fs.BuildPath(fs.GetParentFolderName(WScript.FullName), "mshta.exe")
If Not fs.FileExists(hostPath) Then StopWithError "HTA host not found: " & hostPath
WScript.Echo "MDB preflight passed (" & desired & ", schema 1): " & dbPath
If checkOnly Then WScript.Quit 0
shell.Run Quote(hostPath) & " " & Quote(htaPath), 1, False
WScript.Quit 0

Function HostBitness()
    Dim processEnv
    Set processEnv = shell.Environment("PROCESS")
    If InStr(LCase(WScript.FullName), "\syswow64\") > 0 Then
        HostBitness = "x86"
    ElseIf Len(processEnv("PROCESSOR_ARCHITEW6432")) > 0 Then
        HostBitness = "x86"
    ElseIf InStr(LCase(processEnv("PROCESSOR_ARCHITECTURE")), "64") > 0 Then
        HostBitness = "x64"
    Else
        HostBitness = "x86"
    End If
End Function

Function TargetHost(wanted, actual)
    Dim windowsPath
    windowsPath = shell.ExpandEnvironmentStrings("%SystemRoot%")
    If wanted = "x86" Then
        If fs.FolderExists(fs.BuildPath(windowsPath, "SysWOW64")) Then
            TargetHost = fs.BuildPath(windowsPath, "SysWOW64\cscript.exe")
        Else
            TargetHost = fs.BuildPath(windowsPath, "System32\cscript.exe")
        End If
    ElseIf actual = "x86" Then
        TargetHost = fs.BuildPath(windowsPath, "Sysnative\cscript.exe")
    Else
        TargetHost = fs.BuildPath(windowsPath, "System32\cscript.exe")
    End If
End Function

Function Quote(value)
    Quote = Chr(34) & value & Chr(34)
End Function

Sub StopWithError(message)
    WScript.Echo "ERROR: " & message
    WScript.Quit 1
End Sub