/*----------------------------------------------------------------------------*/
/*                                                                            */
/* 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
