298 lines
10 KiB
OpenEdge ABL
298 lines
10 KiB
OpenEdge ABL
|
/*----------------------------------------------------------------------------*/
|
||
|
|
/* */
|
||
|
|
/* Copyright (c) 2002-2022 Rony G. Flatscher. All rights reserved. */
|
||
|
|
/* Copyright (c) 2023 Rexx Language Association. All rights reserved. */
|
||
|
|
/* */
|
||
|
|
/* This program and the accompanying materials are made available under */
|
||
|
|
/* the terms of the Common Public License v1.0 which accompanies this */
|
||
|
|
/* distribution. A copy is also available at the following address: */
|
||
|
|
/* https://www.oorexx.org/license.html */
|
||
|
|
/* */
|
||
|
|
/* Redistribution and use in source and binary forms, with or */
|
||
|
|
/* without modification, are permitted provided that the following */
|
||
|
|
/* conditions are met: */
|
||
|
|
/* */
|
||
|
|
/* Redistributions of source code must retain the above copyright */
|
||
|
|
/* notice, this list of conditions and the following disclaimer. */
|
||
|
|
/* Redistributions in binary form must reproduce the above copyright */
|
||
|
|
/* notice, this list of conditions and the following disclaimer in */
|
||
|
|
/* the documentation and/or other materials provided with the distribution. */
|
||
|
|
/* */
|
||
|
|
/* Neither the name of Rexx Language Association nor the names */
|
||
|
|
/* of its contributors may be used to endorse or promote products */
|
||
|
|
/* derived from this software without specific prior written permission. */
|
||
|
|
/* */
|
||
|
|
/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */
|
||
|
|
/* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */
|
||
|
|
/* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */
|
||
|
|
/* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */
|
||
|
|
/* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */
|
||
|
|
/* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */
|
||
|
|
/* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */
|
||
|
|
/* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */
|
||
|
|
/* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */
|
||
|
|
/* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */
|
||
|
|
/* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */
|
||
|
|
/* */
|
||
|
|
/*----------------------------------------------------------------------------*/
|
||
|
|
|
||
|
|
/***********************************************************************
|
||
|
|
program: oleinfo.cls
|
||
|
|
|
||
|
|
purpose: Query the OLE/ActiveX automation interface, create an Object Rexx proxy
|
||
|
|
which contains all relevant information in an edited and easy to use form
|
||
|
|
|
||
|
|
usage: require this file
|
||
|
|
|
||
|
|
returns: an instance of class "rgf.oleinfo"
|
||
|
|
|
||
|
|
***********************************************************************/
|
||
|
|
|
||
|
|
|
||
|
|
-- define invocation types
|
||
|
|
tmp.="???"
|
||
|
|
tmp.1="regularMethodCall"
|
||
|
|
tmp.2="getProperty"
|
||
|
|
tmp.4="putProperty"
|
||
|
|
tmp.8="letProperty" -- a put property (assigning a reference, distinguishment not important for Rexx)
|
||
|
|
.local~rgf.invKind= tmp. -- save stem
|
||
|
|
|
||
|
|
|
||
|
|
-- class to parse and create sorted list of methods
|
||
|
|
::class rgf.oleinfo public
|
||
|
|
|
||
|
|
::method oleObject attribute -- OLEobject itself
|
||
|
|
|
||
|
|
::method oleString attribute -- app_name
|
||
|
|
::method libname attribute
|
||
|
|
::method libdoc attribute
|
||
|
|
|
||
|
|
::method allMethodDir attribute -- contains all methods
|
||
|
|
::method allMethodRel attribute
|
||
|
|
::method allMethodSortedStem attribute
|
||
|
|
|
||
|
|
::method methodDir attribute
|
||
|
|
|
||
|
|
::method getPropertyDir attribute
|
||
|
|
::method putPropertyDir attribute
|
||
|
|
|
||
|
|
::method naDir attribute -- directory for storing methods with unknown invocation types
|
||
|
|
|
||
|
|
::method getAndPutPropertyDir attribute
|
||
|
|
::method getOnlyPropertyDir attribute
|
||
|
|
::method putOnlyPropertyDir attribute
|
||
|
|
|
||
|
|
::method eventDir attribute
|
||
|
|
::method eventSortedStem attribute
|
||
|
|
|
||
|
|
::method constantSortedStem attribute
|
||
|
|
|
||
|
|
::method init
|
||
|
|
expose oleObject oleString libname libdoc allMethodDir allMethodSortedStem methodDir getPropertyDir ,
|
||
|
|
putPropertyDir naDir getAndPutPropertyDir getOnlyPropertyDir putOnlyPropertyDir eventDir eventSortedStem,
|
||
|
|
constantSortedStem
|
||
|
|
|
||
|
|
use arg oleobject, oleString
|
||
|
|
|
||
|
|
signal on syntax -- if OLEobject cannot be created, return .nil
|
||
|
|
if arg(1)="" | arg(1)=.nil then oleobject=.oleobject~new(oleString, "WITHEVENTS")
|
||
|
|
|
||
|
|
if arg(2, "Omitted") then oleString="n/a"
|
||
|
|
|
||
|
|
methodDir =.directory~new -- method directory
|
||
|
|
allMethodDir =.directory~new
|
||
|
|
allMethodSortedStem = .stem~new
|
||
|
|
|
||
|
|
getPropertyDir =.directory~new -- get property directory
|
||
|
|
putPropertyDir =.directory~new -- set property directory
|
||
|
|
|
||
|
|
naDir =.directory~new
|
||
|
|
|
||
|
|
getAndPutPropertyDir = .directory~new
|
||
|
|
getOnlyPropertyDir = .directory~new
|
||
|
|
putOnlyPropertyDir = .directory~new
|
||
|
|
|
||
|
|
eventDir =.directory~new -- event directory
|
||
|
|
eventSortedStem = .stem~new
|
||
|
|
constantSortedStem = .stem~new
|
||
|
|
|
||
|
|
m. = oleobject~getKnownMethods -- get all known methods
|
||
|
|
if m. <> .nil then
|
||
|
|
do
|
||
|
|
libname=choose( var("m.!LibName"), m.!LibName, "n/a")
|
||
|
|
libdoc =choose( var("m.!LibDoc"), m.!libDoc, "n/a" )
|
||
|
|
|
||
|
|
-- determine kind of methods, build collection objects
|
||
|
|
j=0
|
||
|
|
tmpSet=.set~new -- used to lookup whether name already collected
|
||
|
|
mStem.0=m.0
|
||
|
|
do i=1 to m.0
|
||
|
|
mo=.ole_method~new(m., i ) -- create object
|
||
|
|
name=mo~name
|
||
|
|
|
||
|
|
allMethodDir~setentry(name, mo) -- save method-object
|
||
|
|
|
||
|
|
if mo~invKind=1 then methodDir~setentry(name, mo) -- a normal method
|
||
|
|
else if mo~invKind=2 then getPropertyDir~setentry(name, mo) -- a get property
|
||
|
|
else if mo~invKind=4 | mo~invKind=8 then putPropertyDir~setentry(name, mo) -- a put property
|
||
|
|
|
||
|
|
uname=translate(name)
|
||
|
|
if tmpSet~hasindex(uname) then iterate
|
||
|
|
j=j+1
|
||
|
|
mStem.j=name
|
||
|
|
mStem.0=J
|
||
|
|
tmpSet~put(uname)
|
||
|
|
end
|
||
|
|
|
||
|
|
call SysStemSort mStem., "Ascending", "Ignore" -- makes problem if used under MSIE (as of: 2002-05-27)
|
||
|
|
self~allMethodSortedStem = mStem. -- save sorted stem
|
||
|
|
end
|
||
|
|
|
||
|
|
-- methods which possess an unknown invocation type:
|
||
|
|
naDir=allMethodDir~difference(methodDir)~difference(getPropertyDir)~difference(putPropertyDir)
|
||
|
|
|
||
|
|
getAndPutPropertyDir = getPropertyDir~intersection(putPropertyDir)
|
||
|
|
getOnlyPropertyDir = getPropertyDir~difference(putPropertyDir)
|
||
|
|
putOnlyPropertyDir = putPropertyDir~difference(getPropertyDir)
|
||
|
|
|
||
|
|
ev. = oleobject~getKnownEvents -- get all known events
|
||
|
|
|
||
|
|
if ev. <> .nil then
|
||
|
|
do
|
||
|
|
evStem.0=ev.0
|
||
|
|
do i=1 to ev.0
|
||
|
|
ev=.ole_event~new(ev., i ) -- create object
|
||
|
|
eventDir~setentry(ev~name, ev)
|
||
|
|
evStem.i=ev~name
|
||
|
|
end
|
||
|
|
|
||
|
|
call SysStemSort evStem., "Ascending", "Ignore"
|
||
|
|
self~eventSortedStem = evStem. -- save sorted stem
|
||
|
|
end
|
||
|
|
|
||
|
|
-- call alert "oleobject="oleObject "ev.0="ev.0 "evStem.0="evStem.0 "sel~eventSortedStem="self~eventSortedStem
|
||
|
|
|
||
|
|
c. = oleobject~getConstant -- OLE object needs to have been created with the "WITHEVENTS"-option
|
||
|
|
if c. <> .nil then
|
||
|
|
do
|
||
|
|
i=0
|
||
|
|
do item over c.
|
||
|
|
i=i+1
|
||
|
|
constStem.i=substr(item, 2)
|
||
|
|
end
|
||
|
|
constStem.0=i
|
||
|
|
|
||
|
|
if constStem.0>0 then
|
||
|
|
call SysStemSort constStem., "A", "I" -- get constants and sort ascendingly
|
||
|
|
self~constantSortedStem = constStem.
|
||
|
|
end
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
syntax:
|
||
|
|
oleObject=.nil
|
||
|
|
return
|
||
|
|
|
||
|
|
|
||
|
|
-- pretty print
|
||
|
|
::routine pp
|
||
|
|
return "[" || arg(1) || "]"
|
||
|
|
|
||
|
|
|
||
|
|
-- OLE MethodOrEvent
|
||
|
|
::class methodOrEvent
|
||
|
|
::method init
|
||
|
|
expose name doc params
|
||
|
|
use arg stem., idx
|
||
|
|
|
||
|
|
name=stem.idx.!Name
|
||
|
|
|
||
|
|
if var("stem.idx.!doc") then doc=stem.idx.!Doc
|
||
|
|
else doc="n/a" -- .nil
|
||
|
|
|
||
|
|
params =.list~new
|
||
|
|
do i=1 to stem.idx.!params.0
|
||
|
|
params~insert( .ole_param~new( stem.idx.!params.i.!name, -
|
||
|
|
stem.idx.!params.i.!type, -
|
||
|
|
stem.idx.!params.i.!flags ) )
|
||
|
|
end
|
||
|
|
|
||
|
|
::method name attribute
|
||
|
|
::method doc attribute
|
||
|
|
::method params attribute -- list of params, if any
|
||
|
|
|
||
|
|
::method makestring -- create string rendering
|
||
|
|
expose name doc params
|
||
|
|
|
||
|
|
tmp=""
|
||
|
|
do param over params
|
||
|
|
tmp=tmp "," param~makestring
|
||
|
|
end
|
||
|
|
tmp=substr(tmp,4)
|
||
|
|
return name pp( doc ) "(" tmp ")"
|
||
|
|
|
||
|
|
|
||
|
|
-- OLE Method
|
||
|
|
::class ole_method subclass MethodOrEvent
|
||
|
|
|
||
|
|
::method init
|
||
|
|
expose invkind retType
|
||
|
|
use arg stem., idx
|
||
|
|
|
||
|
|
forward class (super) continue -- let super initialize
|
||
|
|
|
||
|
|
invkind=stem.idx.!InvKind
|
||
|
|
if invkind=.nil then invkind="??? unknown type #" stem.idx.!InvKind "???"
|
||
|
|
|
||
|
|
-- if invkind="4" then self~name=(self~name || "=")
|
||
|
|
retType=stem.idx.!retType
|
||
|
|
|
||
|
|
::method invkind attribute -- 1=method, 2=getProperty, 4=putProperty
|
||
|
|
::method retType attribute
|
||
|
|
|
||
|
|
::method makestring -- create string rendering
|
||
|
|
expose invKind retType
|
||
|
|
return (.rgf.invKind[invKind]~string) (self~makestring:super~string) "retType --->" (retType~string)
|
||
|
|
|
||
|
|
|
||
|
|
-- OLE Event
|
||
|
|
::class ole_event subclass MethodOrEvent
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
-- OLE Parameter
|
||
|
|
::class ole_param
|
||
|
|
::method init
|
||
|
|
expose name in out opt type
|
||
|
|
parse arg name, type, flags
|
||
|
|
in =pos("in", flags)>0
|
||
|
|
out=pos("out", flags)>0
|
||
|
|
opt=pos("opt", flags)>0
|
||
|
|
|
||
|
|
::method name attribute
|
||
|
|
::method in attribute
|
||
|
|
::method out attribute
|
||
|
|
::method opt attribute
|
||
|
|
::method type attribute
|
||
|
|
|
||
|
|
::method makestring -- render to a string
|
||
|
|
expose name in out opt type type
|
||
|
|
|
||
|
|
tmp=name
|
||
|
|
if in then tmp=tmp "in"
|
||
|
|
else tmp=tmp " "
|
||
|
|
|
||
|
|
if out then tmp=tmp"/out"
|
||
|
|
|
||
|
|
tmp=tmp":" type
|
||
|
|
|
||
|
|
if opt then tmp=pp(tmp) -- indicate optionality by enclosing in brackets
|
||
|
|
return tmp
|
||
|
|
|
||
|
|
|
||
|
|
-- C++/Java like choice ("...?...:...;")
|
||
|
|
:: routine choose public
|
||
|
|
if arg(1)=.true then return arg(2)
|
||
|
|
return arg(3)
|
||
|
|
|