[原创] 强制VBS以32位模式运行，修正VBS在64位系统下“ActiveX部件不能创建对象”错误

yu2n

名称：强制 VBS 以 32 位模式运行
功能：修正 VBS 在 Windows 7 等 64 位系统中无法调用32位组件的问题

RunAsX64
Test

Sub Test()
  Set sc = CreateObject("ScriptControl")    ' 64 位模式下提示：ActiveX部件不能创建对象:'ScriptControl'
  sc.Language = "javascript"
  t = sc.eval("new Date().getTime()")
  Msgbox t
End Sub

' RunAsX64() By Yu2n
' 64位系统下强制以32位模式运行脚本
' 示例：在代码开头加上 RunAsX64 ...
Sub RunAsX64()
  On Error Resume Next
  If InStr(1,WScript.FullName,"\SysWOW64\",vbTextCompare) > 0 Then Exit Sub
  Dim wso, sCommand, sArgs
  Set wso = CreateObject("WScript.Shell")
  If wso.Run("cmd /c set ProgramFiles|find /i ""x86"" ",0,True) = 0 Then
    If Err.Number = 0 Then
      sCommand = "%windir%\SysWOW64\cscript.exe //NoLogo """ & WScript.ScriptFullName & """"
      For Each oArg In WScript.Arguments
        sArgs = sArgs & " " & """" & oArg & """"
      Next
      wso.Run sCommand & sArgs, 1, False
      WScript.Quit
    End If
  End If
End Sub
复制代码

' Is64OS() By Yu2n
' 示例：If Is64OS() = True Then ...
' Ps: 已堕落到不执着于 “纯” VBS
Function Is64OS()
  On Error Resume Next
  Is64OS = False
  Set wso = CreateObject("WScript.Shell")
  If wso.Run("cmd /c set ProgramFiles|find /i ""x86"" ",0,True) = 0 Then
    If Err.Number = 0 Then Is64OS = True
  End If
End Function
复制代码

CrLf

64 位系统使用组件很尴尬
以 64 位运行时不支持 tli 等 32 位组件，而以 32 位运行时，(new ActiveXObject('Shell.Application')).Windows() 得到的结果不能正常解析

yu2n

回复 2# CrLf
囧，那就看情况编写代码吧。