' 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