OS/2 Shareware BBS: Product/Product.zip/visilotu.zip/FILES.PRG

Text File | 1995-08-31 | 19KB | 597 lines

!.HEADER
!.SPEC APPDEST 0 D:\DESKTOP\VIS2LONO\LNQ.APL
!.HEADER
!
!
! Program Name     - FILES.PRG
!
! Program Function - Program Task for the Sample Lotus Notes Query application
!                    This program provides a modal dialog allowing the user to
!                    select a Lotus Notes form for querying.  The dialog provided
!                    is identical to the standard dialog used in Visualizer for the
!                    selection of tables, files, etc.  The user selects from a list
!                    of Lotus Notes servers to locate a Notes database.  Once a database
!                    is selected then a list of the Forms within the database is displayed.
!                    The User then selects the desired Form and control is returned to
!                    calling task.
!
!
! Called by        - LNQMAIN.PRG
!
! Calls            - LOTUSNOTES ASL Object for interface to Lotus Notes
!                    The Object is initialised in LNQMAIN and passed to this
!                    Module
!
! Dynamic-Link-Library with functions to access Lotus Notes
!
!
! The LOTUSNOTES object uses VIS2LONO.DLL (accessed via the LIBRARY DLL statement in ASL)
! to provide all of the function necessary to get data from Lotus Notes databases.
! The following actions are called from this program:
!
!   Request a list of servers from Notes     "GetServerList"
!   Request a list of files on a server      "GetFileList"
!   Request a list of forms in a database    "GetFormList"
!
!
!.spec winsize MAX MAX
!.spec textcol 0 17
!.spec appdest 0 d:\desktop\vis2lono\lnq.apl
!.HEADER
!
! DEFINITION
! This block contains general definitions.
!
DECLARE POINTER LotusObjectPtr                    ! Pointer to Lotus Notes Object
!
! ON SELECT
! This block is triggered whenever the user selects a control
! or menu entry.
!
ON SELECT
DO
  CASE A.System.Object
    !
    WHEN "T.W_files.STD_PUSH"
    DO
      CASE A.System.Boxnumber
        WHEN 1                                    ! button marked 'OK'
        DO
          IF FIND(ItemList,SelName)=0             ! is the form in our list
          DO                                      ! of valid forms?
            ERROR 2,"The Form name supplied does not exist, "||
             "please supply another."
            RETURN
          END

          ! Interpret OK on a primary window as required
          LET A..Server    = CurrentServer        ! set scalars for the application
          LET A..Directory = CurrentDirectory     ! level task so that
          LET A..Database  = CurrentFile          ! the appropriate functions
          LET A..Form      = SelName              ! can be executed there

          MODIFY T..W_Files,                      ! hide this window
           VISIBLE = No,                          ! by setting to INVISIBLE
           MODAL = No                             ! and turn off MODAL nature

          SIGNAL PROGRAM A.System.Master          ! signal the caller that we are done
        END
        !
        WHEN 2                                    ! button marked 'Cancel'
        DO
          MODIFY T..W_Files,                      ! hide this window
           VISIBLE = No,                          ! by setting to INVISIBLE
           MODAL = No                             ! and turn off MODAL nature

          SIGNAL PROGRAM A.System.Master          ! signal the caller that we are done

        END
        !
        WHEN 3                                    ! button marked 'Help'
        DO
          ! help button
          NOTHING
        END
        !
      END
    END
    !
    WHEN "T.W_files.LIST1"                        ! user selects from the lefthand
    DO                                            ! listbox (names of forms)
      ! list box set for single select mode

      DEFINE FormSel[0]
      CALL T.W_Files.LIST1'QUERYCHECK(FormSel[0])

      IF FormSel[0]'ENTRIES
        DO
        LET SelName=ItemList[A.System.BoxNumber]  ! store selected form name
        LET T.W_Files'CURSORBOX = T.W_Files.Std_Push[1]     ! Make OK Button the default
        END
      ELSE
        LET SelName = ""

    END
    !
    WHEN "T.W_files.LIST2"                        ! user selects from righthand
    DO                                            ! Listbox (Locations)
      ! list box set for single select mode
      CALL Fill_Locations(                        ! call function to use
       LocationList[A.System.BoxNumber],          ! selected location and type
       LocationType[A.System.BoxNumber])          ! to get next level of files/directories

      CALL T.W_Files.LIST2'UNCHECK(               ! de-select item in List
       A.System.BoxNumber)
      LET T.W_Files.LIST2'TOPROW=1                ! and set list to top row

    END
  END
END
!
! ON DATA
! This block responds to controls which can accept data entry.
! It is executed whenever the cursor leaves the control after
! data has been changed. This is normally used to provide input
! validation.
!
ON DATA
DO
  CASE A.System.Object
    WHEN "T.W_files.SLE1"
    DO
      ! React to change to data variable  SelName
      !
      !
    END
    WHEN "T.W_files.SLE2"
    DO
      ! React to change to data variable  SelLocation
      !
      !
      CALL User_Location()                        ! determine what location the user entered
    END
  END
END
ON START(pExistingName,pLotus)
DO
  DECLARE LOCAL NULL CHARACTER[*] pExistingName   ! Handle of main window passed as parameter
  DECLARE LOCAL POINTER pLOTUS                    ! Pointer to LotusNotes object from lnqmain

  LET LotusObjectPtr = pLOTUS                     ! Make Address available to whole program

  !
  ! Assign boolean variables
  LET yes = 1
  LET no  = 0

  !
  ! Assign all variables referred by the windows
  !
  LET SelName = ""
  LET SelLocation = ""

  !
  ! Call procedure to define data for list control(s)
  !
  CALL List_Define

  !
  OPEN WINDOW W_Files, , "I.Windows.Files",
   MODAL=Yes,
   OWNERWINDOW=A..W_lnqmain

  ! assign the default push button
  LET T.W_files.STD_PUSH[0]'DEFAULT = 1
  ! assign the help button
  LET T.W_files.STD_PUSH[0]'HELPBUTTON = 3
  !
END
!
! Construct the arrays needed to support list controls
!
PROCEDURE List_Define
DO
  !
  ! Define data to handle list 'T.W_files.LIST1'
  !
  DEFINE NColumns[0]                              ! coldata vector
  DEFINE NLayout[0]                               ! expression vector
  !
  ! fill the expression vector
  !
  INSERT NLayout[0]="WIDTH=120 SEPARATOR=YES JUST=LEFT READONLY=YES"
  !
  ! Initialise the referred vectors. These are the vectors
  ! which will contain the data to be displayed
  !
  DEFINE ItemList[0]
  !
  ! fill the reference vector to point to these vectors
  !
  INSERT NColumns[0] = "ItemList"
  !
  ! Define data to handle list 'T.W_files.LIST2'
  !
  DEFINE LColumns[0]                              ! coldata vector
  DEFINE LLayout[0]                               ! expression vector
  !
  ! fill the expression vector
  !
  INSERT LLayout[0]="WIDTH=100 SEPARATOR=YES JUST=LEFT READONLY=YES"
  INSERT LLayout[0]="WIDTH=150 SEPARATOR=YES JUST=LEFT READONLY=YES"
  !
  ! Initialise the referred vectors. These are the vectors
  ! which will contain the data to be displayed
  !
  DEFINE LocationList[0]
  DEFINE LocationDetails[0]
  !
  ! fill the reference vector to point to these vectors
  !
  INSERT LColumns[0] = "LocationList"
  INSERT LColumns[0] = "LocationDetails"

CALL Get_Server_List()
END
!
! ON ESCAPE
! This block is executed when the user hits the 'Escape'
! key. This will normally be interpreted to mean the same
! as a selection on a 'Cancel' button(ie shut the window without
! committing any changes) and is applicable to
! secondary windows only.
!
ON ESCAPE
DO
  IF A.System.Object ="T..W_files"
  DO
    LET A.System.BoxNumber= 2                     ! cancel button
    LET A.System.Object="T.W_files.Std_Push"
    QUEUE PROGRAM A.System.Thistask,SELECT
  END
END
!
! ON QUIT
! This block is executed when the user uses Close in the
! system menu.
! For a secondary window this would imply, 'shut the window'.
! For a primary window the impication is, 'close the
! Application'.
!
ON QUIT
DO
  CASE A.System.Object

    WHEN "T..W_files"                             ! primary window
      MODIFY T..W_Files,
       VISIBLE = No,
       MODAL = No

    OTHERWISE
      SHUT ?A.System.Object

  END
END
!
! ON ENTER
! This block is executed when the user hits the enter key
! This is normally coded to be equivalent to selecting
! the default push button (often the OK button).
!
ON ENTER
DO
  IF A.System.Object ="T..W_files"
  DO
    LET A.System.BoxNumber= T.W_files.Std_Push'DEFAULT[0]
    LET A.System.Object="T.W_files.Std_Push"
    QUEUE PROGRAM A.System.Thistask,SELECT
  END
END
!
! ON QUEUE
! The default block to which control is passed when another
! program RUNs or QUEUEs this task
!
ON QUEUE
DO
  MODIFY T..W_Files,                              ! control has been passed back
   VISIBLE = Yes,                                 ! so surface the window
   MODAL = Yes                                    ! and make it modal
END
!
! ERROR event
! This block is executed when there is a run-time error.
! You can trap errors here or allow the error message provided
! to identify the error and stop the program.
!

ON ERROR
DO
  !
  ! Message to identify failing module and line
  !
  LET ans=DIALOG("EFD7004",0,
   A.System.ErrorModule ,
   A.System.ErrorLine )

  DO i=1 : A.System.ErrorNumber[0]'ENTRIES

    IF ans = "CANCEL"
      TERMINATE

      ! Display system message corresponding to error
    LET ans = DIALOG ("EFD" ||
     A.System.Errornumber[i], 0,
     A.System.ErrorInfo[i])
  END
  STOP

END
!
! ON STOP
! This block is executed when the program is terminated.
! You should use the block to carry out any housekeeping
! required before closing
!
ON STOP
DO

  STOP
END
!
! User specified procedures may have up to 10 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE Fill_Locations(pLocation,pType)
DO
  DECLARE LOCAL NUMERIC CurrLen =0

  CASE pType                                      ! what type of item was selected?
    WHEN "SERVER"                                 ! a server
    DO
      LET SelLocation=pLocation                   ! First possible part of name

      LET CurrentServer=pLocation

      LET CurrentDirectory=""                     ! reset directory variable

      CALL Fill_List()                            ! fill list for this server

    END
    WHEN "DIRECTORY"                              ! a directory was selecte
    DO
      IF CurrentDirectory=""                      ! if the first directory
      DO
        LET SelLocation=CurrentServer ||"\"|| pLocation
        LET CurrentDirectory=pLocation
      END
      ELSE
      DO
        LET SelLocation=TRIM(SelLocation) ||
         "\" || pLocation

        LET CurrentDirectory=TRIM(CurrentDirectory)||
         "\"|| pLocation
      END

      CALL Fill_List()

    END
    WHEN "FILE"
    DO
      IF CurrentDirectory\=""
        LET CurrentFile=TRIM(CurrentDirectory) ||
         "\" ||
         pLocation
      ELSE
        LET CurrentFile = pLocation

      LET SelLocation=TRIM(SelLocation) ||
       "\" || pLocation

      LET CurrentDirectory=TRIM(CurrentDirectory)||
       "\"|| pLocation
      ! GetFormList

      DEFINE IList[0]
      DEFINE ItemList[0]


      ! 'push' button marked 'GetFormList'

      LET (?LotusObjectPtr)'SERVERNAME = CurrentServer
      LET (?LotusObjectPtr)'DIRECTORY = CurrentDirectory
      LET (?LotusObjectPtr)'DATABASE = CurrentFile

      FORGIVE
          CALL (?LotusObjectPtr)'GetFormList( POINTER(IList[0]) ) ! pointer to ASL vector of forms
      If (?LotusObjectPtr)'CODE > 0
         DO
         MESSAGE "FTB0003",0,(?LotusObjectPtr)'REASON
         RETURN
         END

      DO ii=1:IList[0]'ENTRIES
        IF Ilist[ii]\=""
          INSERT ItemList[0]=Ilist[ii]
      END

      DEFINE LocationList[0]                      ! Listbox vector of locations
      DEFINE LocationType[0]                      ! type of location


      INSERT LocationList[0]="[..]PREVIOUS"       ! and the previous one

       INSERT LocationType[0]="PREVIOUS"
    END
    WHEN "PREVIOUS"
    DO
      LET SelName = ""                            ! clear form name
      LET Levels=WORDS(CurrentDirectory,,"\")

      IF Levels
      DO
        LET CurrentDirectory=WORDS(CurrentDirectory,1,"\",
         Levels-1)
      END
      ELSE
      DO
        LET CurrentDirectory = ""

        CALL Get_Server_List()
        RETURN
      END

      IF CurrentServer=""
        LET SelLocation=CurrentDirectory
      ELSE
        LET SelLocation=CurrentServer||
         IF(CurrentDirectory\="","\","")||CurrentDirectory

      CALL Fill_List

    END

  END

END
!
! User specified procedures may have up to 10 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE Fill_List
DO
  DECLARE LOCAL CHARACTER[*] ReturnMsg
  DECLARE LOCAL CHARACTER[*] ServerName

  DEFINE DList[0]                                 ! used for list of Drives
  DEFINE FDetails[0]                              ! used for list of file details
  DEFINE FList[0]                                 ! used for list of files
  DEFINE ItemList[0]                              ! used for list of forms in file

  LET (?LotusObjectPtr)'ServerName = CurrentServer      ! call the API to get
  LET (?LotusObjectPtr)'Directory = CurrentDirectory    ! a list of drives/files/details
   FORGIVE                                        ! for the specified server
     CALL (?LotusObjectPtr)'GetFileList( POINTER(DList[0]),   ! and directory providing
                           POINTER(FList[0]),     ! ptr to vector of Directories and
                           POINTER(FDetails[0]))  ! ptr to vector of Files and
      If (?LotusObjectPtr)'CODE > 0               ! ptr to vector of File Details
         DO
         MESSAGE "FTB0003",0,(?LotusObjectPtr)'REASON
         RETURN
         END

  DEFINE LocationList[0]                          ! Listbox vector of locations
  DEFINE LocationType[0]                          ! type of location

  INSERT LocationList[0]="[..]PREVIOUS"           ! and the previous one

  INSERT LocationType[0]="PREVIOUS"

  DO ff=1:DList[0]'ENTRIES
    IF DList[ff]\=".." &
     DList[ff]\=" "
    DO
      INSERT LocationList[0]=DList[ff]
      INSERT LocationType[0]="DIRECTORY"
    END
  END

  DO ff=1:FList[0]'ENTRIES
    IF Flist[ff]\=""
    DO
      INSERT LocationList[0]=FList[ff]
      INSERT LocationType[0]="FILE"
    END
  END

END
!
! User specified procedures may have up to 20 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE User_Location
DO
  LET CurrentServer = WORDS(SelLocation,1,"\")    ! get server name from entry

  LET CurrentDirectory =                          ! get the directory path
   WORDS(
   SelLocation,                                   ! from the the entry
   2,                                             ! use 2 to skip the server name
   "\",                                           ! separate by "slash"
   WORDS(SelLocation,,"\")-2)                     ! get all except last part

  LET LastPartOfPath =                            ! now get the last part here
   WORDS(
   SelLocation,                                   ! from the entry
   WORDS(SelLocation,,"\"),"\")                   ! just get the last part

  CALL Fill_List()                                ! get list of drives/files for 'CurrentDirectory' above

  LET FindAt = FIND(LocationList,                 ! look for the last part
   LastPartOfPath)                                ! we derived above as well

  IF LocationType[FindAt] = "FILE"                ! if this last part is a file (notes database)
  DO
    CALL Fill_Locations(LastPartOfPath,"FILE")    ! then get list of forms for it

    LET SelLocation =                             ! directory is now the
     WORDS(SelLocation,                           ! entire path entered
     1,                                           ! excluding the server name
     "\",
     WORDS(SelLocation,,"\")-1)

  END
  ELSE                                            ! otherwise use the entire
  DO                                              ! path specified to get new list
    LET CurrentDirectory =                        ! directory is now the
     WORDS(SelLocation,                           ! entire path entered
     2,                                           ! excluding the server name
     "\",
     WORDS(SelLocation,,"\")-1)

    CALL Fill_List()                              ! refresh location list

  END
END
!
! User specified procedures may have up to 20 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE Get_Server_List
DO
  DEFINE LocationList[0]                          ! Listbox vector of locations
  DEFINE LocationType[0]                          ! type of location

  LET SelLocation = ""
  LET SelName     = ""

  DEFINE ServerList[0]
   FORGIVE
     CALL (?LotusObjectPtr)'GetServerList(POINTER(ServerList[0]))  ! Get List of Lotus Notes Server
                                                  ! into ServerList
   If (?LotusObjectPtr)'CODE > 0
      DO
      MESSAGE "FTB0003",0,(?LotusObjectPtr)'REASON
      RETURN
      END



  DO ss=1:ServerList[0]'ENTRIES                   ! "GetServerList" returns a blank
    IF \NOVALUE(ServerList[ss])                   ! in the list of servers if
      INSERT LocationList[0] =ServerList[ss]      ! any remote servers exist
  END

  DEFINE LocationType[LocationList[0]'ENTRIES]=   ! mark "Local" and all others as servers
   "SERVER"
END