如何从Visual Basic 6程序向后台VBScript定时传递变量？

Hey Tuncay, great question! Ditching temp files is definitely a cleaner approach—here are some solid alternatives for inter-process communication between your VB6 app and background VBScript:

1. Use WM_COPYDATA Messages #

This is Windows' native IPC mechanism for passing structured data between processes. The catch is your VBScript needs a hidden window to receive messages (since Windows messages require a window handle).

VB6 Sender Code #

Private Const WM_COPYDATA = &H4A
Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As String
End Type

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Sub SendVarToVBS(varValue As String)
    Dim hWndVBS As Long
    Dim cds As COPYDATASTRUCT
    
    ' Target the hidden window your VBScript creates (use a unique window title)
    hWndVBS = FindWindow(vbNullString, "VBScriptIPCListener")
    If hWndVBS = 0 Then Exit Sub
    
    cds.dwData = 1 ' Custom identifier to flag your message
    cds.cbData = Len(varValue) + 1 ' Include null terminator
    cds.lpData = varValue
    
    SendMessage hWndVBS, WM_COPYDATA, Me.hwnd, cds
End Sub

VBScript Receiver Code #

' Declare required Windows APIs
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (lpWndClass As WNDCLASS) As Integer
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Type WNDCLASS
    style As Long
    lpfnWndProc As Long
    cbClsExtra As Long
    cbWndExtra As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As String
    lpszClassName As String
End Type

Private Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt_x As Long
    pt_y As Long
End Type

Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As String
End Type

Private Const WM_COPYDATA = &H4A
Private Const WS_OVERLAPPEDWINDOW = &HCF0000
Private Const CS_HREDRAW = &H2
Private Const CS_VREDRAW = &H1

Dim g_hwnd As Long

Sub Main()
    ' Register a window class
    Dim wc As WNDCLASS
    wc.style = CS_HREDRAW Or CS_VREDRAW
    wc.lpfnWndProc = GetAddressOf(WndProc)
    wc.lpszClassName = "VBSIPCClass"
    wc.hbrBackground = 1 ' White background (irrelevant for hidden window)
    
    RegisterClass wc
    
    ' Create a tiny hidden window
    g_hwnd = CreateWindowEx(0, "VBSIPCClass", "VBScriptIPCListener", WS_OVERLAPPEDWINDOW, 0, 0, 1, 1, 0, 0, 0, 0)
    
    ' Start message loop to listen for incoming data
    Dim msg As MSG
    Do While GetMessage(msg, g_hwnd, 0, 0) > 0
        TranslateMessage msg
        DispatchMessage msg
    Loop
End Sub

Function WndProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If wMsg = WM_COPYDATA Then
        ' Parse the incoming data structure
        Dim cds As COPYDATASTRUCT
        CopyMemory cds, ByVal lParam, Len(cds)
        Dim receivedVar As String
        receivedVar = Left(cds.lpData, cds.cbData - 1) ' Remove null terminator
        
        ' Process the variable here (e.g., log it, use it in your script)
        WScript.Echo "Received from VB6: " & receivedVar
        
        WndProc = 1 ' Signal successful processing
        Exit Function
    End If
    
    WndProc = DefWindowProc(hwnd, wMsg, wParam, lParam)
End Function

' Helper to get function address required for window procedure
Function GetAddressOf(func)
    GetAddressOf = FuncPtr(func)
End Function

Main()

2. Use Temporary Registry Keys #

A lightweight option using the Windows Registry as a shared storage space. VB6 writes to a dedicated temporary key, and VBScript polls it at intervals.

VB6 Write Code #

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Const HKEY_CURRENT_USER = &H80000001
Private Const REG_SZ = 1
Private Const KEY_WRITE = &H20006

Sub WriteVarToRegistry(varValue As String)
    Dim hKey As Long
    Dim tempSubKey As String
    
    tempSubKey = "Software\TempVB6VBS_IPC"
    ' Open the key (create it first with RegCreateKeyEx if it doesn't exist)
    If RegOpenKeyEx(HKEY_CURRENT_USER, tempSubKey, 0, KEY_WRITE, hKey) <> 0 Then Exit Sub
    
    ' Write the variable value
    RegSetValueEx hKey, "AppVariable", 0, REG_SZ, ByVal varValue, Len(varValue) + 1
    RegCloseKey hKey
End Sub

VBScript Read Code #

Set objShell = CreateObject("WScript.Shell")
Dim currentValue

' Poll every 5 seconds for updates
Do
    On Error Resume Next
    currentValue = objShell.RegRead("HKCU\Software\TempVB6VBS_IPC\AppVariable")
    If Err.Number = 0 Then
        WScript.Echo "Current variable value: " & currentValue
    Else
        WScript.Echo "No value received yet"
        Err.Clear
    End If
    WScript.Sleep 5000
Loop

Pro tip: Don't forget to delete the temporary registry key when your app/script exits to avoid clutter.

3. Use WMI Events for Real-Time Updates #

WMI lets you create temporary dynamic classes. VB6 updates the class instance, and VBScript listens for modification events—no polling required.

VB6 Update Code #

Dim objWMIService As Object
Dim dynamicClass As Object
Dim dataInstance As Object

Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

' Create a temporary event class (exists only during the WMI session)
Set dynamicClass = objWMIService.Get().SpawnInstance_("__EventClass")
dynamicClass.Path_.Class = "VB6VBS_DataTransfer"
dynamicClass.Properties_.Add "VariableValue", 8 ' 8 = string data type
dynamicClass.Put_()

' Update the class instance with your variable value
Set dataInstance = objWMIService.Get("VB6VBS_DataTransfer").SpawnInstance_()
dataInstance.VariableValue = "YourVariableHere"
dataInstance.Put_()

VBScript Listener Code #

Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set eventWatcher = objWMIService.ExecNotificationQuery("SELECT * FROM __InstanceModificationEvent WHERE TargetInstance ISA 'VB6VBS_DataTransfer'")

WScript.Echo "Waiting for VB6 updates..."
Do
    Set receivedEvent = eventWatcher.NextEvent()
    Dim varValue
    varValue = receivedEvent.TargetInstance.VariableValue
    WScript.Echo "Received update: " & varValue
Loop

Each method has its strengths: registry is simplest for basic values, WM_COPYDATA works great for structured data, WMI avoids polling, and named pipes (another option not covered here) support bidirectional communication. Pick the one that fits your use case best!

内容的提问来源于stack exchange，提问作者Tuncay Özışık