在 VB6 的 运行 时间创建指定服务器的非排队远程 COM 对象

Create non-queued remote COM object specifying server at run time in VB6

我在 2 台远程服务器上的 COM 应用程序中安装了 COM+ dll。我已经从其中一台服务器导出了一个非排队代理并将其安装在客户端计算机上。

我希望能够指定在运行时实例化 COM 对象的远程服务器 - 代理安装包含我从中导出代理的机器的远程服务器名称,因此只需在客户端创建代理即可总是调用我从中导出它的机器,因为它是代理属性的一部分。

代理没有排队,所以我不能使用像queue:ComputerName=Server01/new:ComClass.Class这样的PathName调用GetObject的方法。

对于始终调用从中导出的远程服务器的非排队代理,我只使用 CreateObject(objectName),它将使用代理属性中的远程服务器名称。

经过一番搜索后,我找到了一个解决方案(在下面的自我回答中),但是是否有一种更简单的方法可以在 VB6 中执行此操作而无需使用 ole32.dll 函数?

编辑:在测试@Bob77 在评论中提出的解决方案后,使用服务器名称参数调用CreateObject 没有效果。仅使用概述的CreateRemoteObject方法实际调用指定服务器上的COM组件。

这可能是因为客户端调用来自 IIS 进程,并且远程服务器的 COM+ 应用程序的用户身份不同。

这可以使用 ole32.dll 库中的 CoCreateInstanceEx 函数来完成。

首先从ole32.dll声明需要的函数和相应的数据结构:

Private Type SERVER_STRUCTURE
   reserved1   As Long
   pServer     As Long
   AuthInfo    As Long
   reserved2   As Long
End Type

Private Type MULTI_QI
   pIID        As Long
   pInterface  As Object
   hResult     As Long
End Type

Private Declare Function CLSIDFromProgID Lib "ole32.dll" _
                 (progid As Any, clsid As Any) As Long

Private Declare Function OleInitialize Lib "ole32.dll" _
                 (ByVal Nullptr As Long) As Long

Private Declare Function CoCreateInstanceEx Lib "ole32.dll" _
                 (clsid As Any, ByVal pUnkOuter As Long, _
                  ByVal Context As Long, server As SERVER_STRUCTURE, _
                  ByVal nElems As Long, mqi As MULTI_QI) As Long

然后我使用此函数接收对象名称和服务器名称以及 returns 对象实例,这将是所需服务器的代理:

Private Function CreateRemoteObject(ByVal ObjectName As String, _
                   ByVal ByVal serverName As String) As Object

    Dim clsid(256) As Byte
    Dim progid() As Byte
    Dim server() As Byte
    Dim queryInterface As MULTI_QI
    Dim serverStructure As SERVER_STRUCTURE
    Dim refiid(16) As Byte
    Dim longReturnCode As Long
    Dim errorString As String

    errorString = ""

    GetInterfaceIDforIDispatch refiid()     ' set an interface ID for IDispatch
    queryInterface.pIID = VarPtr(refiid(0)) ' point to the interface ID
    progid = ObjectName & Chr$(0)           ' specify the object to be launched
    server = serverName & Chr$(0)           ' specify the server
    OleInitialize 0                         ' initialise OLE
    longReturnCode = CLSIDFromProgID(progid(0), clsid(0))   ' get the CLSID for the object

    If longReturnCode <> 0 Then
        errorString = "Unable to obtain CLSID from progid " & ObjectName
        App.LogEvent errorString, vbLogEventTypeError
        Exit Function
    End If

    ' point to server name and invoke a remote instance of the desired object
    serverStructure.pServer = VarPtr(server(0))
    longReturnCode = CoCreateInstanceEx(clsid(0), 0, 16, serverStructure, 1, queryInterface)

    If longReturnCode <> 0 Then
        errorString = "CoCreateInstanceEx failed with error code " & Hex$(longReturnCode)
        App.LogEvent errorString, vbLogEventTypeError
        Exit Function
    End If

    ' Pass back object ref
    Set CreateRemoteObject = queryInterface.pInterface
End Function

Private Sub GetInterfaceIDforIDispatch(p() As Byte)
    ' fills in the well-known IID for IDispatch into the byte array p.

    p(1) = 4
    p(2) = 2
    p(8) = &HC0
    p(15) = &H46
End Sub