Re: Creating remote objects
From: Erich Neuwirth (erich.neuwirth_at_univie.ac.at)
Date: 05/13/04
- Next message: Lift Off: "Re: Open file saved as today's date"
- Previous message: Luong: "Re: HLOOKUP or VLOOKUP help"
- In reply to: Erich Neuwirth: "Re: Creating remote objects"
- Messages sorted by: [ date ] [ thread ]
Date: Fri, 14 May 2004 00:53:22 +0200 To: Erich Neuwirth <erich.neuwirth@univie.ac.at>
Well, I have to correct my forst answer.
The code with Tom Ogilvy's correction (given at the end)
almost does the trick,
but not fully so. Excel almost always crashes when
it is closed after the code has been run.
I tried this eowth XL2K, XLXP, and XL2K3.
I do have a DLL written in C which does the trick.
The problem is that It has to be loaded with a declatre statement,
and for that the DLL has to be in the PATH.
Due to the nature of the project, it would be better if we can
avoid adding to the path.
Can anybody of the VBA masters on this list have a look at this code
and possibly translate it into VBA?
C/C++ code
-=-=-=-=-=-=-=-=-=-=-=-=
DLLTOOLS_API IDispatch* __stdcall CreateRemoteObject(char* pCLSID,char*
pServer)
{
COSERVERINFO lServer = { 0,NULL,NULL,0 };
HRESULT hr;
MULTI_QI lQI = { &IID_IDispatch,NULL,0 };
CLSID lCLSID;
char x[1024];
sprintf(x,"DLLTools> Creating remote object on server \"%s\", CLSID
\"%s\"\n",pServer,pCLSID);
OutputDebugString(x);
OLECHAR lServerStr[1024];
OLECHAR lCLSIDStr[1024];
MultiByteToWideChar(CP_ACP,MB_PRECOMPOSED,pCLSID,-1,lCLSIDStr,1024);
MultiByteToWideChar(CP_ACP,MB_PRECOMPOSED,pServer,-1,lServerStr,1024);
lServer.pwszName = lServerStr;
// try it as a progid first
hr = CLSIDFromProgID(lCLSIDStr,&lCLSID);
if(FAILED(hr)) {
hr = CLSIDFromString(lCLSIDStr,&lCLSID);
if(FAILED(hr)) {
sprintf(x,"DLLTools> could not interpret %s as a valid ProgID or
CLSID\n",pCLSID);
OutputDebugString(x);
return NULL;
}
}
hr = CoCreateInstanceEx(lCLSID,NULL,CLSCTX_ALL,&lServer,1,&lQI);
if(FAILED(hr)) {
sprintf(x,"DLLTools> CoCreateInstanceEx failed code %x\n",hr);
OutputDebugString(x);
return NULL;
}
return (IDispatch*) lQI.pItf;
}
Erich Neuwirth wrote:
> It took me long to answer.
> This code solves my Problem:
> It creates the server object on a remote machine
> without the need for a registry entry on the client machine.
>
>
> Thanks so much
>
>
> Tom Ogilvy wrote:
>
>> This creates an instance of Word on the local machine from Excel 2000, US
>> English, Win 2K. I don't have a remote server to go against. But if
>> this
>> works here, I suspect the problem with a remote server could be with
>> security settings. This article might give some insights:
>>
>> http://support.microsoft.com/default.aspx?scid=kb;en-us;174024
>> DCOM95 Frequently Asked Questions
>>
>> This article basically seems like it might have been the original
>> source for
>> the code you found, but there are some differences which might be
>> significant. Your code makes some assumptions about early and late
>> binding
>> and the use of the constant with a word guid seems strange if your not
>> going
>> against word.
>>
>> http://support.microsoft.com/default.aspx?scid=kb;en-us;180217&Product=vbb
>>
>> HOWTO: Control Server Location in a Visual Basic Client
>>
>>
>> Event though an instance of Word can be seen in the task manager (and
>> terminated there), I couldn't do much with the variable X. It doesn't
>> seem
>> to be the standard type of reference you get back from CreateObject. All
>> that said, under VBA6 (xl2000 and later), createobject has a second
>> argument
>> for servername
>>
>> CreateObject(class,[servername])
>>
>>
-=-=-=-=-=-=-=-=-=-=-=-=-=-
This is the corrected code
>>
>> 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
>>
>> Private Type MULTI_QI
>> piid As Long ' const IID*
>> pItf As Object ' IUnknown*
>> hr As Long ' HRESULT
>> End Type
>>
>> 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 GMEM_FIXED = &H0
>> Private Const IID_IDispatch As String = _
>> "{00020400-0000-0000-C000-000000000046}"
>> Private Declare Function GlobalAlloc Lib "kernel32" _
>> (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
>> Private Declare Function GlobalFree Lib "kernel32" _
>> (ByVal hMem As Long) As Long
>> Private Declare Function IIDFromString Lib "OLE32" _
>> (ByVal lpszIID As String, ByVal piid As Long) As Long
>> Private Declare Function CLSIDFromString Lib "OLE32" _
>> (ByVal lpszCLSID As String, pclsid As GUID) As Long
>> Private Declare Function CLSIDFromProgID Lib "OLE32" _
>> (ByVal lpszProgID As String, 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 lstrcpyW Lib "kernel32" _
>> (ByVal lpString1 As String, ByVal lpString2 As String) As Long
>>
>> Public Function CreateObjectEx(ByVal Class As String, _
>> Optional ByVal RemoteServerName As String = "") As Object
>> Dim rclsid As GUID
>> Dim hr As Long
>> Dim ServerInfo As COSERVERINFO
>> Dim Context As Long
>> Dim mqi As MULTI_QI
>>
>> mqi.piid = GlobalAlloc(GMEM_FIXED, 16)
>>
>> ' Convert the string version of IID_IDispatch to a binary IID.
>> hr = IIDFromString(StrConv(IID_IDispatch, vbUnicode), mqi.piid)
>> If hr <> 0 Then Err.Raise hr
>>
>> ' Convert the CLSID or ProgID string to a binary CLSID.
>> If ((Left(Class, 1) = "{") And (Right(Class, 1) = "}") And _
>> (Len(Class) = 38)) Then
>> ' Create a binary CLSID from string representation.
>> hr = CLSIDFromString(StrConv(Class, vbUnicode), rclsid)
>> If hr <> 0 Then Err.Raise hr
>> Else
>> ' Create a binary CLSID from a ProgID string.
>> hr = CLSIDFromProgID(StrConv(Class, vbUnicode), rclsid)
>> If hr <> 0 Then Err.Raise hr
>> End If
>>
>> ' Set up the class context.
>> If RemoteServerName = "" Then
>> Context = CLSCTX_SERVER
>> Else
>> Context = CLSCTX_REMOTE_SERVER
>> Dim MachineArray() As Byte
>> ReDim MachineArray(Len(StrConv(RemoteServerName, _
>> vbUnicode)) + 1)
>> ServerInfo.pwszName = lstrcpyW(MachineArray, _
>> StrConv(RemoteServerName, vbUnicode))
>> End If
>>
>> ' Create the object.
>>
>> hr = CoCreateInstanceEx(rclsid, 0, Context, ServerInfo, 1, mqi)
>> If hr <> 0 Then Err.Raise hr
>> GlobalFree mqi.piid
>> Set CreateObjectEx = mqi.pItf
>> End Function
>>
>> ' To use the CreateObjectEx function, simply put the code into any
>> ' Visual Basic module and then call it.
>> ' The class can take the form of a
>> ' programmatic identifier(ProgID) such as Word.Application or the
>> ' equivalent CLSID (in this case,
>> ' {000209FE-0000-0000-C000-000000000046}).
>> ' Note that if a ProgID is 'supplied, the local registry
>> ' is searched for the corresponding CLSID.
>> ' This function could be enhanced to read the remote computer's registry
>> ' instead.
>> ' The optional RemoteServerName parameter references
>> ' the computer on 'which the object is to be run.
>> ' If a remote server name is not provided,
>> ' the function creates the object on the local machine,
>> ' analogous to the behavior of the standard CreateObject function.
>> ' The RemoteServerName parameter can be set to the computer name
>> ' of the remote machine, as in \\server (or just server),
>> ' or the Domain Name System (DNS) name, such as server.com,
>> ' www.microsoft.com,
>> ' or 199.34.57.30.
>> ' The following code shows some sample invocations of the
>> ' CreateObjectEx function:
>>
>> Private Sub Form_Click()
>> Dim x As Object
>>
>>
>> ' Create object on local machine.
>> Set x = CreateObjectEx("{000209FE-0000-0000-C000-000000000046}")
>> ' x.Visible = True
>> Debug.Print TypeName(x)
>>
>> End Sub
>>
- Next message: Lift Off: "Re: Open file saved as today's date"
- Previous message: Luong: "Re: HLOOKUP or VLOOKUP help"
- In reply to: Erich Neuwirth: "Re: Creating remote objects"
- Messages sorted by: [ date ] [ thread ]
Relevant Pages
|
|
