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 /*-----------------------------------------------------------------------------
15 * Id: comole L "COM/OLE"
16 *
17 * Summary: Working with COM/OLE Object. The COM library is applied for working
18 with the #b(COM/OLE objects), the #b(IDispatch) interface and
19 maintains late binding operations. For using this library, it is
20 required to specify the file olecom.g (from lib\olecom subfolder)
21 with include command. #srcg[
22 |include : $"...\gentee\lib\olecom\olecom.g"]
23 *
24 * List: *,olecom_desc,tvariant,
25 *#lng/opers#,typevar_opeq,variant_opeq,type_opvar,
26 *#lng/methods#,oleobj_createobj,oleobj_getres,oleobj_iserr,
27 oleobj_release,
28 *VARIANT Methods,variant_arrcreate,variant_arrfromg,variant_arrgetptr,
29 variant_clear,variant_ismissing,variant_isnull,variant_setmissing
30 *
31 -----------------------------------------------------------------------------*/
32
33 define <export> {
34 FOLEOBJ_INT = 0x01 // Представлять целые числа uint как int
35 }
36 type oleobj
37 {
38 uint ppv
39 uint flgdotcreate
40 uint pflgs
41 uint err
42 uint perrfunc
43 }
44
45 include {"variant.g"
46 }
47
48 import "Ole32.dll"
49 {
50 uint CoInitializeEx( uint, uint )
51 //uint CoInitialize( uint )
52 CoUninitialize()
53 uint CoGetClassObject( uint, uint, uint, uint, uint )
54 //uint CoCreateInstance( uint, uint, uint, uint, uint )
55 //uint CoCreateInstanceEx( uint, uint, uint, uint, uint, uint )
56 uint CLSIDFromString( uint, uint )
57 uint CLSIDFromProgID( uint, uint )
58 }
59
60 type olecom
61 {
62 uint flginit
63 uint lasterr
64 }
65
66 global {
67 uint oleinit
68 buf IDispatch = '\h00 04 02 00 00 00 00 00 c0 00 00 00 00 00 00 46'
69 buf IClassFactory = '\h01 00 00 00 00 00 00 00 c0 00 00 00 00 00 00 46'
70 buf INULL = '\h00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00'
71 olecom ole
72 }
73
74 define {
75 // COM initialization flags; passed to CoInitialize.
76 COINIT_APARTMENTTHREADED = 0x2 // Apartment model
77 COINIT_MULTITHREADED = 0x0 // OLE calls objects on any thread.
78 COINIT_DISABLE_OLE1DDE = 0x4 // Don't use DDE for Ole1 support.
79 COINIT_SPEED_OVER_MEMORY = 0x8 // Trade memory for speed.
80
81 CLSCTX_INPROC_SERVER = 0x1
82 CLSCTX_INPROC_HANDLER = 0x2
83 CLSCTX_LOCAL_SERVER = 0x4
84 CLSCTX_INPROC_SERVER16 = 0x8
85 CLSCTX_REMOTE_SERVER = 0x10
86 CLSCTX_INPROC_HANDLER16 = 0x20
87 CLSCTX_INPROC_SERVERX86 = 0x40
88 CLSCTX_INPROC_HANDLERX86= 0x80
89 CLSCTX_ESERVER_HANDLER = 0x100
90
91 DISPATCH_METHOD =0x1
92 DISPATCH_PROPERTYGET =0x2
93 DISPATCH_PROPERTYPUT =0x4
94 DISPATCH_PROPERTYPUTREF =0x8
95 }
96
97 type COSERVERINFO
98 {
99 uint dwReserved1
100 uint pwszName
101 uint pAuthInfo
102 uint dwReserved2
103 }
104
105 method olecom.seterr( uint err )
106 {
107 this.lasterr = err
108 }
109
110 func uint olecheck( uint errcode )
111 {
112 uint ret = ? ( errcode & 0x80000000, 0, 1 )
113 if !ret
114 {
115 //print( hex2stru("Ole error [", errcode ) + "]\n" )
116 ole.seterr( errcode )
117 }
118 return ret
119 }
120
121 method olecom.init()
122 {
123 if !this.flginit && olecheck( CoInitializeEx( 0,
124 $COINIT_APARTMENTTHREADED ) )
125 {
126 this.flginit = 1
127 }
128 }
129
130 method olecom.release
131 {
132 if this.flginit
133 {
134 CoUninitialize()
135 this.flginit = 0
136 }
137 }
138
139 method uint olecom.geterr()
140 {
141 return this.lasterr
142 }
143
144 method olecom.noerr()
145 {
146 this.lasterr = 0
147 }
148
149 method olecom.delete()
150 {
151 this.release()
152 }
153
154 /*-----------------------------------------------------------------------------
155 * Id: oleobj_release F3
156 *
157 * Summary: Releasing the COM object. The method deletes the bond between the
158 variable and the COM object and releases the COM object.
159 *
160 -----------------------------------------------------------------------------*/
161
162 method oleobj.release()
163 {
164 if this.ppv
165 {
166 ((this.ppv->uint+8)->uint)->stdcall(this.ppv)
167 //this.flgcreate = 0
168 this.ppv = 0
169 //oleinit--
170 //if !oleinit : CoUninitialize()
171 }
172 }
173
174 property oleobj.errfunc( uint val )
175 {
176 this.perrfunc = val
177 }
178
179 method uint oleobj.check( uint rcode )
180 {
181 this.err = rcode
182 if olecheck( rcode )
183 {
184 return 1
185 }
186 if this.perrfunc
187 {
188 this.perrfunc->func( rcode )
189 }
190 return 0
191 }
192
193 /*-----------------------------------------------------------------------------
194 * Id: oleobj_iserr F3
195 *
196 * Summary: Enables to define whether or not an error occurs while working
197 with a COM object.
198 *
199 * Return: Returns the HRESULT code of the last COM object operation.
200 *
201 -----------------------------------------------------------------------------*/
202
203 method uint oleobj.iserr()
204 {
205 return olecheck( this.err )
206 }
207
208 /*-----------------------------------------------------------------------------
209 * Id: oleobj_getres F3
210 *
211 * Summary: Result of the last operation. This method is applied for getting
212 an error code or a warning; the code is the C type of HRESULT.
213 *
214 * Return: Returns the HRESULT code of the last COM object operation.
215 *
216 -----------------------------------------------------------------------------*/
217
218 method uint oleobj.getres()
219 {
220 return this.err
221 }
222
223 /*-----------------------------------------------------------------------------
224 * Id: oleobj_createobj F2
225 *
226 * Summary: The method creates a new COM object. Example: #srcg[
227 |oleobj excapp
228 |excapp.createobj( "Excel.Application", "" )
229 |//is equal to excapp.createobj( "{00024500-0000-0000-C000-000000000046}", "" ) |
230 |excapp.flgs = $FOLEOBJ_INT
231 |excapp~Visible = 1]
232 *
233 * Params: name - An object name, or the string representation of an object /
234 identifier - "{...}".
235 mashine - A computer name where the required object is created; /
236 if the current string is empty, the object is created /
237 in the current computer.
238 *
239 * Return: #lng/retf#
240 *
241 -----------------------------------------------------------------------------*/
242
243 method uint oleobj.createobj( str name, str mashine )
244 {
245 uint res
246 uint pcf
247 buf iid
248 buf un
249 COSERVERINFO csi
250
251 iid.expand(16)
252 if ole.flginit
253 {
254 this.release()
255
256 res = this.check( CLSIDFromString( un.unicode( name ).ptr(), iid.ptr() ))
257 // res = this.check( CLSIDFromString( un.unicode( name ).ptr(), iid.ptr() ))
258
259 if res
260 {
261 if &mashine
262 {
263 csi.pwszName = un.unicode( mashine ).ptr()
264 }
265 res = this.check( CoGetClassObject(
266 iid.ptr(),
267 ?(&mashine && *mashine, $CLSCTX_REMOTE_SERVER,
268 $CLSCTX_LOCAL_SERVER | $CLSCTX_INPROC_SERVER ),
269 ?(&mashine,&csi,0),
270 IClassFactory.ptr(),
271 &pcf))
272 if res
273 {
274 // print( "x \( ((pcf->uint + 12 )->uint )), \(pcf),
275 // \(IDispatch.ptr()), \( &this.ppv) \n " )
276 res = this.check( ((pcf->uint + 12 )->uint)->stdcall(
277 pcf, 0, IDispatch.ptr(), &this.ppv ))
278 // print( "9\n" )
279 }
280 if pcf : ((pcf->uint + 8)->uint)->stdcall( pcf );
281
282 /*olecheck( CoCreateInstance( iid.ptr(), 0,
283 $CLSCTX_LOCAL_SERVER | $CLSCTX_INPROC_SERVER,
284 IDispatch.ptr(), &this.ppv ))*/
285 //if res : this.flgcreate = 1
286 }
287 }
288 return res
289 }
290
291 /*-----------------------------------------------------------------------------
292 * Id: typevar_opeq_1 FC
293 *
294 * Summary: Assign operation. #b[oleobj = VARIANT( VT_DISPATCH )].
295 *
296 * Return: The result #b(oleobj).
297 *
298 -----------------------------------------------------------------------------*/
299
300 operator oleobj = (oleobj left, VARIANT right )
301 {
302 left.release()
303 if (right.vt & $VT_TYPEMASK) == $VT_DISPATCH
304 {
305 left.ppv = uint(right.val)
306 ((uint(left.ppv)->uint+4)->uint)->stdcall(uint(left.ppv))
307 //right.vt = 0
308 uint parent = (&right.val + 4)->uint
309 if parent
310 {
311 left.perrfunc = parent->oleobj.perrfunc
312 left.pflgs = parent->oleobj.pflgs
313 }
314 }
315 return left
316 }
317
318 method oleobj.delete()
319 {
320 this.release()
321 }
322
323 property uint oleobj.flgs()
324 {
325 return this.pflgs
326 }
327
328 property oleobj.flgs( uint val )
329 {
330 this.pflgs = val
331 }
332
333 method uint oleobj.dispatch ( str name, uint typeres,
334 uint addrres, collection pars)
335 {
336 buf un
337 int i, j
338 uint pname = un.unicode(name).ptr()
339 uint idmeth
340 uint typecall
341 int cargs
342 uint dispidnamedargs = -3
343 DISPPARAMS dp
344 VARIANT vres
345 arr varg of VARIANT
346
347 //Получаем код метода
348 if !this.ppv || !this.check( ((this.ppv->uint+20)->uint)->stdcall(
349 this.ppv, INULL.ptr(), &pname, 1, 0x00010000, &idmeth) )
350 {
351 return 0
352 }
353
354 //Формируем параметры
355 if &pars : cargs = *pars
356
357 varg.expand( cargs )
358 if !typeres && addrres == -1
359 {
360 dp.cNamedArgs = 1
361 typecall = $DISPATCH_PROPERTYPUT
362 }
363 else
364 {
365 typecall = $DISPATCH_METHOD
366 if addrres : typecall |= $DISPATCH_PROPERTYGET
367 }
368
369 for i = cargs-1, i >= 0, i--
370 {
371 uint gtype = pars.gettype(i)
372 if this.pflgs & $FOLEOBJ_INT
373 {
374 if gtype == uint : gtype = int
375 }
376 varg[j++].fromg( gtype, ?( gtype <= double, pars.ptr(i),
377 pars.ptr(i)->uint ))
378 }
379
380 dp.rgvarg = varg.ptr()
381 dp.rgdispidNamedArgs = &dispidnamedargs
382 dp.cArgs = cargs
383 //Вызываем метод
384 if !this.check((this.ppv->uint+24)->uint->stdcall( this.ppv, idmeth,
385 INULL.ptr(), 0, typecall, &dp, vres, 0, 0 ))
386 {
387 return 0
388 }
389 //Обрабатываем результаты
390 if addrres && typeres == VARIANT
391 {
392 addrres->VARIANT.vt = vres.vt
393 addrres->VARIANT.val = vres.val
394 if (vres.vt & $VT_TYPEMASK) == $VT_DISPATCH
395 {
396 (&addrres->VARIANT.val + 4)->uint = &this
397 }
398 }
399 vres.vt = 0
400 if this.flgdotcreate
401 {
402 destroy( &this )
403 }
404 return 1
405 }
406
407 method oleobj.call( collection pars, str name )
408 {
409 // print( "CALL \(name)\n" )
410 this.dispatch( name, 0, 0, pars )
411 }
412
413 method oleobj.setval( collection pars, str name )
414 {
415 //print( "SETVAL \(name)\n" )
416 this.dispatch( name, 0, -1, pars )
417 }
418
419 method VARIANT oleobj.getval <result> ( collection pars, str name )
420 {
421 //print( "GETVAL \(name)\n" )
422 this.dispatch( name, VARIANT, &result, pars )
423 }
424
425 method oleobj oleobj.getobj ( collection pars, str name )
426 {
427 uint res
428 VARIANT vres
429 //print( "GETOBJ \(name)\n" )
430 res as new( oleobj )->oleobj
431 this.dispatch( name, VARIANT, &vres, pars )
432 res = vres
433 res.flgdotcreate = 1
434 res.pflgs = this.pflgs
435 res.perrfunc = this.perrfunc
436
437 return res
438 }
439
440 /* property oleboj.valset ()
441 {
442 }*/
443 func err( uint errcode )
444 {
445 print( "Ole error ["+ hex2stru( errcode ) + "]\n" )
446 }
447
448
449 /*-----------------------------------------------------------------------------
450 * Id: olecom_desc F1
451 *
452 * Summary: A brief description of COM/OLE library. This library also contains
453 the support of the #a(tvariant,VARIANT) type, used for data
454 transmitting from/to COM objects.
455
456 Variables of the #b(oleobj) type are used for working with the COM
457 objects; furthermore, each variable of this type has one appropriate
458 COM object. A COM objects method is called with the help of
459 the #a( lateoper, ~ late) binding operation. There are two ways of
460 binding a COM object with a variable , as follows:
461 #p[
462 1. The #a(oleobj_createobj) method is used for creating a new COM object:
463 #srcg[
464 |oleobj excapp
465 |excapp.createobj( "Excel.Application", "" )]]
466
467 #p[2. Binding a variable with the existing COM object (child) is returned by
468 another COM object method call:#srcg[
469 |oleobj workbooks
470 |workbooks = excapp~WorkBooks]]
471
472 #p[The #b(oleobj) object can maintain the following kinds of late binding:]
473 #ul[
474 |elementary method call #b(excapp~Quit), with/without parameters;
475 |set value #b[excapp~Cells( 3, 2 ) = "Hello World!"];
476 |get value #b[vis = uint( excapp~Visible )];
477 call chain #b(excapp~WorkBooks~Add), equals the following expressions
478 ]
479 #srcg[
480 |oleobj workbooks
481 |workbooks = excapp~WorkBooks
482 |workbooks~Add]
483
484 #p[The method call can return only the #b(VARIANT) type, and the appropriate
485 assignment operators and type cast operators are used to convert data to
486 basic Gentee types. Parameters of the COM objects methods call as well as
487 the assigned values are automatically converted to the appropriate VARIANT
488 types. The following Gentee types can be used - #b('uint, int, ulong, long,
489 float, double, str, VARIANT').]
490
491 #p[Use the #a(oleobj_release) method in order to release the COM object;
492 otherwise, the COM object is released when the variable is deleted; also
493 the object is released when the variable is bound with another COM object.
494 Have a look at the example of using the COM object]
495 #srcg[
496 |include : $"...\olecom.g"
497 |func ole_example
498 |{
499 | oleobj excapp
500 | excapp.createobj( "Excel.Application", "" )
501 | excapp.flgs = $FOLEOBJ_INT
502 | excapp~Visible = 1
503 | excapp~WorkBooks~Add
504 | excapp~Cells( 3, 2 ) = "Hello World!"
505 }]
506 #p[The oleobj object has properties, as follows:]
507 #ul[
508 uint #b(flgs) are flags. Flags value can be set or obtained; the property can
509 contain the #b($FOLEOBJ_INT) flag, i.e. when transmitting data to the COM
510 object the unsigned Gentee type of uint is automatically converted to the
511 | signed type of VARIANT( VT_I4 )
512 uint #b(errfunc) is an error handling function. A function address can be
513 assigned to this property, so using the COM object this function will be
514 called as long as an error occurs; furthermore, this function must have
515 a parameter of the uint type, that contains an error code.
516 ]
517 #p[All child objects automatically inherit the #b(flgs) property as well as
518 the #b(errfunc) property.]
519 *
520 * Title: COM/OLE description
521 *
522 * Define:
523 *
524 -----------------------------------------------------------------------------*/
525
526 //----------------------------------------------------------------------------
527
528 /*-----------------------------------------------------------------------------
529 ** Id: tvariant F1
530 *
531 * Summary: VARIANT type. #b(VARIANT) is a universal type that is used for
532 storing various data and it enables different programs to exchange data
533 properly. This type represents a structure consisted of two main fields:
534 the first field is a type of the stored value, the second field is the
535 stored value or the pointer to a storage area. The #b(VARIANT) type is
536 defined as follows:
537 #srcg[
538 |type VARIANT {
539 | ushort vt
540 | ushort wReserved1
541 | ushort wReserved2
542 | ushort wReserved3
543 | ulong val
544 }]
545 #p[
546 #b(vt) is a type code of the contained value ( type constants VT_*: $VT_UI4, $VT_I4, $VT_BSTR ... );#br#
547 #b(val) is a field used for storing values]
548 #p[
549 The library provides only some of the operations of the VARIANT type, however, you can use the fields of the given structure.
550 The example illustrates creation of the VARIANT( VT_BOOL ) variable:]
551 #srcg[
552 |VARIANT bool
553 |....
554 |bool.clear()
555 |bool.vt = $VT_BOOL
556 |(&bool.val)->uint = 0xffff// 0xffff - VARIANT_TRUE]
557
558 #p[This example shows VARIANT operations]
559 #srcg[
560 |uint val
561 |str res
562 |oleobj ActWorkSheet
563 |VARIANT vval
564 |
565 |....
566 |vval = int( 100 ) //VARIANT( VT_I4 ) is being created
567 |excapp~Cells(1,1) = vval //equals excapp~Cells(1,1) = 100
568 |
569 |vval = "Test string" //VARIANT( VT_BSTR ) is being created
570 |excapp~Cells(2,1) = vval //equals excapp~Cells(1,1) = "Test string"
571 |
572 |val = uint( excapp~Cells(1,1)~Value ) //VARIANT( VT_I4 ) is converted to uint
573 |res = excapp~Cells(2,1)~Value //VARIANT( VT_BSTR ) is converted to str
574 |ActWorkSheet = excapp~ActiveWorkSheet //VARIANT( VT_DISPATCH ) is converted
575 to oleobj]
576 *
577 * Title: VARIANT
578 *
579 * Define:
580 *
581 -----------------------------------------------------------------------------*/
582
583 //----------------------------------------------------------------------------
584
585 /*v1.arrcreate( $VT_VARIANT, %{3,0,2,0} )
586
587 v1.arrfromg( %{0,0, 0.0001f} )
588 b++
589 v1.arrfromg( %{0,1, b++} )
590 v1.arrfromg( %{1,0, b++} )
591 v1.arrfromg( %{1,1, b++} )
592 v1.arrfromg( %{2,0, b++} )
593 v1.arrfromg( %{2,1, b} )
594 exc_app.errfunc = &err*/
595 /*func a <main>
596 {
597 oleobj exc
598
599
600 // exc.createobj( "Excel.Application", "" )
601 if ( !exc.createobj( "{00024500-0000-0000-C000-000000000046}", "" ) )
602 {
603 print("error\n" )
604 }
605 exc.flgs = $FOLEOBJ_INT
606 exc~Visible = 1
607 exc~WorkBooks~Add
608 VARIANT v
609 v.arrcreate( %{3,0,2,0} )//Создается массив с 3-мя строками и 2-мя столбцами
610
611 v.arrfromg( %{0,0, 0.1234f} )
612 v.arrfromg( %{0,1, int(100)} )
613 v.arrfromg( %{2,1, "Testsssssssss" } )
614 exc~Range( exc~Cells( 1, 1 ), exc~Cells( 3, 2 ) ) = v //Передача массива в COM объект
615
616 print( "ok\n" )
617 getch()
618 //exc~Quit
619 }*/
Ads
Perfect Automation tool
All-In-One: Script editor, Launcher, Scheduler, Keyboard & Mouse Recorder. Try now!
CreateInstall
Freeware and commercial installers.
Cell Phone Batteries
Batteries Plus offers batteries for laptop, camcorder, cell phone,
camera.
Gentee needs your help!
How to advertise with us
laptop battery