EnglishРусский  

   ..

   olecom.g

   varconv.g

   variant.g

Реклама

Инсталлятор CreateInstall
Бесплатные и коммерческие инсталляторы

source\lib\olecom\olecom.g
  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 
281    	   if pcf : ((pcf->uint + 8)->uint)->stdcall( pcf );
282          
283          /*olecheck( CoCreateInstance( iid.ptr(), 0, 
284                   $CLSCTX_LOCAL_SERVER | $CLSCTX_INPROC_SERVER, 
285                   IDispatch.ptr(), &this.ppv ))*/     
286          //if res : this.flgcreate = 1
287       }
288    }
289    return res
290 }
291 
292 /*-----------------------------------------------------------------------------
293 * Id: typevar_opeq_1 FC
294 * 
295 * Summary: Assign operation. #b[oleobj = VARIANT( VT_DISPATCH )].
296 *
297 * Return: The result #b(oleobj).
298 *
299 -----------------------------------------------------------------------------*/
300 
301 operator oleobj = (oleobj left, VARIANT right )
302 {
303    left.release()
304    if (right.vt & $VT_TYPEMASK) == $VT_DISPATCH
305    {        
306       left.ppv = uint(right.val)
307       ((uint(left.ppv)->uint+4)->uint)->stdcall(uint(left.ppv))
308       //right.vt = 0
309       uint parent = (&right.val + 4)->uint 
310       if parent
311       {
312          left.perrfunc = parent->oleobj.perrfunc
313          left.pflgs = parent->oleobj.pflgs
314       }
315    }
316    return left
317 }
318 
319 method oleobj.delete()
320 {
321    this.release()
322 }
323 
324 property uint oleobj.flgs()
325 {
326    return this.pflgs
327 } 
328 
329 property oleobj.flgs( uint val )
330 {
331    this.pflgs = val
332 }
333 
334 method uint oleobj.dispatch ( str name, uint typeres, 
335       uint addrres, collection pars)
336 {   
337    buf  un
338    int i, j
339    uint pname = un.unicode(name).ptr()
340    uint idmeth   
341    uint typecall
342    int  cargs
343    uint dispidnamedargs = -3
344    DISPPARAMS dp
345    VARIANT    vres   
346    arr        varg of VARIANT  
347 
348 //Получаем код метода
349    if !this.ppv || !this.check( ((this.ppv->uint+20)->uint)->stdcall( 
350                         this.ppv, INULL.ptr(), &pname, 1, 0x00010000, &idmeth) )
351    {   
352       return 0
353    }   
354       
355 //Формируем параметры   
356    if &pars : cargs = *pars
357 
358    varg.expand( cargs )
359    if !typeres && addrres == -1
360    {        
361       dp.cNamedArgs = 1      
362       typecall = $DISPATCH_PROPERTYPUT       
363    }   
364    else
365    {
366       typecall = $DISPATCH_METHOD
367       if addrres : typecall |= $DISPATCH_PROPERTYGET       
368    }
369    
370    for i = cargs-1, i >= 0, i--
371    {  
372       uint gtype = pars.gettype(i)
373       if this.pflgs & $FOLEOBJ_INT
374       {      
375          if gtype == uint : gtype = int       
376       } 
377       varg[j++].fromg( gtype, ?( gtype <= double, pars.ptr(i), 
378                                  pars.ptr(i)->uint ))
379    }     
380 
381    dp.rgvarg = varg.ptr()
382    dp.rgdispidNamedArgs = &dispidnamedargs   
383    dp.cArgs = cargs   
384 //Вызываем метод   
385    if !this.check((this.ppv->uint+24)->uint->stdcall( this.ppv, idmeth, 
386                    INULL.ptr(), 0, typecall, &dp, vres, 0, 0 ))
387    {    
388       return 0
389    }
390 //Обрабатываем результаты
391 	if addrres && typeres == VARIANT 
392 	{  
393 		addrres->VARIANT.vt = vres.vt
394 		addrres->VARIANT.val = vres.val            
395       if (vres.vt & $VT_TYPEMASK) == $VT_DISPATCH
396       {         
397          (&addrres->VARIANT.val + 4)->uint = &this
398       }      
399 	}
400    vres.vt = 0
401    if this.flgdotcreate 
402    {
403       destroy( &this )
404    }
405    return 1
406 } 
407 
408 method oleobj.call( collection pars, str name )
409 {
410 //   print( "CALL \(name)\n" )
411    this.dispatch( name, 0, 0, pars )
412 }
413 
414 method oleobj.setval( collection pars, str name )
415 {
416    //print( "SETVAL \(name)\n" )
417    this.dispatch( name, 0, -1, pars )
418 }
419 
420 method VARIANT oleobj.getval <result> ( collection pars, str name )
421 {
422 	//print( "GETVAL \(name)\n" ) 
423 	this.dispatch( name, VARIANT, &result, pars )
424 }
425 
426 method oleobj oleobj.getobj ( collection pars, str name )
427 {
428    uint res
429    VARIANT vres
430    //print( "GETOBJ \(name)\n" ) 
431    res as new( oleobj )->oleobj   
432    this.dispatch( name, VARIANT, &vres, pars )   
433    res = vres  
434    res.flgdotcreate = 1
435    res.pflgs = this.pflgs
436    res.perrfunc = this.perrfunc 
437      
438    return res
439 }
440 
441 /* property oleboj.valset ()
442 {
443 }*/
444 func err( uint errcode )
445 {
446    print( "Ole error ["+ hex2stru( errcode ) + "]\n" )
447 }
448 
449 
450 /*-----------------------------------------------------------------------------
451 * Id: olecom_desc F1
452 *
453 * Summary: A brief description of COM/OLE library. This library also contains
454            the support of the #a(tvariant,VARIANT) type, used for data
455            transmitting from/to COM objects.
456 
457            Variables of the #b(oleobj) type are used for working with the COM
458            objects; furthermore, each variable of this type has one appropriate
459            COM object. A COM objects method is called with the help of 
460            the #a( lateoper, ~ late) binding operation. There are two ways of
461            binding a COM object with a variable , as follows:
462            #p[   
463 1. The #a(oleobj_createobj) method is used for creating a new COM object: 
464 #srcg[
465 |oleobj excapp
466 |excapp.createobj( "Excel.Application", "" )]]
467 
468 #p[2. Binding a variable with the existing COM object (child) is returned by
469  another COM object method call:#srcg[
470 |oleobj workbooks
471 |workbooks = excapp~WorkBooks]]
472 
473 #p[The #b(oleobj) object can maintain the following kinds of late binding:] 
474 #ul[
475 |elementary method call #b(excapp~Quit), with/without parameters; 
476 |set value #b[excapp~Cells( 3, 2 ) = "Hello World!"]; 
477 |get value #b[vis = uint( excapp~Visible )]; 
478 call chain #b(excapp~WorkBooks~Add), equals the following expressions 
479 ]
480 #srcg[
481 |oleobj workbooks
482 |workbooks = excapp~WorkBooks
483 |workbooks~Add]
484 
485 #p[The method call can return only the #b(VARIANT) type, and the appropriate
486  assignment operators and type cast operators are used to convert data to 
487  basic Gentee types. Parameters of the COM objects methods call as well as 
488  the assigned values are automatically converted to the appropriate VARIANT
489  types. The following Gentee types can be used - #b('uint, int, ulong, long,
490  float, double, str, VARIANT').]
491 
492 #p[Use the #a(oleobj_release) method in order to release the COM object;
493  otherwise, the COM object is released when the variable is deleted; also 
494  the object is released when the variable is bound with another COM object.
495 Have a look at the example of using the COM object] 
496 #srcg[
497 |include : $"...\olecom.g"
498 |func ole_example 
499 |{
500 |   oleobj excapp   
501 |   excapp.createobj( "Excel.Application", "" )     
502 |   excapp.flgs = $FOLEOBJ_INT
503 |   excapp~Visible = 1   
504 |   excapp~WorkBooks~Add   
505 |   excapp~Cells( 3, 2 ) = "Hello World!"
506 }]
507 #p[The oleobj object has properties, as follows:] 
508 #ul[
509 uint #b(flgs) are flags. Flags value can be set or obtained; the property can
510  contain the #b($FOLEOBJ_INT) flag, i.e. when transmitting data to the COM
511  object the unsigned Gentee type of uint is automatically converted to the
512 | signed type of VARIANT( VT_I4 ) 
513 uint #b(errfunc) is an error handling function. A function address can be
514  assigned to this property, so using the COM object this function will be 
515  called as long as an error occurs; furthermore, this function must have 
516  a parameter of the uint type, that contains an error code.
517 ]
518 #p[All child objects automatically inherit the #b(flgs) property as well as 
519 the #b(errfunc) property.]
520 *
521 * Title: COM/OLE description
522 *
523 * Define:    
524 *
525 -----------------------------------------------------------------------------*/
526 
527 //----------------------------------------------------------------------------
528 
529 /*-----------------------------------------------------------------------------
530 ** Id: tvariant F1
531 *
532 * Summary: VARIANT type. #b(VARIANT) is a universal type that is used for 
533 storing various data and it enables different programs to exchange data
534  properly. This type represents a structure consisted of two main fields: 
535  the first field is a type of the stored value, the second field is the 
536  stored value or the pointer to a storage area. The #b(VARIANT) type is 
537  defined as follows: 
538 #srcg[
539 |type VARIANT {
540 |   ushort vt          
541 |   ushort wReserved1     
542 |   ushort wReserved2     
543 |   ushort wReserved3 
544 |   ulong  val
545 }]
546 #p[
547 #b(vt) is a type code of the contained value ( type constants VT_*: $VT_UI4, $VT_I4, $VT_BSTR ... );#br#
548 #b(val) is a field used for storing values]
549 #p[
550 The library provides only some of the operations of the VARIANT type, however, you can use the fields of the given structure.
551 The example illustrates creation of the VARIANT( VT_BOOL ) variable:] 
552 #srcg[
553 |VARIANT bool
554 |....
555 |bool.clear()
556 |bool.vt = $VT_BOOL
557 |(&bool.val)->uint = 0xffff// 0xffff - VARIANT_TRUE]
558 
559 #p[This example shows VARIANT operations] 
560 #srcg[
561 |uint val
562 |str  res
563 |oleobj ActWorkSheet
564 |VARIANT vval
565 |
566 |....
567 |vval = int( 100 )        //VARIANT( VT_I4 ) is being created
568 |excapp~Cells(1,1) = vval //equals excapp~Cells(1,1) = 100
569 |                        
570 |vval = "Test string"     //VARIANT( VT_BSTR ) is being created
571 |excapp~Cells(2,1) = vval //equals excapp~Cells(1,1) = "Test string"
572 |
573 |val = uint( excapp~Cells(1,1)~Value ) //VARIANT( VT_I4 ) is converted to uint 
574 |res = excapp~Cells(2,1)~Value         //VARIANT( VT_BSTR ) is converted to str
575 |ActWorkSheet = excapp~ActiveWorkSheet //VARIANT( VT_DISPATCH ) is converted 
576 to oleobj]
577 *
578 * Title: VARIANT
579 *
580 * Define:    
581 *
582 -----------------------------------------------------------------------------*/
583 
584 //----------------------------------------------------------------------------
585 
586 /*v1.arrcreate( $VT_VARIANT, %{3,0,2,0} )
587    
588    v1.arrfromg( %{0,0, 0.0001f} )
589    b++
590    v1.arrfromg( %{0,1, b++} )
591    v1.arrfromg( %{1,0, b++} )
592    v1.arrfromg( %{1,1, b++} )   
593    v1.arrfromg( %{2,0, b++} )
594    v1.arrfromg( %{2,1, b} )    
595    exc_app.errfunc = &err*/
596 /*func a <main>
597 {
598    oleobj exc
599    
600    
601 //   exc.createobj( "Excel.Application", "" )
602    if ( !exc.createobj( "{00024500-0000-0000-C000-000000000046}", "" ) )
603    {
604    print("error\n" )
605    }     
606    exc.flgs = $FOLEOBJ_INT
607    exc~Visible = 1   
608    exc~WorkBooks~Add   
609    VARIANT v 
610    v.arrcreate( %{3,0,2,0} )//Создается массив с 3-мя строками и 2-мя столбцами
611    
612    v.arrfromg( %{0,0, 0.1234f} )    
613    v.arrfromg( %{0,1, int(100)} )   
614    v.arrfromg( %{2,1, "Testsssssssss" } )
615    exc~Range( exc~Cells( 1, 1 ), exc~Cells( 3, 2 ) ) = v //Передача массива в COM объект
616 
617    print( "ok\n" )
618    getch()
619    //exc~Quit   
620 }*/
621 
Редактировать