How To Control Server Location in a Visual Basic Client

MORE INFORMATION

WARNING: ANY USE BY YOU OF THE CODE PROVIDED IN THIS ARTICLE IS AT YOUR OWN RISK. Microsoft provides this code "as is" without warranty of any kind, either express or implied, including but not limited to the implied warranties of merchantability and/or fitness for a particular purpose.

To use CreateObjectEx, add a module to your Visual Basic project and insert the following code into the module.

You may now call CreateObjectEx as follows:

   Dim obj As Object
   Set obj = CreateObjectEx("MyServer.MyClass", "ServerMachineName")
				

This will create an instance of MyServer.MyClass on the server.

Several formats are available for the arguments, and these are described in detail in the following section of this article.

A third argument is available to control the binding type. If you are using early binding, you may wish to use this syntax:

   Dim obj as MyServer.MyClass
   Set obj = CreateObjectEx("MyServer.MyClass", "ServerMachineName", _
                                     EARLY_BINDING)
				

The following code uses the DCOM CoCreateInstanceEx function to control the server location.

Option Explicit

   Private Type GUID
      Data1 As Long
      Data2 As Integer
      Data3 As Integer
      Data4(7) As Byte
   End Type

   Private Type COSERVERINFO
      dwReserved1 As Long  'DWORD
      pwszName As Long     'LPWSTR
      pAuthInfo As Long    'COAUTHINFO *
      dwReserved2 As Long  'DWORD
   End Type

   Type MULTI_QI
      pIID As Long   'const IID*
      pItf As Object 'Interface *
      hr As Long     'HRESULT
   End Type

   Public Enum BindingType
      EARLY_BINDING = 0
      LATE_BINDING = 1
   End Enum

   Public Enum CLSCTX
      CLSCTX_INPROC_SERVER = 1
      CLSCTX_INPROC_HANDLER = 2
      CLSCTX_LOCAL_SERVER = 4
      CLSCTX_REMOTE_SERVER = 16
      CLSCTX_SERVER = CLSCTX_INPROC_SERVER + CLSCTX_LOCAL_SERVER _
                        + CLSCTX_REMOTE_SERVER
      CLSCTX_ALL = CLSCTX_INPROC_SERVER + CLSCTX_INPROC_HANDLER _
                        + CLSCTX_LOCAL_SERVER + CLSCTX_REMOTE_SERVER
   End Enum

   Private Const IID_IUnknown As String = _
                            "{00000000-0000-0000-C000-000000000046}"
   Private Const IID_IDispatch As String = _
                            "{00020400-0000-0000-C000-000000000046}"

   Private Declare Function CLSIDFromString Lib "OLE32" _
            (ByVal lpszCLSID As Long, pclsid As GUID) As Long
   Private Declare Function CLSIDFromProgID Lib "OLE32" _
            (ByVal lpszProgID As Long, pclsid As GUID) As Long
   Private Declare Function CoCreateInstanceEx Lib "OLE32" _
            (rclsid As GUID, ByVal pUnkOuter As Long, _
            ByVal dwClsContext As Long, pServerInfo As COSERVERINFO, _
            ByVal cmq As Long, rgmqResults As MULTI_QI) As Long

   ' Public Function CreateObjectEx
   ' Creates an Instance of an OLE Server on a specified computer.
   '
   ' Arguments:
   '
   ' The Class argument specifies the OLE Server.
   ' There are two formats for the Class argument:
   '   1. PROGID: "Excel.Application"
   '   2. CLSID: "{00000010-0000-0010-8000-00AA006D2EA4}"
   ' If a ProgID is used, the client's registry is used to get the CLSID.
   '
   ' The Server argument specifies the server computer.
   ' There are two formats for the Server argument:
   '   1. UNC ("\\ServerName" or "ServerName")
   '   2. DNS ("server.sub.com" or "135.5.33.19")
   ' The Server argument is optional. If it is not supplied,
   ' the ole server is created on the client computer.
   '
   ' The Binding argument specifies the type of binding used by client.
   ' There are two values: EARLY_BINDING and LATE_BINDING.
   '
   ' If the client uses late binding (e.g. dim obj as Object),
   ' it must use the LATE_BINDING value or omit the Binding argument.
   ' If the client uses early binding (e.g. dim obj as MySvr.MyClass),
   ' it may use either LATE_BINDING or EARLY_BINDING.
   ' Some OLE servers will work only with LATE_BINDING, others
   ' only with EARLY_BINDING, and others with either binding type.
   ' OLE servers written in Visual Basic 5.0 support both binding types.
   '
   Public Function CreateObjectEx(ByVal Class As String, _
            Optional ByVal Server As String = "", _
            Optional Binding As BindingType = LATE_BINDING) As Object
   Dim rclsid As GUID
   Dim riid As GUID
   Dim hr As Long
   Dim ServerInfo As COSERVERINFO
   Dim mqi As MULTI_QI
   Dim Context As Long

   ' Convert IID string to binary IID
   If Binding = EARLY_BINDING Then
        hr = CLSIDFromString(StrPtr(IID_IUnknown), riid)
   Else
        hr = CLSIDFromString(StrPtr(IID_IDispatch), riid)
   End If
   If hr <> 0 Then Err.Raise hr

   'Setup the MULTI_QI structure.
   mqi.pIID = VarPtr(riid)

   'Convert provided CLSID or ProgID string into a binary CLSID
   If ((Left(Class, 1) = "{") And (Right(Class, 1) = "}") _
                    And (Len(Class) = 38)) Then
      hr = CLSIDFromString(StrPtr(Class), rclsid)
   Else
      hr = CLSIDFromProgID(StrPtr(Class), rclsid)
   End If
   If hr <> 0 Then Err.Raise hr

   'Decide on the appropriate context value.
   If Server = "" Then
      Context = CLSCTX_SERVER
   Else
      Context = CLSCTX_REMOTE_SERVER
   End If

   'Setup the COSERVERINFO structure.
   ServerInfo.pwszName = StrPtr(Server)

   ' Create an instance of the object
   hr = CoCreateInstanceEx(rclsid, CLng(0), Context, _
                            ServerInfo, CLng(1), mqi)
   If hr <> 0 Then Err.Raise hr

   Set CreateObjectEx = mqi.pItf

   End Function