home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: Product
/
Product.zip
/
visilotu.zip
/
FILES.PRG
< prev
next >
Wrap
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