rexx-things/modules/windows/oodialog/oleinfo/oleinfo.rex
2025-03-12 20:50:48 +00:00

655 lines
20 KiB
Rexx
Executable File

/*----------------------------------------------------------------------------*/
/* */
/* Copyright (c) 1995, 2004 IBM Corporation. All rights reserved. */
/* Copyright (c) 2005-2014 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. */
/* */
/*----------------------------------------------------------------------------*/
/****************************************************************************/
/* Name: OLEINFO.REX */
/* Type: Open Object Rexx Script using ooDialog */
/* Resource: OLEINFO.RC */
/* */
/* Description: */
/* A "small" browser for OLE objects */
/* */
/****************************************************************************/
discard = locate()
/* start the main dialog */
MainDialog = .OLEINFO~new
if MainDialog~InitCode = 0 then do
rc = MainDialog~Execute("SHOWTOP")
end
exit /* leave program */
::requires "ooDialog.cls" /* contains the ooDialog classes */
::requires "WINSYSTM.CLS" /* used for registry lookup */
/*****************************************/
/* This routine creates the OLE object */
/* the code has been placed outside the */
/* object code to safely catch any error */
/* during creation of the OLE object */
/*****************************************/
::routine createObject
use arg target, name
target~currentObject=.nil
signal on syntax name returnToObject
target~currentObject=.OLEObject~new(name,"NOEVENTS")
signal on syntax
return
returnToObject:
signal on syntax
call RxMessageBox "Error" rc":" errortext(rc)||'0a'x||condition('o')~message, "Error", "OK", "EXCLAMATION"
return
/*******************************************/
/* This routine calls a method of the OLE */
/* object. The code has been placed */
/* outside the object code to safely catch */
/* any error during the invocation */
/*******************************************/
::routine callMethod
use arg target, method, self
resultOfCall = ""
signal on syntax name callFailed
interpret "resultOfCall = target~"method
signal on syntax
return resultOfCall
callFailed:
call RxMessageBox "Error" rc":" errortext(rc)||'0a'x||condition('o')~message, "Error", "OK", "EXCLAMATION"
self~lastError=rc
signal on syntax
return resultOfCall
/**************************/
/* Main Dialog of OLEINFO */
/**************************/
::class OLEINFO subclass UserDialog
::method Init
expose cache
forward class (super) continue /* call parent constructor */
InitRet = Result
cache = .nil
/* load main dialog */
if self~Load(.application~srcDir"OLEINFO.rc", 4711 ) \= 0 then do
self~InitCode = 1
return 1
end
/* Connect dialog control items to class methods */
self~connectButtonEvent(200, "CLICKED", "MyOk")
self~connectButtonEvent(103, "CLICKED", "Lookup")
self~connectComboBoxEvent(100,"SELCHANGE","Ok")
self~connectListViewEvent(104,"ACTIVATE","selectDoubleClick")
self~connectListViewEvent(104,"CHANGED","selectionChange")
self~connectButtonEvent(107, "CLICKED", "selectionChange")
self~connectButtonEvent(108, "CLICKED", "selectionChange")
self~connectButtonEvent(109, "CLICKED", "selectionChange")
self~currentObject = .nil
self~currentObjectName = ""
return InitRet
::method InitDialog
self~newListView(104)~setImageList(self~getImages, SMALL)
cb = self~newComboBox(100)
default = .array~of("InternetExplorer.Application","Excel.Application","Freelance.Application",,
"Notes.NotesSession","Lotus123.Workbook","Outlook.Application",,
"Word.Application","WordPro.Application","Access.Application")
do i over default
cb~add(i)
end
/* Method Ok will be called if enter is pressed in dialog */
::method Ok
cb = self~newComboBox(100)
if cb \= .nil then do
OLEID = cb~Title /* get ProgID or ClassID of OLE Object */
if OLEID \= self~currentObjectName then do
call createObject self, OLEID
if self~currentObject \= .nil then do
self~currentObjectName=OLEID
self~updateView
end
else do
call RxMessageBox "Could not create OLE object", "Error", "OK", "EXCLAMATION"
cb~title = self~currentObjectName
end
end
end
return 0 /* don't leave dialog, this is done via method MyOk */
/* Method MyOk is connected to item 200 */
::method MyOk
return self~OK:super /* make sure self~Validate is called and self~InitCode is set to 1 */
/* Method Help is connected to item 9 */
::method Help
self~Help:super
file = .stream~new(.application~srcDir"help.txt")
data.500 = file~charin(,file~chars)
file~close
temp = .HelpDialog~new(data.)
if temp~InitCode = 0 then do
rc = temp~execute("SHOWTOP")
end
/* Method Lookup is connected to item 103 */
::method Lookup
expose cache
self~Cursor_Wait
progressBar = self~newProgressBar(110)
if cache == .nil then do
cache = .list~new
registry = .WindowsRegistry~new
if registry~InitCode \= 0 then return /* no access to registry? return */
handle = registry~open(registry~classes_root, "CLSID", "READ")
clslist. = registry~query(handle)
registry~list(handle,info.)
if progressBar \= .nil then do
progressBar~SetStep(1)
progressBar~SetRange(0,clslist.subkeys)
end
do i =1 to clslist.subkeys
temphandle = registry~open(handle, info.i, "READ")
if temphandle \= 0 then do
templist. = registry~query(temphandle)
value = self~getProgID(registry,temphandle,progressBar)
registry~close(temphandle)
if value \= .nil then cache~insert(value)
end
end
registry~close(handle)
end
if progressBar \= .nil then progressBar~SetPos(0)
self~Cursor_Arrow
picked = ""
temp = .RegistryDialog~new(,cache)
if temp~InitCode = 0 then do
rc = temp~execute("SHOWTOP")
if rc =1 then do
combo = self~newComboBox(100)
combo~title = temp~data200
picked = combo~title
self~ok
end
end
cb = self~newComboBox(100)
if cb \= .nil then do
cb~DeleteAll
do i over cache
cb~add(i)
end
if picked \== "" then cb~title = picked
end
/* extract ProgID from registry */
::method getProgID
use arg registry, handle, progressBar
res = .nil
/* try to get a version independent ProgID first */
temphandle = registry~open(handle, "VersionIndependentProgID", "READ")
if progressBar \= .nil then progressBar~step
if temphandle \= 0 then do
registry~listvalues(temphandle,info.)
res = info.1.data
registry~close(temphandle)
end
else do
/* this failed, so maybe there's a "normal" ProgID? */
temphandle = registry~open(handle, "ProgID", "READ")
if temphandle \= 0 then do
registry~listvalues(temphandle,info.)
res = info.1.data
registry~close(temphandle)
end
end
return res
::method currentObject ATTRIBUTE /* store the current object */
::method currentObjectName ATTRIBUTE /* store object's name */
/* update the list of methods and events */
::method updateView
expose indexStem. methods. events.
lc = self~newListView(104)
if lc \= .nil then do
methods. = self~currentObject~GetKnownMethods /* retrieve info on methods */
if methods. = .nil then do
temp = RxMessageBox("OLE Object did not return any information on known methods.","Information","OK","INFORMATION")
lc~DeleteAll /* remove all items from list */
return
end
events. = self~currentObject~GetKnownEvents /* retrieve info on events */
if events. = .nil then events.0 = 0
lc~DeleteAll /* remove all items from list */
if var("methods.!LIBNAME") = 1 then
self~newEdit(101)~title = methods.!LIBNAME
else
self~newEdit(101)~title = "unavailable"
if var("methods.!LIBDOC") = 1 then
self~newEdit(102)~title = methods.!LIBDOC
else
self~newEdit(102)~title = "unavailable"
/* collect the indices of the info stem ordered according to their method names */
indexStem.0 = 0
self~Cursor_Wait
pbc = self~newProgressBar(110)
if pbc \= .nil then do
pbc~SetStep(1)
pbc~SetRange(0,methods.0 + events.0)
end
do i = 1 to methods.0 + events.0
if i <= methods.0 then do
/* add method name to list box */
if methods.i.!INVKIND \= 4 then
j = lc~add(methods.i.!NAME, (methods.i.!INVKIND)%2)
else /* this is a property put, symbolize with "=" */
j = lc~add(methods.i.!NAME||"=",2)
end
else do
k = i - methods.0
j = lc~add(events.k.!NAME, 3)
end
j=j+1
if i \= j then do
do k = indexStem.0 to j by -1
t = k + 1
indexStem.t = indexStem.k
end
indexStem.j = i
end
else
indexStem.i = i
indexStem.0 = indexStem.0 + 1
if pbc \= .nil then pbc~Step
end
self~Cursor_Arrow
if pbc \= .nil then pbc~SetPos(0)
end
/* displays information on the selected method */
::method selectionChange
expose indexStem. methods. events.
listbox=self~newListView(104)
j = 1 + listbox~Selected
if j < 1 then return /* return if nothing was selected */
i = indexStem.j
types = self~getCheckBoxData(107)
flags = self~getCheckBoxData(108)
if i > methods.0 then do
workstem. = events.
i = i - methods.0
infostring = ""
end
else do
workstem. = methods.
memberID = self~getCheckBoxData(109)
/* show member ID? */
if memberID \= 0 then
infostring = "['"||workstem.i.!MEMID||"'x] "
else
infostring = ""
/* show return type? */
if types \= 0 then
infostring = infostring||workstem.i.!RETTYPE||" "
end
if methods.i.!INVKIND = 4 then /* property put */
infostring = infostring||workstem.i.!NAME||"="
else /* normal method or property get */
do
/* build method signature with name(...) */
infostring = infostring||workstem.i.!NAME
do j = 1 to workstem.i.!PARAMS.0
if j = 1 then infostring = infostring||"("
/* show flags? */
if flags \= 0 then
infostring = infostring||workstem.i.!PARAMS.j.!FLAGS||" "
/* show types? */
if types \= 0 then
infostring = infostring||workstem.i.!PARAMS.j.!TYPE||" "
/* show name of argument */
infostring = infostring||workstem.i.!PARAMS.j.!NAME
if j < workstem.i.!PARAMS.0 then
infostring = infostring||", "
else infostring = infostring||")"
end
end
/* set string to dialog */
signature = self~newEdit(105)
if signature \= .nil then
signature~title = infostring
desc = self~newEdit(106)
/* show documentation if available */
if desc \= .nil then do
interpret 'exists = var("workstem.'i'.!DOC")'
if exists = 1 then
desc~title = workstem.i.!DOC
else
desc~title="unavailable"
end
/* invoke method */
::method selectDoubleClick
expose indexStem. methods.
listbox=self~newListView(104)
j = 1 + listbox~Selected
i = indexStem.j
if i > methods.0 then do
call RxMessageBox "This is an event!"||'0a'x||"Build a subclass of OLEObject and add a method with",
"this name if you wish REXX to call it when this event occurs.", "Information", "OK", "EXCLAMATION"
return
end
params.0 = methods.i.!PARAMS.0
do j = 1 to params.0
params.j.!NAME = methods.i.!PARAMS.j.!NAME
params.j.!FLAGS = methods.i.!PARAMS.j.!FLAGS
params.j.!TYPE = methods.i.!PARAMS.j.!TYPE
end
aDialog=.invokeDialog~new(,params.)
aDialog~create(100,100,200,26+13*params.0,"Method invocation:" methods.i.!NAME)
rc = aDialog~execute("showtop")
if rc = 1 then do
execString = methods.i.!name
usesOutParms = .FALSE
self~LastError = 0
/* method call? */
if methods.i.!INVKIND = 1 then do
if params.0 > 0 then execString = execString"("
do i = 1 to params.0
interpret "value = aDialog~param"i
execString = execString || value
if i < params.0 then execString = execString", "
if params.i.!FLAGS~pos("out") > 0 then usesOutParms = .TRUE
end
if params.0 > 0 then execString = execString")"
resultOfCall = callMethod(self~currentObject, execstring, self)
end
/* property put? */
if methods.i.!INVKIND = 4 then do
value = aDialog~param1 /* can only have one argument */
interpret "self~currentObject~"execString "=" value
resultOfCall = ""
end
/* property get? */
if methods.i.!INVKIND = 2 then do
interpret "resultOfCall = self~currentObject~"execString
end
if usesOutParms = .TRUE then
outp = self~currentObject~GetOutParameters
else
outp = .nil
if self~LastError \= 0 then call RxMessageBox ERRORTEXT(self~LastError), "Error", "OK", "EXCLAMATION"
else do
temp = .ResultDialog~new(resultOfCall,outp)
if temp~initcode = 0 then do
temp~execute("showtop")
/* if useOLEobject attribute is filled in, change browser to this object */
if temp~useoleobject \= .nil then do
self~currentObject = temp~useOLEobject
self~currentObjectName = "??? (from execution)"
self~newComboBox(100)~title = self~currentObjectName
self~updateView
end
end
end
end
::method getImages private
image = .Image~getImage(.application~srcDir"icons.bmp")
imageList = .ImageList~create(.Size~new(16, 12), COLOR4, 6, 0)
if \image~isNull, \imageList~isNull then do
imageList~add(image)
image~release
return imageList
end
return .nil
::method LastError ATTRIBUTE
/*************************************/
/* Dialog for invoking an OLE method */
/*************************************/
::CLASS invokeDialog SUBCLASS UserDialog
::METHOD resultObject ATTRIBUTE /* takes the result of the invocation */
::METHOD init
expose params.
use arg initstem., params.
self~init:super
::METHOD DefineDialog
expose params.
self~DefineDialog:super
do i = 1 to params.0
self~createEdit(300+i, 64, -5+(13*i), 128, 11, "AUTOSCROLLH", "Param"i)
self~createStaticText(-1, 8, -5+(13*i), 56, 11, , params.i.!NAME)
end
self~createOkCancelRightBottom
::METHOD InitDialog
expose params.
self~resultObject = .nil
do i = 1 to params.0
/* plain out parameters can not be edited */
if params.i.!FLAGS = "[out]" then do
interpret "self~Param"i"='.NIL'"
self~newEdit(300+i)~disable
end
/* set .true if BOOL expected */
if params.i.!TYPE = "VT_BOOL" then interpret "self~param"i"='.TRUE'"
/* set empty string if string expected */
if params.i.!TYPE = "VT_BSTR" then interpret "self~param"i"='""""'"
end
::METHOD ok
return self~OK:super /* make sure self~Validate is called and self~InitCode is set to 1 */
/*******************************************************/
/* Dialog that shows the result of a method invocation */
/*******************************************************/
::class ResultDialog subclass UserDialog
::method Init
expose outarray
use arg rvalue, outarray
InitRet = self~init:super
if self~Load(.application~srcDir"OLEINFO.rc", 4713 ) \= 0 then do
self~InitCode = 1
return 1
end
self~data400=rvalue~string
if self~data400 = "an OLEOBJECT" then self~useOLEobject = rvalue
else self~useOLEobject = .nil
return InitRet
::method InitDialog
expose outarray
lc = self~newListBox(401)
if outarray \= .nil then do
if lc \= .nil then do
i = 1
do j over outarray
lc~add(i||'09'x||j~string)
i = i + 1
end
end
end
else
if lc \= .nil then do lc~add("object did not return out parameters")
end
::METHOD ok
if self~useOLEobject \= .nil then do
keep = RxMessageBox("An OLE object was returned from the method invocation. Do you want to use it as the active object?","Question","OKCANCEL","QUESTION")
if keep \= 1 then self~useOLEobject = .nil
end
return self~ok:super
::method useOLEobject ATTRIBUTE
/********************************************************/
/* Dialog that shows all ProgIDs obtained from Registry */
/********************************************************/
::class RegistryDialog subclass UserDialog
::method Init
expose cache
use arg stem., cache
forward class (super) continue /* call parent constructor */
InitRet = Result
if self~Load(.application~srcDir"OLEINFO.rc", 4712 ) \= 0 then do
self~InitCode = 1
return 1
end
self~connectListBoxEvent(200, "DBLCLK", "selectDoubleClick")
self~connectButtonEvent(201, "CLICKED", "search")
return InitRet
::method GetCache
expose cache
return cache
::method InitDialog
expose cache
lc = self~newListBox(200)
if lc \= .nil then do
do item over cache
lc~add(item)
end
end
::method OK
res = self~OK:super
return res
/* double clicking in the list closes this dialog window */
::method selectDoubleClick
self~OK /* make sure self~Validate is called and self~InitCode is set to 1 */
::method search
dlg = .InputBox~new("String:", "String search", "", 150)
value = dlg~Execute
drop dlg
lb = self~newListBox(200)
startindex = lb~selectedindex
lb~selectindex(lb~find(value,startindex,0))
/******************************/
/* Dialog that shows the help */
/******************************/
::class HelpDialog subclass UserDialog
::method Init
forward class (super) continue /* call parent constructor */
InitRet = Result
if self~Load(.application~srcDir"OLEINFO.rc", 4714 ) \= 0 then do
self~InitCode = 1
return 1
end
return InitRet