/*----------------------------------------------------------------------------*/ /* */ /* 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: oleinfo2html.frm purpose: Query the OLE/ActiveX automation interface, create HTML renderings of results needs: oleinfo.cls usage: require this file oleinfo(app_name[, [oleobj] [, [bCompact] [, HTMLString]]] ) app_name OLE/ActiveX program name or class-id oleobj OLE object, .nil or empty string ... if .nil or empty string, an OLE object is created with app_name bCompact ... .true=compact rendering, .false=full rendering including constants HTMLString ... if given, gets inserted right before tables begin returns: array with two elements: string of and string of ***********************************************************************/ nl="0d0a"x parse source . . thisPgm thisLocation=filespec('location',thisPgm) -- create a stylesheet link with a fully quailified name in addition to one without a path -- oleinfo.properties propsFile="oleinfo.properties" if \sysFileExists(propsFile) then propsFile=thisLocation||propsFile if sysFileExists(propsFile) then do props=.Properties~load(propsFile) stylesheet =props~getProperty("cssFileName", stylesheet)~strip bIncorporateCss=props~getLogical("incorporateCSS", .true) end else -- no cssFile found, just refer to it, do not attempt to incorporate do stylesheet ="oleinfo.css" bIncorporateCss=.false end if bIncorporateCss then -- does stylesheet exist? do if \sysFileExists(stylesheet) then do tmpStyleSheet=thisLocation||stylesheet if sysFileExists(tmpStyleSheet) then styleSheet=tmpStyleSheet else -- does not exist, do not incorporate CSS, leave original name intact bIncorporateCss=.false end end tmpLocalCss="" if bIncorporateCss then -- if .true get css-definitions and copy them into the head do s=.stream~new(stylesheet)~~open("read") tmp="" nl -- incorporate css definitions s~close end else do tmp=stream(stylesheet, "c", "query exists") if tmp="" then -- hmm, not found, maybe wer are not in our home directory, try it with that do errMsg="Problem, cannot locate stylesheet:" stylesheet if window <> "WINDOW" then call alert msg else .error~say(msg) end tmpLocalCss=' ' if tmp <> "" then do tmp=' 'nl , ' ' end else tmp="" end -- HTML head text .local~head.text = , ' 'nl , ' 'nl , ' 'nl , ' 'nl , 'OLE/ActiveX Automation Interfaces for "\\//" 'nl , tmpLocalCss nl , nl , tmp nl , ' 'nl , .resources~flip.js nl , ' 'nl , ' 'nl , '
'nl -- HTML body text leadin .local~leadin.body.text = '
'nl -- HTML body text leadout .local~leadout.body.text = '
'nl -- flip-code .local ~ flip.code = nl , ' 'nl , ' 'nl -- query computer, domain and user-name, save info with the local environment for later referral if .rgf.info=".RGF.INFO" then -- not set yet, query WSH for user data do wn = .OLEObject~New("WScript.Network") .local~rgf.info = wn~userName"/"wn~userDomain"@\\"wn~computerName end ::requires "oleinfo.cls" -- class which queries and keeps the OLE-infos /* create the HTML rendered output of the ole-infos */ ::routine oleinfo2html public use arg olestring, oleobj, bCompact, htmlString bCompact = (bCompact=.true) -- default to .false, i.e. more verbose output bBrowser = (window<>"WINDOW") -- determine whether running under MS Internet Explorer if bBrowser then -- assuming to run under WWW-browser window~status='Interrogating the OLE object automation interface ...' if arg(2)="" | arg(2)=.nil then a=.rgf.oleinfo~new(.nil, olestring) -- create a parsed OLEObject object else a=.rgf.oleinfo~new(oleobj, olestring) if a~oleobject=.nil then return .array~new -- no OLEObject available, return empty array ts. = a~allMethodSortedStem -- stem with all methods sorted -- outArray = .array~new -- create array which contains the HTML-lines -- aIdx = 1 -- set array index to 1 outMB=.mutableBuffer~new -- call time "r" call sag '

' a~oleString '

' call sag call sag 'Definitions from typelib:' '['a~libname']' call sag 'with the brief documentation:' call sag '['a~libdoc']' -- determine date of ooRexx interpreter, if newer than 20220516, then the attributes CLSID and ProgId are available sdate=date("s",.rexxinfo~date) -- turns ooRexx production date into a sorted date (YYYYMMDD) if sdate>"20220516" then -- show attributes ProgID and CLSID do call sag '

Effective ProgID: ['a~oleobject~progid']' call sag 'CLSID: ['a~oleobject~clsid']

' end call sag '
(These published interfaces got retrieved using the .OLEInfo class from ooRexx with the exact name: "'.rexxinfo~name'".)' call sag if arg(4, "Exists") then call sag htmlString -- insert received HTML-string if bCompact then call do_the_work_compact else do -- call sag .flip.code -- add flip-code for showing/hiding table bodies call do_the_work end call sag '

' call sag '

' call sag '
' call sag 'Created with ' call sag 'ooRexx (Open Object' call sag 'Rexx) ("createOleInfo.rex")' call sag 'on' '' pp(date("s") time()) '' call sag 'run by' '' pp(.rgf.info) '' call sag '
' call sag '
' call sag tmp=outMB~string -- broken up into two pieces: a string for and one for return .array~of( changestr( "\\//", .head.text, olestring), .leadin.body.text tmp .leadout.body.text ) /* create the HTML text for documenting the OLE interfaces: methods, get/put properties, events, constants */ do_the_work: /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ /* dump methods */ call sag '

' o=a~methodDir -- get method directory from OLEInfo object if bBrowser then -- assuming to run under WWW-browser window~status='Analyzing and creating HTML-text for available' o~items 'methods ...' call sag call sag '' -- call sag '
' if o~items=0 then do tmp1='' tmp2='style="display:none"' end else do tmp1='checked' tmp2='' end call sag call sag '' call sag '' call sag if bBrowser then -- assuming to run under WWW-browser window~status='Analyzing and creating HTML-text for available' o~items 'methods ...' m=0 do i=1 to ts.0 if o~hasentry(ts.i) then do m=m+1 ot=o~entry(ts.i) call sag '' call sag '
show', '' call sag '' '' a~methodDir~items 'Method[s]' '' call sag '
No. Name Documentation, Argument[s], Return Value' call sag '
'm '' ts.i , ' ' ot~doc~string '' '
' call sag call sag '' if ot~params~items > 0 then do call sag '
arg: ' call write_arguments ot~params end call sag '
returns: ' ot~retType choose(ot~retType="VT_VOID", "( no return value )", "") call sag '
' end call sag end call sag '
' call sag /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ /* readonly properties */ call sag '

' o=a~getOnlyPropertyDir -- get directory with the read-only properties from OLEinfo object if bBrowser then -- assuming to run under WWW-browser window~status='Analyzing and creating HTML-text for available' o~items 'read-only properties ...' call sag call sag '' if o~items=0 then do tmp1='' tmp2='style="display:none"' end else do tmp1='checked' tmp2='' end call sag '' call sag call sag '' m=0 do i=1 to ts.0 if o~hasentry(ts.i) then do m=m+1 ot=o~entry(ts.i) -- call sag '' call sag '
show', '' call sag '' '' a~getOnlyPropertyDir~items 'Read-only Properties' '' call sag '
No. Name Documentation, Return Value' call sag '
'm '' ts.i ' ' ot~doc~string '' '
' call sag '
'm '' ts.i , ' ' ot~doc~string '' '
' call sag call sag '' if ot~params~items > 0 then do call sag '
arg: ' call write_arguments ot~params end call sag '
returns: ' ot~retType choose(ot~retType="VT_VOID", "( no return value )", "") call sag '
' call sag end end call sag '
' call sag /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ /* write-only properties */ call sag '

' o=a~putOnlyPropertyDir -- get write-only property from OLEinfo object if bBrowser then -- assuming to run under WWW-browser window~status='Analyzing and creating HTML-text for available' o~items 'write-only properties ...' call sag call sag '' if o~items=0 then do tmp1='' tmp2='style="display:none"' end else do tmp1='checked' tmp2='' end call sag '' call sag call sag '' m=0 do i=1 to ts.0 if o~hasentry(ts.i) then do m=m+1 ot=o~entry(ts.i) -- call sag '' call sag '
show', '' call sag '' '' a~putOnlyPropertyDir~items 'Write-only Properties' '' call sag '
No. Name Documentation, Argument[s], Return Value' call sag '
'm '' ts.i ' ' ot~doc~string '' '
' call sag '
'm '' ts.i , ' ' ot~doc~string '' '
' call sag call sag '' if ot~params~items > 0 then do call sag '
arg: ' call write_arguments ot~params end call sag '
returns: ' ot~retType choose(ot~retType="VT_VOID", "( no return value )", "") call sag '
' end call sag end call sag '
' call sag /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ /* read/write properties */ call sag '

' o=a~getAndPutPropertyDir if bBrowser then -- assuming to run under WWW-browser window~status='Analyzing and creating HTML-text for available' o~items 'read/write properties ...' call sag call sag '' if o~items=0 then do tmp1='' tmp2='style="display:none"' end else do tmp1='checked' tmp2='' end call sag '' call sag call sag '' m=0 do i=1 to ts.0 if o~hasentry(ts.i) then do m=m+1 ot=o~entry(ts.i) -- call sag '' call sag '
show', '' call sag '' '' a~getAndPutPropertyDir~items 'Read/Write Properties' '' call sag '
No. Name Documentation, Argument[s], Return Value' call sag '
'm '' ts.i ' ' ot~doc~string'' '
' call sag '
'm '' ts.i , ' ' ot~doc~string '' '
' call sag call sag '' if ot~params~items > 0 then do call sag '
arg: ' call write_arguments ot~params end call sag '
needs/returns: ' ot~retType choose(ot~retType="VT_VOID", "( no return value )", "") call sag '
' call sag end end call sag '
' call sag /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ /* unknown properties/methods, i.e. unknown invocation type */ call sag '

' o=a~naDir if bBrowser then -- assuming to run under WWW-browser window~status='Analyzing and creating HTML-text for available' o~items 'unknown invocation types ...' call sag call sag '' if o~items=0 then do tmp1='' tmp2='style="display:none"' end else do tmp1='checked' tmp2='' end call sag '' call sag call sag '' m=0 do i=1 to ts.0 if o~hasentry(ts.i) then do m=m+1 ot=o~entry(ts.i) -- call sag '' call sag '
show', '' call sag '' '' a~naDir~items 'Methods with Unknown Invocation Type Properties' '' call sag '
No. Name Documentation, Argument[s], Return Value' call sag '
'm '' ts.i ' ' '
' call sag '
'm '' ts.i , ' ' ot~doc~string '' '
' call sag 'Invocation type:' ot~invkind "(".rgf.invKind[ot~invkind]")" '
' call sag call sag '' if ot~params~items > 0 then do call sag '
arg: ' call write_arguments ot~params end call sag '
returns: ' ot~retType choose(ot~retType="VT_VOID", "( no return value )", "") call sag '
' call sag '
' end call sag end call sag '
' call sag /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ /* events */ call sag '

' o=a~eventDir if bBrowser then -- assuming to run under WWW-browser window~status='Analyzing and creating HTML-text for available' o~items 'events ...' call sag call sag '' if o~items=0 then do tmp1='' tmp2='style="display:none"' end else do tmp1='checked' tmp2='' end call sag '' call sag call sag '' ts. = a~eventSortedStem m=0 do i=1 to ts.0 if o~hasentry(ts.i) then do m=m+1 ot=o~entry(ts.i) call sag '" call sag '
show', '' call sag '' '' a~eventDir~items 'Event(s)' '' call sag '
No. Name Documentation, Argument[s], Return Value' call sag '
'm '' ts.i , ' ' ot~doc~string '' '
' if ot~params~items > 0 then do call sag call sag '' call sag '
arg: ' call write_arguments ot~params call sag '
' end else call sag ' ' call sag end end call sag "
' call sag /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ /* constants */ ts.=a~constantSortedStem if bBrowser then -- assuming to run under WWW-browser window~status='Analyzing and creating HTML-text for available' ts.0 'constants ...' call sag '

' call sag call sag '' call sag '' call sag call sag '' do i=1 to ts.0 call sag '" call sag "
show', '' call sag '' '' ts.0 'Constant(s)' '' tmp2='style="display:none"' call sag '
No. Name Value' call sag '
'i '' ts.i '' a~oleobject~getconstant( ts.i ) end call sag "
" call sag /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ call sag if bBrowser then -- assuming to run under WWW-browser window~status='Done.' return /* create a compact (terse) output: methods, properties, events */ do_the_work_compact: /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ call sag '

' o=a~methodDir if bBrowser then -- assuming to run under WWW-browser window~status='Analyzing and creating HTML-text for available' o~items 'methods ...' call sag call sag '' call sag ' ' call sag call sag ' ' m=0 do i=1 to ts.0 if o~hasentry(ts.i) then do m=m+1 ot=o~entry(ts.i) p_items=ot~params~items -- get number of arguments/parameters evenOdd=choose( m//2, "odd", "even") call sag '' call sag ' ' call sag '
' '' a~methodDir~items 'Method[s]' '' call sag '
No. Name' call sag ' Argument[s], Documentation' call sag '
' m retType=ot~retType call sag ' 'choose(retType="VT_VOID", "", retType)'' call sag ' ' ts.i'' -- call sag ' ' call sag ' ' if p_items > 0 then do call sag '( ' call write_arguments_compact ot~params call sag ' )' end if wordpos( ot~doc~string, "n/a (null)") = 0 then do if p_items>0 then call sag '
' call sag '' ot~doc~string '' end call sag end end call sag '
' /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ call sag '

' Prop_totals=a~getPropertyDir~items + a~putPropertyDir~items + a~naDir~items if bBrowser then -- assuming to run under WWW-browser window~status='Analyzing and creating HTML-text for available' prop_totals 'properties ...' call sag call sag '' call sag ' ' call sag call sag ' ' -- o=a~methodDir m=0 do i=1 to ts.0 tmpList=.list~new tmp=a~getPropertyDir~entry(ts.i) -- a get property? getName="" if tmp <> .nil then do tmpList~insert(tmp) getName=ts.i end tmp=a~putPropertyDir~entry(ts.i) -- a put property? if tmp <> .nil then tmpList~insert(tmp) tmp=a~naDir~entry(ts.i) -- an unknown invoked method property? if tmp <> .nil then tmpList~insert(tmp) do ot over tmpList -- get all entries for m=m+1 -- ot=aMD~entry(ts.i) -- get property p_items=ot~params~items -- get number of arguments/parameters evenOdd=choose( m//2, "odd", "even") call sag '' call sag ' ' call sag '
' '' prop_totals 'Property[ies]' '' call sag '
No. Name' call sag ' Argument[s], Documentation' call sag '
' m retType=ot~retType call sag ' 'choose(retType="VT_VOID", "", retType)'' -- indicate the put-property by appending the assing operator "=" call sag ' ' ts.i || choose(ot~invKind=4, "=", "") '' -- call sag ' ' call sag ' ' if p_items > 0 then do call sag '( ' call write_arguments_compact ot~params call sag ' )' end if wordpos( ot~doc~string, "n/a (null)") = 0 & \(ot~invKind=4 & getName=ts.i) then do if p_items>0 then call sag '
' call sag '' ot~doc~string '' end end call sag end call sag '
' /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ call sag '

' o=a~eventDir if bBrowser then -- assuming to run under WWW-browser window~status='Analyzing and creating HTML-text for available' o~items 'events ...' call sag call sag '' call sag ' ' call sag call sag ' ' ts. = a~eventSortedStem m=0 do i=1 to ts.0 if o~hasentry(ts.i) then do m=m+1 ot=o~entry(ts.i) p_items=ot~params~items -- get number of arguments/parameters evenOdd=choose( m//2, "odd", "even") call sag '' call sag ' " call sag '
' '' o~items 'Event(s)' '' call sag '
No. Name' call sag ' Argument[s], Documentation' call sag '
' m call sag ' ' call sag ' ' ts.i'' -- call sag ' ' call sag ' ' if p_items > 0 then do call sag '( ' call write_arguments_compact ot~params call sag ' )' end if wordpos( ot~doc~string, "n/a (null)") = 0 then do if p_items>0 then call sag '
' call sag '' ot~doc~string '' end end call sag end call sag "
' call sag /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ call sag if bBrowser then -- assuming to run under WWW-browser window~status='Done.' return -- write all arguments of this method, event write_arguments: procedure expose outMB -- outArray aIdx use arg ot if ot~items=0 then return call sag call sag '' call sag '' , '' , '
arg #' m 'of' t':' '' choose(o~opt, pp(o~name), o~name) , -- call sag '
' choose(o~opt, pp(o~name), o~name) , call sag '
#' m':' '' choose(o~opt, '[ ' || o~name || ' ]', o~name) , '' choose(o~in, "in", "") , '' choose(o~out, "/out", "") , '' choose(o~opt, '[ optional ]', "") , '' o~type end call sag '
' return -- write all arguments of this method, event write_arguments_compact : procedure expose outMB -- outArray aIdx use arg ot if ot~items=0 then return t=ot~items m=0 do o over ot m=m+1 tmp = ''o~name'' tmp = tmp || ' ' || o~type || "" if o~out then tmp = tmp || ' ' || choose(o~in, "in/", "---") || "out" call sag choose( o~opt, ''pp(' 'tmp' ')"" , tmp) if m <> t then -- if not last argument, add comma call sag " ," end return -- save text in array sag: procedure expose outMB -- outArray aIdx outMB~~append(arg(1))~~append("0d0a"x) return -- cheap "pretty" print pp: procedure return "[" || arg(1)~string || "]" ::resource flip.js ::END ::resource flip.rex ' 'nl , ' 'nl ::END