1 /******************************************************************************
2 *
3 * Copyright (C) 2004-2008, The Gentee Group. All rights reserved.
4 * This file is part of the Gentee open source project - http://www.gentee.com.
5 *
6 * THIS FILE IS PROVIDED UNDER THE TERMS OF THE GENTEE LICENSE ("AGREEMENT").
7 * ANY USE, REPRODUCTION OR DISTRIBUTION OF THIS FILE CONSTITUTES RECIPIENTS
8 * ACCEPTANCE OF THE AGREEMENT.
9 *
10 * Author: Alexander Krivonogov ( algen )
11 *
12 ******************************************************************************/
13
14 import "Oleaut32.dll"
15 {
16 uint SysAllocString( uint )
17 uint SysFreeString( uint )
18 uint SysAllocStringByteLen( uint, uint )
19 uint SysStringByteLen( uint )
20 }
21
22 //Типы VARIANT VARIANT.vt
23 define <export> {
24 VT_EMPTY = 0
25 VT_NULL = 1
26 VT_I2 = 2
27 VT_I4 = 3
28 VT_R4 = 4
29 VT_R8 = 5
30 VT_CY = 6
31 VT_DATE = 7
32 VT_BSTR = 8
33 VT_DISPATCH = 9
34 VT_ERROR = 10
35 VT_BOOL = 11
36 VT_VARIANT = 12
37 VT_UNKNOWN = 13
38 VT_DECIMAL = 14
39 VT_I1 = 16
40 VT_UI1 = 17
41 VT_UI2 = 18
42 VT_UI4 = 19
43 VT_I8 = 20
44 VT_UI8 = 21
45 VT_INT = 22
46 VT_UINT = 23
47 VT_VOID = 24
48 VT_HRESULT = 25
49 VT_PTR = 26
50 VT_SAFEARRAY = 27
51 VT_CARRAY = 28
52 VT_USERDEFINED = 29
53 VT_LPSTR = 30
54 VT_LPWSTR = 31
55 VT_RECORD = 36
56 VT_FILETIME = 64
57 VT_BLOB = 65
58 VT_STREAM = 66
59 VT_STORAGE = 67
60 VT_STREAMED_OBJECT = 68
61 VT_STORED_OBJECT = 69
62 VT_BLOB_OBJECT = 70
63 VT_CF = 71
64 VT_CLSID = 72
65 VT_BSTR_BLOB = 0xfff
66 VT_VECTOR = 0x1000
67 VT_ARRAY = 0x2000
68 VT_BYREF = 0x4000
69 VT_RESERVED = 0x8000
70 VT_ILLEGAL = 0xffff
71 VT_ILLEGALMASKED = 0xfff
72 VT_TYPEMASK = 0xfff
73 }
74
75 define {
76 FADF_AUTO = 0x1
77 FADF_STATIC = 0x2
78 FADF_EMBEDDED = 0x4
79 FADF_FIXEDSIZE = 0x10
80 FADF_RECORD = 0x20
81 FADF_HAVEIID = 0x40
82 FADF_HAVEVARTYPE = 0x80
83 FADF_BSTR = 0x100
84 FADF_UNKNOWN = 0x200
85 FADF_DISPATCH = 0x400
86 FADF_VARIANT = 0x800
87 FADF_RESERVED = 0xf008
88 }
89
90 type VARIANT {
91 ushort vt
92 ushort wReserved1
93 ushort wReserved2
94 ushort wReserved3
95 ulong val
96 }
97
98
99
100 type DISPPARAMS {
101 uint rgvarg // Array of arguments.
102 uint rgdispidNamedArgs // Dispatch IDs of named arguments.
103 uint cArgs // Number of arguments.
104 uint cNamedArgs // Number of named arguments.
105 }
106
107 type SAFEARRAYBOUND
108 {
109 uint cElements
110 int lLbound
111 }
112
113 type SAFEARRAY
114 {
115 ushort cDims
116 ushort fFeatures
117 ushort cbElements
118 ushort cLocks
119 ushort handle
120 ushort empty
121 uint pvData
122 SAFEARRAYBOUND rgsabound
123 }
124
125 /*-----------------------------------------------------------------------------
126 * Id: variant_clear F3
127 *
128 * Summary: Clears the variable contents, the storage area is released if
129 necessary. The VARIANT type is equal to VT_EMPTY. This method is
130 automatically called before a new value has been set .
131 *
132 -----------------------------------------------------------------------------*/
133
134 method VARIANT.clear()
135 {
136 if this.vt && !(this.vt & $VT_BYREF)
137 {
138 if this.vt & $VT_ARRAY
139 {
140 uint i, j, off, nums
141 uint sarr as uint(this.val)->SAFEARRAY
142 if (this.vt & $VT_TYPEMASK) == $VT_VARIANT
143 {
144 off = &sarr.rgsabound
145 nums = 1
146 fornum i = 0, sarr.cDims
147 {
148 nums = nums * off->SAFEARRAYBOUND.cElements
149 off += sizeof(SAFEARRAYBOUND)
150 }
151
152 off = sarr.pvData
153 fornum i = 0, nums
154 {
155 off->VARIANT.clear()
156 off += sizeof(VARIANT)
157 }
158 }
159 SysFreeString( sarr.pvData )
160 //SysFreeString( uint( this.val ) )
161 mfree( uint( this.val ) )
162 }
163 elif (this.vt & $VT_TYPEMASK) == $VT_BSTR
164 {
165 SysFreeString( uint(this.val) )
166 }
167 elif (this.vt & $VT_TYPEMASK) == $VT_DISPATCH
168 {
169 //print( "ddd \(this.val)\n" )
170 if this.val : ((uint(this.val)->uint+8)->uint)->stdcall(uint(this.val))
171 }
172 }
173 mzero( &this, sizeof( VARIANT ))
174 }
175
176 include {
177 "varconv.g"
178 }
179
180 method VARIANT.delete()
181 {
182 this.clear()
183 }
184
185 /*method VARIANT.arrgetptr( collection*/
186 /*-----------------------------------------------------------------------------
187 * Id: variant_arrcreate F2
188 *
189 * Summary: Creating the SafeArray array. This method creates the #b(SafeArray)
190 array in the variable of the VARIANT type. VARIANT is an
191 element of the array. Values can be assigned to the array
192 elements using the #a(variant_arrfromg) method. An element of
193 the array can be obtained with the help of the
194 #a(variant_arrgetptr) method.
195
196 #p[The example uses SafeArray]
197 #srcg[
198 |VARIANT v
199 |//An array with 3 lines and 2 columns is being created
200 |v.arrcreate( %{3,0,2,0} )
201 |
202 |v.arrfromg( %{0,0, 0.1234f} )
203 |v.arrfromg( %{0,1, int(100)} )
204 |v.arrfromg( %{2,1, "Test" } )
205 |...
206 |//The array is being transmitted to the COM object
207 |excapp~Range( excapp~Cells( 1, 1 ), excapp~Cells( 3, 2 ) ) = v]
208 #p[SafeArray allows you to group data, that makes data exchange with the COM object faster.]
209 *
210 * Params: bounds - The collection that contains array parameters. Two /
211 numbers are specified for each array dimension: the first /
212 number - an element quantity, the second number - a sequence /
213 number of the first element in the dimension.
214 *
215 * Return: #lng/retf#
216 *
217 -----------------------------------------------------------------------------*/
218
219 method uint VARIANT.arrcreate( collection bounds )
220 {
221 this.clear()
222 if *bounds > 1 && !(*bounds & 0x01)
223 {
224 uint sarr
225 uint els
226 int i
227 uint arrbound
228
229 this.vt = $VT_ARRAY | $VT_VARIANT//eltype
230 els = sizeof(SAFEARRAY) + sizeof(SAFEARRAYBOUND) * ( (*bounds >> 1) - 1 )
231 //sarr as SysAllocStringByteLen( 0, els - 1 )->SAFEARRAY
232 sarr as malloc( els + sizeof(SAFEARRAYBOUND) + 100 )->SAFEARRAY
233 //print( "alloc \(sizeof(SAFEARRAY) + sizeof(SAFEARRAYBOUND) *
234 //( (*bounds >> 1) -1 ))\n" )
235 mzero( &sarr, els )
236 this.val = ulong( &sarr )
237 sarr.cDims = *bounds >> 1
238 arrbound as sarr.rgsabound
239 els = 1
240 for i = *bounds-1, i>=0, i--
241 {
242 arrbound.lLbound = bounds[i--]
243 els *= bounds[i]
244 arrbound.cElements = bounds[i]
245 arrbound as uint
246 arrbound += sizeof(SAFEARRAYBOUND)
247 }
248 sarr.fFeatures = /*$FADF_HAVEVARTYPE*/ $FADF_VARIANT |$FADF_FIXEDSIZE
249 sarr.cbElements = sizeof(VARIANT)
250 els *= sarr.cbElements
251 sarr.pvData = SysAllocStringByteLen( 0, els - 1 )
252 mzero( sarr.pvData, els )
253 return 1
254 }
255 return 0
256 }
257
258 /*-----------------------------------------------------------------------------
259 * Id: variant_arrgetptr F2
260 *
261 * Summary: Obtaining a pointer to an element of the SafeArray array.
262 *
263 * Params: item - The collection that contains "coordinates" of an element.
264 *
265 * Return: The method returns address of an array element, if error occurs
266 it returns zero.
267 *
268 -----------------------------------------------------------------------------*/
269
270 method uint VARIANT.arrgetptr( collection item )
271 {
272 uint off
273
274 if this.vt & $VT_ARRAY &&
275 uint(this.val)->SAFEARRAY.cDims == *item
276 {
277 uint sa as uint(this.val)->SAFEARRAY
278 uint sba = &sa.rgsabound + sizeof( SAFEARRAYBOUND ) * (*item-1)
279 uint r
280 int i
281 for i = *item-1, i >= 0, i--
282 {
283 off = off + item[i] - sba->SAFEARRAYBOUND.lLbound
284 if i > 0
285 {
286 off *= sba->SAFEARRAYBOUND.cElements
287 }
288 sba -= sizeof( SAFEARRAYBOUND )
289 }
290 off = sa.pvData + off * sa.cbElements
291 }
292 return off
293 }
294
295 /*-----------------------------------------------------------------------------
296 ** Id: variant_arrfromg F2
297 *
298 * Summary: Assigning a value to an element of the SafeArray array. Example
299 #srcg[
300 |v.arrfromg( %{0,0, 0.1234f} )
301 |v.arrfromg( %{0,1, int(100)} )
302 |v.arrfromg( %{2,1, "Test" } )]
303 *
304 * Params: item - The collection that contains "coordinates" of an element; /
305 the last element of the collection - the assigned value.
306 *
307 * Return: #lng/retf#
308 *
309 -----------------------------------------------------------------------------*/
310
311 method uint VARIANT.arrfromg( collection item )
312 {
313 uint gtype = item.gettype(*item-1)
314 uint val = ?( gtype <= double, item.ptr(*item-1), item.ptr(*item-1)->uint )
315 item.count--
316 uint off = this.arrgetptr( item )
317 item.count++
318 if off && ( this.vt & $VT_TYPEMASK ) == $VT_VARIANT
319 {
320 off->VARIANT.fromg( gtype, val )
321 return 1
322 }
323 return 0
324 }
325