Attribute VB_Name = "CoCreateInstanceExModule"
' Module: CoCreateInstanceExModule
'
' Description: Misc. functions and procedures
'
' Taken from Microsoft Corp. MSDN website (http:\\msdn.microsoft.com)
'
' Copyright © 2002 Intuit Inc. All rights reserved.
' Use is subject to the terms specified at:
' http://developer.intuit.com/legal/devsite_tos.html
'
'--------------------------------------------------------------------
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
Private Declare Function api_GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function api_GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function GetUser()
Dim Buff As String
Dim BuffSize As Long
Dim result As Long
BuffSize = 256
Buff = Space$(BuffSize)
result = api_GetUserName(Buff, BuffSize)
GetUser = Trim$(Buff)
End Function
Public Function GetComputerName()
Dim Buff As String
Dim BuffSize As Long
Dim result As Long
BuffSize = 256
Buff = Space$(BuffSize)
result = api_GetComputerName(Buff, BuffSize)
GetComputerName = Trim$(Buff)
End Function
Public Function CreateObjectEx(ByVal Class As String, Optional ByVal Server As String = "", Optional Binding As BindingType = LATE_BINDING) As Object
' 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.
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 using CoCreateInstanceEx
hr = CoCreateInstanceEx(rclsid, CLng(0), Context, _
ServerInfo, CLng(1), mqi)
If hr <> 0 Then Err.Raise hr
Set CreateObjectEx = mqi.pItf
End Function
