source: Include/com/vbobject.ab@ 232

Last change on this file since 232 was 208, checked in by イグトランス (egtra), 18 years ago

[207]参照型変数のNothing初期化に対応する修正
File size: 9.3 KB
RevLine 
[175]1' com/vbobject.ab
2
3#ifndef _COM_VBIBJECT_AB
4#define _COM_VBIBJECT_AB
5
6#include <com/variant.ab>
7
8Class VBObject
9Public
10 Sub VBObject()
11 pdisp = 0
12 End Sub
13
[192]14 Sub VBObject(className As String, pOuter As *IUnknown, clsContext As DWord)
15 VBObject(ToWCStr(className), pOuter, clsContext)
[175]16 End Sub
17
[192]18 Sub VBObject(className As PCSTR, pOuter As *IUnknown, clsContext As DWord)
19 VBObject(ToWCStr(className), pOuter, clsContext)
20 End Sub
21
22 Sub VBObject(className As PCWSTR, pOuter As *IUnknown, clsContext As DWord)
[175]23 pdisp = 0
24 Dim clsid As CLSID
25 Dim hr = _System_CLSIDFromString(className, clsid)
[192]26 VBObject(clsid, pOuter, clsContext)
[175]27 End Sub
28
[192]29 Sub VBObject(ByRef clsid As CLSID, pOuter As *IUnknown, clsContext As DWord)
30 Dim hr = CoCreateInstance(clsid, pOuter, clsContext, IID_IDispatch, pdisp)
31 End Sub
32
[175]33 Sub VBObject(ByRef obj As VBObject)
34 pdisp = obj.pdisp
35 pdisp->AddRef()
36 End Sub
37
38 Sub ~VBObject()
39 Clear()
40 End Sub
41
42 Sub Clear()
43 If pdisp <> 0 Then
44 pdisp->Release()
45 pdisp = 0
46 End If
47 End Sub
48
49 Function Operator [](name As PCWSTR) As DispatchCaller
50 Return GetCaller(name)
51 End Function
52
53 Function Operator [](name As String) As DispatchCaller
54 Return GetCaller(ToWCStr(name))
55 End Function
56
57 Function Equals(y As VBObject) As Boolean
[192]58 Return _System_COMReferenceEquals(pdisp, y.pdisp)
[175]59 End Function
60/*
61 Override Function GetHashCode() As Long
[192]62 Dim punk = _System_GetUnknown(pdisp)
[175]63 GetHashCode = _System_HashFromPtr(punk)
64 punk->Release()
65 End Function
66*/
67 Function Operator ==(y As VBObject) As Boolean
68 Return Equals(y)
69 End Function
70
71 Function Operator <>(y As VBObject) As Boolean
72 Return Not Equals(y)
73 End Function
74
75 Sub Assign(p As *IDispatch)
76 Clear()
77 VBObject.Copy(pdisp, p)
78 End Sub
79
[192]80 Function Copy() As *IDispatch
[175]81 VBObject.Copy(GetDispatch, pdisp)
82 End Function
83
84 Sub Attach(ByRef p As *IDispatch)
85 Clear()
86 VBObject.Move(pdisp, p)
87 End Sub
88
[192]89 Function Detach() As *IDispatch
[175]90 VBObject.Move(Detach, pdisp)
[192]91 End Function
92
93 Function Dispatch() As *IDispatch
94 Dispatch = pdisp
95 End Function
[175]96Private
97 Function GetCaller(name As PCWSTR) As DispatchCaller
98 Dim dispid As DISPID
99 Dim hr = pdisp->GetIDsOfNames(GUID_NULL, VarPtr(name), 1, LOCALE_USER_DEFAULT, VarPtr(dispid))
100 Return New DispatchCaller(pdisp, dispid)
101 End Function
102
103 pdisp As *IDispatch
104
105 Static Sub Copy(ByRef dst As *IDispatch, ByVal src As *IDispatch)
106 dst = src
107 dst->AddRef()
108 End Sub
109
110 Static Sub Move(ByRef dst As *IDispatch, ByRef src As *IDispatch)
111 dst = src
112 src = 0
113 End Sub
114End Class
115
116Class DispatchCaller
117Public
118 Sub DispatchCaller()
119 End Sub
120 Sub DispatchCaller(pDispatch As *IDispatch, dispatchId As DISPID)
121 pdisp = pDispatch
122 pdisp->AddRef()
123 dispid = dispatchId
124 End Sub
125
126 Sub DispatchCaller(ByRef dc As DispatchCaller)
127 pdisp = dc.pdisp
128 pdisp->AddRef()
129 dispid = dc.dispid
130 End Sub
131
132 Sub Operator =(ByRef dc As DispatchCaller)
133 Dispose()
134 DispatchCaller(dc)
135 End Sub
136
137 Sub Dispose()
138 If pdisp <> 0 Then
139 pdisp->Release()
140 pdisp = 0
141 End If
142 End Sub
143
144 Sub ~DispatchCaller()
145 Dispose()
146 End Sub
147
148 Function Prop() As Variant
149 Dim dispParams As DISPPARAMS
150 With dispParams
151 .rgvarg = 0
152 .rgdispidNamedArgs = 0
153 .cArgs = 0
154 .cNamedArgs = 0
155 End With
156 Dim ret As VARIANT
157 Dim hr = pdisp->Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_PROPERTYGET, dispParams, ret, 0, 0)
158 Dispose()
[208]159 Prop = New Variant
[175]160 v.Attach(ret)
161 Return v
162 End Function
163
164 Sub Prop(ByRef arg As Variant)
165 Prop(ByVal arg.PtrToVariant)
166 End Sub
167
168 Sub Prop(ByRef arg As VARIANT)
[192]169 setProp(arg, DISPATCH_PROPERTYPUT)
[175]170 End Sub
171
172 Sub PropRef(ByRef arg As Variant)
173 PropRef(arg.PtrToVariant)
174 End Sub
175
176 Sub PropRef(ByRef arg As VARIANT)
[192]177 setProp(arg, DISPATCH_PROPERTYPUTREF)
[175]178 End Sub
179
180 Function Call(cArgs As Long, args As *VARIANT) As Variant
181 Dim dispParams As DISPPARAMS
182 With dispParams
183 .rgvarg = args
184 .rgdispidNamedArgs = 0
185 .cArgs = cArgs
186 .cNamedArgs = 0
187 End With
188 Dim ret As VARIANT
189 Dim hr = pdisp->Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_METHOD, dispParams, ret, ByVal 0, 0)
190 Dispose()
191 Dim v = New Variant
192 v.Attach(ret)
193 Return v
194 End Function
195
196' Function Call(cArgs As Long, args As *Variant) As Variant
197' End Function
198
199 Function Call() As Variant
200 Return Call(0, 0)
201 End Function
202
[200]203 Function Call(arg0 As Variant) As Variant
204 Return Call(1, arg0.PtrToVariant)
[175]205 End Function
206
[200]207 Function Call(arg0 As Variant, arg1 As Variant) As Variant
208 Dim arg[ELM(2)] As VARIANT
209 arg[0] = arg0.Copy()
210 arg[1] = arg1.Copy()
211 Return Call(2, arg)
212 End Function
[192]213
[200]214 Function Call(arg0 As Variant, arg1 As Variant, arg2 As Variant) As Variant
215 Dim arg[ELM(3)] As VARIANT
216 arg[0] = arg0.Copy()
217 arg[1] = arg1.Copy()
218 arg[2] = arg2.Copy()
219 Return Call(3, arg)
[175]220 End Function
221
[200]222 Function Call(arg0 As Variant, arg1 As Variant, arg2 As Variant, arg3 As Variant) As Variant
223 Dim arg[ELM(4)] As VARIANT
224 arg[0] = arg0.Copy()
225 arg[1] = arg1.Copy()
226 arg[2] = arg2.Copy()
227 arg[3] = arg3.Copy()
228 Return Call(4, arg)
229 End Function
230
231/*
232 Function Call(arg0 = Variant.OptionalParam As Variant, arg1 = Variant.OptionalParam As Variant,
233 arg2 = Variant.OptionalParam As Variant, arg3 = Variant.OptionalParam As Variant,
234 arg4 = Variant.OptionalParam As Variant, arg5 = Variant.OptionalParam As Variant,
235 arg6 = Variant.OptionalParam As Variant, arg7 = Variant.OptionalParam As Variant,
236 arg8 = Variant.OptionalParam As Variant, arg9 = Variant.OptionalParam As Variant) As Variant
237 Dim arg[ELM(10)] As VARIANT
238 arg[0] = arg0.Copy()
239 arg[1] = arg1.Copy()
240 arg[2] = arg2.Copy()
241 arg[3] = arg3.Copy()
242 arg[4] = arg3.Copy()
243 arg[5] = arg4.Copy()
244 arg[6] = arg5.Copy()
245 arg[7] = arg6.Copy()
246 arg[8] = arg7.Copy()
247 arg[9] = arg8.Copy()
248 Return Call(10, arg)
249 End Function
250*/
[175]251Private
[192]252 Sub setProp(ByRef arg As VARIANT, callType As Word)
253 Dim dispidNamed = DISPID_PROPERTYPUT As DISPID
254 Dim dispParams As DISPPARAMS
255 With dispParams
256 .rgvarg = VarPtr(arg)
257 .rgdispidNamedArgs = VarPtr(dispidNamed)
258 .cArgs = 1
259 .cNamedArgs = 1
260 End With
261 Dim hr = pdisp->Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, callType, dispParams, ByVal 0, ByVal 0, 0)
262 Dispose()
263 End Sub
264
265
[175]266 pdisp As *IDispatch
267 dispid As DISPID
268End Class
[192]269
270Function CallByName(obj As VBObject, procName As String, callType As Word, cArgs As Long, args As *VARIANT) As Variant
271 Return CallByName(obj.Dispatch, ToWCStr(procName), callType, cArgs, args)
272End Function
273
274Function CallByName(obj As VBObject, procName As PCWSTR, callType As Word, cArgs As Long, args As *VARIANT) As Variant
275 Return CallByName(obj.Dispatch, procName, callType, cArgs, args)
276End Function
277
278Function CallByName(obj As *IDispatch, name As PCWSTR, callType As Word, cArgs As Long, args As *VARIANT) As Variant
279 Dim dispid As DISPID
280 Dim hr = obj->GetIDsOfNames(GUID_NULL, VarPtr(name), 1, LOCALE_USER_DEFAULT, VarPtr(dispid))
281 Dim dispParams As DISPPARAMS
282 With dispParams
283 .rgvarg = args
284 .rgdispidNamedArgs = 0
285 .cArgs = cArgs
286 .cNamedArgs = 0
287 End With
288 Dim ret As VARIANT
289 hr = obj->Invoke(dispid, GUID_NULL, LOCALE_USER_DEFAULT, DISPATCH_METHOD, dispParams, ret, ByVal 0, 0)
[208]290 CallByName = New Variant
[192]291 CallByName.Attach(ret)
292 Return CallByName
293End Function
294
[175]295Function CreateObject(className As PCWSTR) As VBObject
296 Return New VBObject(className)
297End Function
298
299Function CreateObject(className As String) As VBObject
300 Return New VBObject(ToWCStr(className))
301End Function
[192]302/*
[175]303#ifdef _WIN32_DCOM
304Function CreateObject(className As PCWSTR, serverName As PCWSTR) As VBObject
305 Dim clsid As CLSID
306 Dim si As COSERVERINFO
307 Dim context As DWord
[192]308 If /*Server = 0 OrElse* / Server[0] = 0 Then
309 context = CLSCTX_SERVER
310 Else
311 context = CLSCTX_REMOTE_SERVER
312 si.pwszName = serverName
313 End If
[175]314
315 Dim hr = _System_CLSIDFromString(className, clsid)
316
317 Dim mqi As MULTI_QI
318 mqi.pIID = VarPtr(IID_IUnknown)
319 hr = CoCreateInstanceEx(clsid, 0, context, si, 1, VarPtr(mqi))
320 If SUCCEEDED(hr) Then
321 Dim obj As VBObject
322 obj.Attach(mqi.pItf As IDispatch)
323 Return obj
324 Else
325 'Throw
326 Return Nothing
327 End If
[192]328End Function
[175]329
330Function CreateObject(className As String, serverName As String) As VBObject
331 Return CreateObject(ToWCStr(className), ToWCStr(serverName))
332End Function
333#endif
334*/
335Function _System_CLSIDFromString(pwString As PCWSTR, ByRef guid As GUID) As HRESULT
336 If pwString[0] = &h007b As WCHAR Then
[192]337 ' 1文字目が { ならクラスIDの文字列表現と見なしCLSIDFromStringで変換。
338 _System_CLSIDFromString = CLSIDFromString(pwString, guid)
339 Else
340 _System_CLSIDFromString = CLSIDFromProgID(pwString, guid)
341 End If
[175]342End Function
343
[192]344Function _System_COMReferenceEquals(p As *IUnknown, q As *IUnknown) As Boolean
345 If p = q Then
346 Return True
347 Else If p = 0 Or q = 0 Then
348 Return False
349 End If
350
351 Dim punkX = _System_GetUnknown(p)
352 Dim punkY = _System_GetUnknown(q)
353 If punkX = punkY Then
354 _System_COMReferenceEquals = True
355 Else
356 _System_COMReferenceEquals = False
357 End If
358 punkX->Release()
359 punkY->Release()
360End Function
361
362Function _System_GetUnknown(p As *IUnknown) As *IUnknown 'pは任意のCOMインタフェース
363 If FAILDED(pdisp->QueryInterface(IID_Unknown, _System_GetUnknown)) Then
364 GetUnknown = 0
365 End If
366End Function
367
[175]368#endif '_COM_VBIBJECT_AB
Note: See TracBrowser for help on using the repository browser.