Form VL_SAM019: Displaying and Maintaining Security Details
Name: VL_SAM019
Description: The following RDMLX form allows standard LANSA file, process, function and form security information to be displayed and maintained.
Note: The data dictionary fields required by this form should be defined before the RDMLX code is pasted into the component editor. If you have pasted the code before defining the fields, simply define the fields now and then cut and paste the code again.
* ;
* This form requires the following dictionary level defined fields;
* before it can be compiled and used:;
* ;
* Name Type Length Decimals Description;
* ===== ==== ====== ======== ===========;
* S_019DES A 40 0 Description;
* S_019EXT A 10 0 Object Extension;
* S_019LAR A 20 0 List of Access Rights;
* S_019OBJ A 10 0 Object;
* S_019SP1 A 10 0 Spare Field 1 ;
* S_019SP2 A 18 0 Spare Field 2 ;
* S_019FRM A 20 0 Framework ;
* S_019GRP A 20 0 Group ;
* S_019TYP A 2 0 Object Type ;
* S_019USR A 10 0 User ;
* PROCDESC A 40 0 Process Description;
* ;
BEGIN_COM BORDERICONS(Maximize+Minimize+SystemMenu) FORMPOSITION(ScreenCenter) HEIGHT(300) WIDTH(660);
DEFINE_COM CLASS(#PRIM_TAB) NAME(#TABSHEET) DISPLAYPOSITION(1) HEIGHT(240) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(1) TOP(8) WIDTH(345);
* File Tab;
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#FILETAB) CAPTION(Files) DISPLAYPOSITION(1) HEIGHT(0) LEFT(0) PARENT(#TABSHEET) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(0);
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#FILELIST) DISPLAYPOSITION(1) HEIGHT(209) LEFT(0) PARENT(#FILETAB) SELECTIONSTYLE(Single) TABPOSITION(1) TOP(3) WIDTH(337);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FILENAM) CAPTION(File) CAPTIONTYPE(Caption) DISPLAYPOSITION(1) PARENT(#FILELIST) SOURCE(#S_019OBJ) WIDTH(26);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FILLIB) CAPTION(Library) CAPTIONTYPE(Caption) DISPLAYPOSITION(2) PARENT(#FILELIST) SOURCE(#S_019EXT) WIDTH(24);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FILDES) CAPTION(Description) CAPTIONTYPE(Caption) DISPLAYPOSITION(3) PARENT(#FILELIST) SOURCE(#S_019DES) WIDTH(30) WIDTHTYPE(Remainder);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FILSP1) CAPTION(Spare) CAPTIONTYPE(Caption) PARENT(#FILELIST) SOURCE(#S_019SP1) VISIBLE(False) WIDTH(20);
* Field Tab;
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#FLDTAB) CAPTION(Forms) DISPLAYPOSITION(2) HEIGHT(214) LEFT(4) PARENT(#TABSHEET) TABPOSITION(2) TABSTOP(False) TOP(22) WIDTH(337);
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#FLDLIST) DISPLAYPOSITION(1) HEIGHT(210) LEFT(0) PARENT(#FLDTAB) SELECTIONSTYLE(Single) TABPOSITION(1) TOP(3) WIDTH(335);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FLDNAM) CAPTION(Field) CAPTIONTYPE(Caption) DISPLAYPOSITION(1) PARENT(#FLDLIST) SOURCE(#S_019OBJ) WIDTH(27);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FLDDES) CAPTION(Description) CAPTIONTYPE(Caption) DISPLAYPOSITION(2) PARENT(#FLDLIST) SOURCE(#S_019DES) WIDTH(30) WIDTHTYPE(Remainder);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FLDFRM) CAPTION(Framework) CAPTIONTYPE(Caption) PARENT(#FLDLIST) SOURCE(#S_019FRM) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FLDGRP) CAPTION(Group) CAPTIONTYPE(Caption) PARENT(#FLDLIST) SOURCE(#S_019GRP) VISIBLE(False) WIDTH(20);
* Other stuff;
DEFINE_COM CLASS(#PRIM_STBR) NAME(#STBR_1) DISPLAYPOSITION(2) HEIGHT(22) LEFT(0) MESSAGEPOSITION(1) PARENT(#COM_OWNER) TABPOSITION(2) TOP(251) WIDTH(652);
* Authority Details;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_AUTH) CAPTION('Object Authority Details') DISPLAYPOSITION(3) HEIGHT(245) LEFT(355) PARENT(#COM_OWNER) TABPOSITION(3) TABSTOP(False) TOP(4) VISIBLE(False) WIDTH(297);
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#AUTHLIST) DISPLAYPOSITION(1) HEIGHT(115) PARENT(#GPBX_AUTH) SELECTIONSTYLE(Single) TABPOSITION(1) TOP(101) WIDTH(100);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHOBJ) PARENT(#AUTHLIST) SOURCE(#S_019OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHEXT) PARENT(#AUTHLIST) SOURCE(#S_019EXT) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHTYP) PARENT(#AUTHLIST) SOURCE(#S_019TYP) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHUSR) DISPLAYPOSITION(1) PARENT(#AUTHLIST) SOURCE(#S_019USR) WIDTH(100);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHLAR) PARENT(#AUTHLIST) SOURCE(#S_019LAR) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHSP2) PARENT(#AUTHLIST) SOURCE(#S_019SP2) VISIBLE(False) WIDTH(20);
* Other details ;
DEFINE_COM CLASS(#S_019OBJ.Visual) NAME(#S_019OBJ) CAPTION(Name) DISPLAYPOSITION(2) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(60) PARENT(#GPBX_AUTH) READONLY(True) TABPOSITION(2) TABSTOP(False) TOP(16) WIDTH(162);
DEFINE_COM CLASS(#S_019EXT.Visual) NAME(#S_019EXT) CAPTION(Extension) DISPLAYPOSITION(3) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(60) PARENT(#GPBX_AUTH) READONLY(True) TABPOSITION(3) TABSTOP(False) TOP(36) WIDTH(162);
DEFINE_COM CLASS(#S_019DES.Visual) NAME(#S_019DES) CAPTION(Description) DISPLAYPOSITION(4) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(60) PARENT(#GPBX_AUTH) READONLY(True) TABPOSITION(4) TABSTOP(False) TOP(76) WIDTH(281);
DEFINE_COM CLASS(#S_019TYP.Visual) NAME(#S_019TYP) CAPTION(Type) DISPLAYPOSITION(5) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(60) PARENT(#GPBX_AUTH) READONLY(True) TABPOSITION(5) TABSTOP(False) TOP(56) WIDTH(84);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_USER) DISPLAYPOSITION(6) HEIGHT(119) LEFT(112) PARENT(#GPBX_AUTH) TABPOSITION(6) TABSTOP(False) TOP(96) WIDTH(177);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_DEFN) CAPTION('Definition ') DISPLAYPOSITION(1) HEIGHT(98) LEFT(7) PARENT(#GPBX_USER) TABPOSITION(1) TABSTOP(False) TOP(16) WIDTH(73);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_DATA) CAPTION('Data Content') DISPLAYPOSITION(2) HEIGHT(99) LEFT(83) PARENT(#GPBX_USER) TABPOSITION(2) TABSTOP(False) TOP(16) WIDTH(86);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DEFNUD) CAPTION(Use) DISPLAYPOSITION(1) HEIGHT(22) PARENT(#GPBX_DEFN) TABPOSITION(1) TOP(12) WIDTH(50);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DEFNMD) CAPTION(Modify) DISPLAYPOSITION(2) HEIGHT(22) PARENT(#GPBX_DEFN) TABPOSITION(2) TOP(32) WIDTH(50);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DEFNDD) CAPTION(Delete) DISPLAYPOSITION(3) HEIGHT(22) PARENT(#GPBX_DEFN) TABPOSITION(3) TOP(52) WIDTH(50);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DATADS) CAPTION(Read) DISPLAYPOSITION(1) HEIGHT(22) PARENT(#GPBX_DATA) TABPOSITION(1) TOP(12) WIDTH(55);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DATAAD) CAPTION(Add) DISPLAYPOSITION(2) HEIGHT(22) LEFT(11) PARENT(#GPBX_DATA) TABPOSITION(2) TOP(32) WIDTH(46);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DATACH) CAPTION(Update) DISPLAYPOSITION(4) HEIGHT(22) LEFT(11) PARENT(#GPBX_DATA) TABPOSITION(3) TOP(52) WIDTH(59);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DATADL) CAPTION(Delete) DISPLAYPOSITION(3) HEIGHT(22) PARENT(#GPBX_DATA) TABPOSITION(4) TOP(72) WIDTH(50);
DEFINE_COM CLASS(#USER.Visual) NAME(#USER) DISPLAYPOSITION(7) HEIGHT(19) MARGINLEFT(0) PARENT(#GPBX_AUTH) TABPOSITION(7) TOP(216) WIDTH(100);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_NEW) CAPTION('<----- Add New User') DISPLAYPOSITION(8) HEIGHT(19) LEFT(114) PARENT(#GPBX_AUTH) TABPOSITION(8) TOP(216) WIDTH(174);
;
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#PROCTAB) CAPTION('Processes and Functions') DISPLAYPOSITION(3) HEIGHT(0) LEFT(0) PARENT(#TABSHEET) TABPOSITION(3) TABSTOP(False) TOP(0) WIDTH(0);
DEFINE_COM CLASS(#PRIM_TRVW) NAME(#PROCLIST) DISPLAYPOSITION(1) HEIGHT(200) LEFT(0) MANAGECHILDREN(True) PARENT(#PROCTAB) TABPOSITION(1) TOP(8) WIDTH(337);
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_1) DISPLAYPOSITION(1) LEVEL(1) PARENT(#PROCLIST) SOURCE(#PROCDESC);
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_2) KEYPOSITION(1) LEVEL(1) PARENT(#PROCLIST) SOURCE(#PROCESS) VISIBLE(False);
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_3) DISPLAYPOSITION(1) LEVEL(2) PARENT(#PROCLIST) SOURCE(#FUNCDESC);
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_4) KEYPOSITION(1) LEVEL(2) PARENT(#PROCLIST) SOURCE(#FUNCTION) VISIBLE(False);
DEFINE_COM CLASS(#PRIM_IMGE) NAME(#STOPLIGHT) DISPLAYPOSITION(2) HEIGHT(16) IMAGEHEIGHT(17) IMAGEWIDTH(15) LEFT(620) PARENT(#STBR_1) TABPOSITION(2) TOP(4) VISIBLE(False) WIDTH(15);
DEFINE_COM CLASS(#PRIM_IMGE) NAME(#GOLIGHT) DISPLAYPOSITION(1) HEIGHT(16) IMAGEHEIGHT(17) IMAGEWIDTH(15) LEFT(603) PARENT(#STBR_1) TABPOSITION(1) TOP(4) WIDTH(15);
DEFINE FIELD(#RETCODE) TYPE(*CHAR) LENGTH(2) DESC('Return Code');
DEF_COND NAME(*OKRETURN) COND('#RETCODE = OK');
DEF_COND NAME(*ERRETURN) COND('#RETCODE *NE OK');
DEF_COND NAME(*ISFILE) COND('#S_019TYP = FD');
DEF_COND NAME(*ISPROCESS) COND('#S_019TYP = PD');
DEF_COND NAME(*FUNLVLSEC) COND('#FUNCSEC = YES');
DEF_COND NAME(*VALIDUSER) COND('#USER *ne *blanks');
DEFINE FIELD(#FOUND) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#FUNCSEC) TYPE(*CHAR) LENGTH(10);
* ;
* Form Initialization ;
* ;
EVTROUTINE handling(#com_owner.Initialize);
SET #com_owner caption(*component_desc);
CHANGE #SYSVAR$AV *PART_DIR_EXECUTE;
USE TCONCAT (#SYSVAR$AV 'STOPLIGH.BMP') (#SYSVAR$AV);
SET #STOPLIGHT FILENAME(#SYSVAR$AV);
CHANGE #SYSVAR$AV *PART_DIR_EXECUTE;
USE TCONCAT (#SYSVAR$AV 'GOLIGHT.BMP') (#SYSVAR$AV);
SET #GOLIGHT FILENAME(#SYSVAR$AV);
ENDROUTINE ;
* ;
* Turn RED light and GREEN light on or off as requested by caller ;
* ;
SUBROUTINE SETBUSY ((#BUSYOPT *RECEIVED));
DEFINE #BUSYOPT *CHAR 5;
IF '#BUSYOPT = ON';
SET #GOLIGHT VISIBLE(FALSE);
SET #STOPLIGHT VISIBLE(TRUE);
ELSE ;
SET #STOPLIGHT VISIBLE(FALSE);
SET #GOLIGHT VISIBLE(TRUE);
ENDIF ;
ENDROUTINE ;
* ;
* File Tab Opening ;
* ;
EVTROUTINE HANDLING(#FILETAB.Opening);
define #fileload *char 1 default(N);
if '#fileload *ne Y' ;
Message 'Locating file details .... please wait' type(*status);
execute setBusy (ON);
USE BUILTIN(GET_PHYSICAL_LIST) WITH_ARGS(*BLANKS) TO_GET(#FILELIST);
change #fileload Y;
execute setBusy (OFF);
endif ;
ENDROUTINE ;
* ;
* Process Tab Opening ;
* ;
EVTROUTINE HANDLING(#PROCTAB.Opening);
DEFINE FIELD(#PROCLOAD) TYPE(*CHAR) LENGTH(1) DEFAULT(N);
DEF_LIST NAME(#PROCWORK) FIELDS(#PROCESS #PROCDESC #S_019SP1) TYPE(*WORKING) ENTRYS(9999);
IF COND('#PROCLOAD *NE Y');
CHANGE #STD_TEXTL '''Is your system currently configured to support function level security ?''';
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(YESNO NO QUESTION *COMPONENT #STD_TEXTL) TO_GET(#FUNCSEC);
MESSAGE MSGTXT('Locating process details .... please wait') TYPE(*STATUS);
execute setBusy (ON);
IF COND(*FUNLVLSEC);
SET #PROCLIST LinesAtRoot(True);
SET #PROCTAB Caption('Processes and Functions') ;
else ;
SET #PROCLIST LinesAtRoot(False) ;
SET #PROCTAB Caption('Processes') ;
ENDIF ;
USE BUILTIN(GET_PROCESS_LIST) WITH_ARGS(*BLANKS) TO_GET(#PROCWORK);
CHANGE FIELD(#PROCESS #FUNCTION #PROCDESC #FUNCDESC) TO(*BLANKS);
SELECTLIST NAMED(#PROCWORK);
ADD_ENTRY TO_LIST(#PROCLIST);
ENDSELECT ;
CLR_LIST NAMED(#PROCWORK);
CHANGE FIELD(#PROCLOAD) TO(Y);
execute setBusy (OFF);
endif ;
ENDROUTINE ;
* ;
* Process Tree Item Expansion : Get associated function details ;
* ;
EVTROUTINE HANDLING(#PROCLIST.ItemExpanding);
DEFINE FIELD(#FUNSP1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#FUNSP2) TYPE(*CHAR) LENGTH(12);
DEF_LIST NAME(#FUNCWORK) FIELDS(#FUNCTION #FUNSP1 #FUNCDESC #FUNSP2) TYPE(*WORKING) ENTRYS(9999);
IF '(#PROCLIST.CURRENTITEM.LEVEL = 1) *AND *FUNLVLSEC';
execute setBusy (ON);
CLR_LIST NAMED(#FUNCWORK);
USE BUILTIN(GET_FUNCTION_LIST) WITH_ARGS(#PROCESS) TO_GET(#FUNCWORK);
SELECTLIST #FUNCWORK;
add_entry #proclist ;
endselect;
execute setBusy (OFF);
endif ;
ENDROUTINE ;
* ;
* Process Tree Item Collapsed : Standard logic ;
* ;
EVTROUTINE HANDLING(#PROCLIST.ITEMCOLLAPSED );
SET #PROCLIST.CURRENTITEM HASCHILDREN(UNKNOWN);
endroutine ;
* ;
* Item selected from process-function tree view ;
* ;
EVTROUTINE HANDLING(#PROCLIST.ITEMGOTFOCUS );
IF '#PROCLIST.CURRENTITEM.LEVEL = 1';
CHANGE #S_019OBJ #PROCESS;
CHANGE #S_019EXT *BLANKS ;
change #S_019des #procdesc ;
EXECUTE SUBROUTINE(LOADAUTH) WITH_PARMS( PD );
else ;
CHANGE #S_019OBJ #PROCESS;
CHANGE #S_019EXT #FUNCTION ;
CHANGE #S_019DES #FUNCDESC ;
EXECUTE SUBROUTINE(LOADAUTH) WITH_PARMS( PF );
endif ;
endroutine ;
* ;
* Field Tab Opening ;
* ;
EVTROUTINE HANDLING(#FLDTAB.Opening);
define #fldload *char 1 default(N);
if '#fldload *ne Y';
define #lastcmp reffld(#std_obj);
define #lastfrm reffld(#S_019frm);
define #lastretc *char 2;
execute setBusy (ON);
Message 'Locating form details .... please wait' type(*status);
USE BUILTIN(GET_COMPONENT_LIST) WITH_ARGS(CMP *BLANKS) TO_GET(#FLDLIST #LASTCMP #LASTFRM #LASTRETC);
change #fldload Y;
execute setBusy (OFF);
endif ;
ENDROUTINE ;
* ;
* Load authority details for requested object ;
* ;
SUBROUTINE NAME(LOADAUTH) PARMS((#S_019TYP *RECEIVED));
execute setBusy (ON);
CLR_LIST NAMED(#AUTHLIST);
MESSAGE MSGTXT('Locating autghority details') TYPE(*STATUS);
USE BUILTIN(GET_AUTHORITIES) WITH_ARGS(#S_019OBJ #S_019EXT #S_019TYP) TO_GET(#RETCODE #AUTHLIST);
if *erreturn;
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK INFORMATION ERROR 'Security Information cannot be displayed');
ENDIF ;
SET #GPBX_AUTH VISIBLE(*OKRETURN);
SET #GPBX_USER VISIBLE(FALSE);
CHANGE #USER *BLANKS;
SET #BTN_NEW ENABLED(*VALIDUSER);
execute setBusy (OFF);
ENDROUTINE ;
* ;
* File selected from file list view;
* ;
EVTROUTINE HANDLING(#FILELIST.ItemGotSelection);
EXECUTE SUBROUTINE(LOADAUTH) WITH_PARMS( FD );
ENDROUTINE ;
* ;
* Field selected from field list view;
* ;
EVTROUTINE HANDLING(#FLDLIST.ItemGotSelection);
CHANGE FIELD(#S_019EXT) TO(*NULL);
EXECUTE SUBROUTINE(LOADAUTH) WITH_PARMS( DF );
ENDROUTINE ;
* ;
* Item in user authority list lost selection;
* ;
EVTROUTINE HANDLING(#AUTHLIST.ITEMLOSTSELECTION);
SET #GPBX_USER VISIBLE(FALSE);
ENDROUTINE ;
* ;
* Item in user authority list got selected;
* ;
EVTROUTINE HANDLING(#AUTHLIST.ItemGotSelection);
SET #GPBX_USER VISIBLE(TRUE);
CHANGE #USER *BLANKS;
SET #BTN_NEW ENABLED(*VALIDUSER);
SET #GPBX_USER CAPTION(#S_019USR);
set #GPBX_DEFN visible(true);
SET #GPBX_DATA VISIBLE(*ISFILE);
execute SetChkBox;
ENDROUTINE ;
* ;
* Set details of all authority check boxes for presentation;
* ;
subroutine SetChkBox ;
DEFINE FIELD(#TEST_TYP) REFFLD(#S_019TYP);
DEFINE FIELD(#WRKLAR) REFFLD(#S_019LAR);
DEFINE FIELD(#XX) REFFLD(#STD_NUM);
DEF_ARRAY NAME(#LAR) INDEXES(#XX) OVERLAYING(#WRKLAR) TYPE(*CHAR) TOT_ENTRY(10) ENTRY_LEN(2);
* ;
SET #CK_DEFNUD BUTTONSTATE(UnChecked);
SET #CK_DEFNMD BUTTONSTATE(UnChecked);
SET #CK_DEFNDD BUTTONSTATE(UnChecked);
SET #CK_DATADS BUTTONSTATE(UnChecked);
SET #CK_DATAAD BUTTONSTATE(UnChecked);
SET #CK_DATACH BUTTONSTATE(UnChecked);
SET #CK_DATADL BUTTONSTATE(UnChecked);
* ;
CHANGE FIELD(#WRKLAR) TO(#S_019LAR);
* ;
BEGIN_LOOP FROM(1) TO(10) USING(#XX);
case #LAR#XX;
when '= UD';
SET #CK_DEFNUD BUTTONSTATE(Checked);
when '= MD';
SET #CK_DEFNMD BUTTONSTATE(Checked);
when '= DD';
SET #CK_DEFNDD BUTTONSTATE(Checked);
when '= DS';
SET #CK_DATADS BUTTONSTATE(Checked);
when '= AD';
SET #CK_DATAAD BUTTONSTATE(Checked);
when '= CH';
SET #CK_DATACH BUTTONSTATE(Checked);
when '= DL';
SET #CK_DATADL BUTTONSTATE(Checked);
endcase ;
END_LOOP ;
* ;
endroutine ;
* ;
* New user name details changed;
* ;
EVTROUTINE HANDLING(#USER.Changed);
SET #BTN_NEW ENABLED(*VALIDUSER);
ENDROUTINE ;
* ;
* New user button clicked;
* ;
EVTROUTINE HANDLING(#BTN_NEW.CLICK);
SET #GPBX_USER VISIBLE(FALSE);
CHANGE FIELD(#FOUND) TO(N);
SELECTLIST #AUTHLIST ;
if '#S_019usr = #user';
CHANGE FIELD(#FOUND) TO(Y);
SET #AUTHLIST.CURRENTITEM Selected(TRUE) ;
LEAVE ;
endif ;
ENDSELECT ;
if '#found = N';
change #S_019usr #user;
if *isfile;
CHANGE #S_019LAR UDDSADCHDL;
else ;
CHANGE #S_019LAR UD;
endif ;
EXECUTE SUBROUTINE(UPDATEAUTH);
ADD_ENTRY #AUTHLIST;
SET #AUTHLIST.CURRENTITEM ENSUREVISIBLE(TRUE) ;
SET #AUTHLIST.CURRENTITEM Selected(TRUE) ;
ENDIF ;
CHANGE #USER *BLANKS;
SET #BTN_NEW ENABLED(*VALIDUSER);
invoke #user.setfocus;
ENDROUTINE ;
* ;
* Any security Check box clicked ;
* ;
EVTROUTINE HANDLING(#CK_DEFNUD.CLICK #CK_DEFNMD.CLICK #CK_DEFNDD.CLICK #CK_DATADS.CLICK #CK_DATAAD.CLICK #CK_DATACH.CLICK #CK_DATADL.CLICK);
change #wrklar *blanks;
change #xx 1;
if '#CK_DEFNUD.ButtonState = Checked';
change #lar#xx UD;
change #xx '#xx + 1';
endif ;
if '#CK_DEFNMD.ButtonState = Checked';
change #lar#xx MD;
change #xx '#xx + 1';
endif ;
if '#CK_DEFNDD.ButtonState = Checked';
change #lar#xx DD;
change #xx '#xx + 1';
endif ;
if '#CK_DATADS.ButtonState = Checked';
change #lar#xx DS;
change #xx '#xx + 1';
endif ;
if '#CK_DATAAD.ButtonState = Checked';
change #lar#xx AD;
change #xx '#xx + 1';
endif ;
if '#CK_DATACH.ButtonState = Checked';
change #lar#xx CH;
change #xx '#xx + 1';
endif ;
if '#CK_DATADL.ButtonState = Checked';
change #lar#xx DL;
change #xx '#xx + 1';
endif ;
CHANGE FIELD(#S_019LAR) TO(#WRKLAR);
UPD_ENTRY IN_LIST(#AUTHLIST);
EXECUTE SUBROUTINE(UPDATEAUTH);
endroutine ;
* ;
* Update authority for specified object / user;
* ;
subroutine updateauth;
IF COND(*ISPROCESS);
USE BUILTIN(SET_AUTHORITY) WITH_ARGS(#S_019OBJ *blanks #S_019TYP #S_019USR #S_019LAR) TO_GET(#RETCODE);
else ;
USE BUILTIN(SET_AUTHORITY) WITH_ARGS(#S_019OBJ #S_019EXT #S_019TYP #S_019USR #S_019LAR) TO_GET(#RETCODE);
endif ;
IF *ERRETURN;
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK INFORMATION ERROR 'Security Information was NOT updated');
ENDIF ;
ENDROUTINE ;
;
END_COM ;
Name: VL_SAM019
Description: The following RDMLX form allows standard LANSA file, process, function and form security information to be displayed and maintained.
Note: The data dictionary fields required by this form should be defined before the RDMLX code is pasted into the component editor. If you have pasted the code before defining the fields, simply define the fields now and then cut and paste the code again.
* ;
* This form requires the following dictionary level defined fields;
* before it can be compiled and used:;
* ;
* Name Type Length Decimals Description;
* ===== ==== ====== ======== ===========;
* S_019DES A 40 0 Description;
* S_019EXT A 10 0 Object Extension;
* S_019LAR A 20 0 List of Access Rights;
* S_019OBJ A 10 0 Object;
* S_019SP1 A 10 0 Spare Field 1 ;
* S_019SP2 A 18 0 Spare Field 2 ;
* S_019FRM A 20 0 Framework ;
* S_019GRP A 20 0 Group ;
* S_019TYP A 2 0 Object Type ;
* S_019USR A 10 0 User ;
* PROCDESC A 40 0 Process Description;
* ;
BEGIN_COM BORDERICONS(Maximize+Minimize+SystemMenu) FORMPOSITION(ScreenCenter) HEIGHT(300) WIDTH(660);
DEFINE_COM CLASS(#PRIM_TAB) NAME(#TABSHEET) DISPLAYPOSITION(1) HEIGHT(240) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(1) TOP(8) WIDTH(345);
* File Tab;
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#FILETAB) CAPTION(Files) DISPLAYPOSITION(1) HEIGHT(0) LEFT(0) PARENT(#TABSHEET) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(0);
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#FILELIST) DISPLAYPOSITION(1) HEIGHT(209) LEFT(0) PARENT(#FILETAB) SELECTIONSTYLE(Single) TABPOSITION(1) TOP(3) WIDTH(337);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FILENAM) CAPTION(File) CAPTIONTYPE(Caption) DISPLAYPOSITION(1) PARENT(#FILELIST) SOURCE(#S_019OBJ) WIDTH(26);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FILLIB) CAPTION(Library) CAPTIONTYPE(Caption) DISPLAYPOSITION(2) PARENT(#FILELIST) SOURCE(#S_019EXT) WIDTH(24);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FILDES) CAPTION(Description) CAPTIONTYPE(Caption) DISPLAYPOSITION(3) PARENT(#FILELIST) SOURCE(#S_019DES) WIDTH(30) WIDTHTYPE(Remainder);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FILSP1) CAPTION(Spare) CAPTIONTYPE(Caption) PARENT(#FILELIST) SOURCE(#S_019SP1) VISIBLE(False) WIDTH(20);
* Field Tab;
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#FLDTAB) CAPTION(Forms) DISPLAYPOSITION(2) HEIGHT(214) LEFT(4) PARENT(#TABSHEET) TABPOSITION(2) TABSTOP(False) TOP(22) WIDTH(337);
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#FLDLIST) DISPLAYPOSITION(1) HEIGHT(210) LEFT(0) PARENT(#FLDTAB) SELECTIONSTYLE(Single) TABPOSITION(1) TOP(3) WIDTH(335);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FLDNAM) CAPTION(Field) CAPTIONTYPE(Caption) DISPLAYPOSITION(1) PARENT(#FLDLIST) SOURCE(#S_019OBJ) WIDTH(27);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FLDDES) CAPTION(Description) CAPTIONTYPE(Caption) DISPLAYPOSITION(2) PARENT(#FLDLIST) SOURCE(#S_019DES) WIDTH(30) WIDTHTYPE(Remainder);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FLDFRM) CAPTION(Framework) CAPTIONTYPE(Caption) PARENT(#FLDLIST) SOURCE(#S_019FRM) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#FLDGRP) CAPTION(Group) CAPTIONTYPE(Caption) PARENT(#FLDLIST) SOURCE(#S_019GRP) VISIBLE(False) WIDTH(20);
* Other stuff;
DEFINE_COM CLASS(#PRIM_STBR) NAME(#STBR_1) DISPLAYPOSITION(2) HEIGHT(22) LEFT(0) MESSAGEPOSITION(1) PARENT(#COM_OWNER) TABPOSITION(2) TOP(251) WIDTH(652);
* Authority Details;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_AUTH) CAPTION('Object Authority Details') DISPLAYPOSITION(3) HEIGHT(245) LEFT(355) PARENT(#COM_OWNER) TABPOSITION(3) TABSTOP(False) TOP(4) VISIBLE(False) WIDTH(297);
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#AUTHLIST) DISPLAYPOSITION(1) HEIGHT(115) PARENT(#GPBX_AUTH) SELECTIONSTYLE(Single) TABPOSITION(1) TOP(101) WIDTH(100);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHOBJ) PARENT(#AUTHLIST) SOURCE(#S_019OBJ) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHEXT) PARENT(#AUTHLIST) SOURCE(#S_019EXT) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHTYP) PARENT(#AUTHLIST) SOURCE(#S_019TYP) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHUSR) DISPLAYPOSITION(1) PARENT(#AUTHLIST) SOURCE(#S_019USR) WIDTH(100);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHLAR) PARENT(#AUTHLIST) SOURCE(#S_019LAR) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#AUTHSP2) PARENT(#AUTHLIST) SOURCE(#S_019SP2) VISIBLE(False) WIDTH(20);
* Other details ;
DEFINE_COM CLASS(#S_019OBJ.Visual) NAME(#S_019OBJ) CAPTION(Name) DISPLAYPOSITION(2) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(60) PARENT(#GPBX_AUTH) READONLY(True) TABPOSITION(2) TABSTOP(False) TOP(16) WIDTH(162);
DEFINE_COM CLASS(#S_019EXT.Visual) NAME(#S_019EXT) CAPTION(Extension) DISPLAYPOSITION(3) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(60) PARENT(#GPBX_AUTH) READONLY(True) TABPOSITION(3) TABSTOP(False) TOP(36) WIDTH(162);
DEFINE_COM CLASS(#S_019DES.Visual) NAME(#S_019DES) CAPTION(Description) DISPLAYPOSITION(4) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(60) PARENT(#GPBX_AUTH) READONLY(True) TABPOSITION(4) TABSTOP(False) TOP(76) WIDTH(281);
DEFINE_COM CLASS(#S_019TYP.Visual) NAME(#S_019TYP) CAPTION(Type) DISPLAYPOSITION(5) HEIGHT(19) LABELTYPE(Caption) LEFT(7) MARGINLEFT(60) PARENT(#GPBX_AUTH) READONLY(True) TABPOSITION(5) TABSTOP(False) TOP(56) WIDTH(84);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_USER) DISPLAYPOSITION(6) HEIGHT(119) LEFT(112) PARENT(#GPBX_AUTH) TABPOSITION(6) TABSTOP(False) TOP(96) WIDTH(177);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_DEFN) CAPTION('Definition ') DISPLAYPOSITION(1) HEIGHT(98) LEFT(7) PARENT(#GPBX_USER) TABPOSITION(1) TABSTOP(False) TOP(16) WIDTH(73);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_DATA) CAPTION('Data Content') DISPLAYPOSITION(2) HEIGHT(99) LEFT(83) PARENT(#GPBX_USER) TABPOSITION(2) TABSTOP(False) TOP(16) WIDTH(86);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DEFNUD) CAPTION(Use) DISPLAYPOSITION(1) HEIGHT(22) PARENT(#GPBX_DEFN) TABPOSITION(1) TOP(12) WIDTH(50);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DEFNMD) CAPTION(Modify) DISPLAYPOSITION(2) HEIGHT(22) PARENT(#GPBX_DEFN) TABPOSITION(2) TOP(32) WIDTH(50);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DEFNDD) CAPTION(Delete) DISPLAYPOSITION(3) HEIGHT(22) PARENT(#GPBX_DEFN) TABPOSITION(3) TOP(52) WIDTH(50);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DATADS) CAPTION(Read) DISPLAYPOSITION(1) HEIGHT(22) PARENT(#GPBX_DATA) TABPOSITION(1) TOP(12) WIDTH(55);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DATAAD) CAPTION(Add) DISPLAYPOSITION(2) HEIGHT(22) LEFT(11) PARENT(#GPBX_DATA) TABPOSITION(2) TOP(32) WIDTH(46);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DATACH) CAPTION(Update) DISPLAYPOSITION(4) HEIGHT(22) LEFT(11) PARENT(#GPBX_DATA) TABPOSITION(3) TOP(52) WIDTH(59);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#CK_DATADL) CAPTION(Delete) DISPLAYPOSITION(3) HEIGHT(22) PARENT(#GPBX_DATA) TABPOSITION(4) TOP(72) WIDTH(50);
DEFINE_COM CLASS(#USER.Visual) NAME(#USER) DISPLAYPOSITION(7) HEIGHT(19) MARGINLEFT(0) PARENT(#GPBX_AUTH) TABPOSITION(7) TOP(216) WIDTH(100);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_NEW) CAPTION('<----- Add New User') DISPLAYPOSITION(8) HEIGHT(19) LEFT(114) PARENT(#GPBX_AUTH) TABPOSITION(8) TOP(216) WIDTH(174);
;
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#PROCTAB) CAPTION('Processes and Functions') DISPLAYPOSITION(3) HEIGHT(0) LEFT(0) PARENT(#TABSHEET) TABPOSITION(3) TABSTOP(False) TOP(0) WIDTH(0);
DEFINE_COM CLASS(#PRIM_TRVW) NAME(#PROCLIST) DISPLAYPOSITION(1) HEIGHT(200) LEFT(0) MANAGECHILDREN(True) PARENT(#PROCTAB) TABPOSITION(1) TOP(8) WIDTH(337);
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_1) DISPLAYPOSITION(1) LEVEL(1) PARENT(#PROCLIST) SOURCE(#PROCDESC);
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_2) KEYPOSITION(1) LEVEL(1) PARENT(#PROCLIST) SOURCE(#PROCESS) VISIBLE(False);
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_3) DISPLAYPOSITION(1) LEVEL(2) PARENT(#PROCLIST) SOURCE(#FUNCDESC);
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_4) KEYPOSITION(1) LEVEL(2) PARENT(#PROCLIST) SOURCE(#FUNCTION) VISIBLE(False);
DEFINE_COM CLASS(#PRIM_IMGE) NAME(#STOPLIGHT) DISPLAYPOSITION(2) HEIGHT(16) IMAGEHEIGHT(17) IMAGEWIDTH(15) LEFT(620) PARENT(#STBR_1) TABPOSITION(2) TOP(4) VISIBLE(False) WIDTH(15);
DEFINE_COM CLASS(#PRIM_IMGE) NAME(#GOLIGHT) DISPLAYPOSITION(1) HEIGHT(16) IMAGEHEIGHT(17) IMAGEWIDTH(15) LEFT(603) PARENT(#STBR_1) TABPOSITION(1) TOP(4) WIDTH(15);
DEFINE FIELD(#RETCODE) TYPE(*CHAR) LENGTH(2) DESC('Return Code');
DEF_COND NAME(*OKRETURN) COND('#RETCODE = OK');
DEF_COND NAME(*ERRETURN) COND('#RETCODE *NE OK');
DEF_COND NAME(*ISFILE) COND('#S_019TYP = FD');
DEF_COND NAME(*ISPROCESS) COND('#S_019TYP = PD');
DEF_COND NAME(*FUNLVLSEC) COND('#FUNCSEC = YES');
DEF_COND NAME(*VALIDUSER) COND('#USER *ne *blanks');
DEFINE FIELD(#FOUND) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#FUNCSEC) TYPE(*CHAR) LENGTH(10);
* ;
* Form Initialization ;
* ;
EVTROUTINE handling(#com_owner.Initialize);
SET #com_owner caption(*component_desc);
CHANGE #SYSVAR$AV *PART_DIR_EXECUTE;
USE TCONCAT (#SYSVAR$AV 'STOPLIGH.BMP') (#SYSVAR$AV);
SET #STOPLIGHT FILENAME(#SYSVAR$AV);
CHANGE #SYSVAR$AV *PART_DIR_EXECUTE;
USE TCONCAT (#SYSVAR$AV 'GOLIGHT.BMP') (#SYSVAR$AV);
SET #GOLIGHT FILENAME(#SYSVAR$AV);
ENDROUTINE ;
* ;
* Turn RED light and GREEN light on or off as requested by caller ;
* ;
SUBROUTINE SETBUSY ((#BUSYOPT *RECEIVED));
DEFINE #BUSYOPT *CHAR 5;
IF '#BUSYOPT = ON';
SET #GOLIGHT VISIBLE(FALSE);
SET #STOPLIGHT VISIBLE(TRUE);
ELSE ;
SET #STOPLIGHT VISIBLE(FALSE);
SET #GOLIGHT VISIBLE(TRUE);
ENDIF ;
ENDROUTINE ;
* ;
* File Tab Opening ;
* ;
EVTROUTINE HANDLING(#FILETAB.Opening);
define #fileload *char 1 default(N);
if '#fileload *ne Y' ;
Message 'Locating file details .... please wait' type(*status);
execute setBusy (ON);
USE BUILTIN(GET_PHYSICAL_LIST) WITH_ARGS(*BLANKS) TO_GET(#FILELIST);
change #fileload Y;
execute setBusy (OFF);
endif ;
ENDROUTINE ;
* ;
* Process Tab Opening ;
* ;
EVTROUTINE HANDLING(#PROCTAB.Opening);
DEFINE FIELD(#PROCLOAD) TYPE(*CHAR) LENGTH(1) DEFAULT(N);
DEF_LIST NAME(#PROCWORK) FIELDS(#PROCESS #PROCDESC #S_019SP1) TYPE(*WORKING) ENTRYS(9999);
IF COND('#PROCLOAD *NE Y');
CHANGE #STD_TEXTL '''Is your system currently configured to support function level security ?''';
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(YESNO NO QUESTION *COMPONENT #STD_TEXTL) TO_GET(#FUNCSEC);
MESSAGE MSGTXT('Locating process details .... please wait') TYPE(*STATUS);
execute setBusy (ON);
IF COND(*FUNLVLSEC);
SET #PROCLIST LinesAtRoot(True);
SET #PROCTAB Caption('Processes and Functions') ;
else ;
SET #PROCLIST LinesAtRoot(False) ;
SET #PROCTAB Caption('Processes') ;
ENDIF ;
USE BUILTIN(GET_PROCESS_LIST) WITH_ARGS(*BLANKS) TO_GET(#PROCWORK);
CHANGE FIELD(#PROCESS #FUNCTION #PROCDESC #FUNCDESC) TO(*BLANKS);
SELECTLIST NAMED(#PROCWORK);
ADD_ENTRY TO_LIST(#PROCLIST);
ENDSELECT ;
CLR_LIST NAMED(#PROCWORK);
CHANGE FIELD(#PROCLOAD) TO(Y);
execute setBusy (OFF);
endif ;
ENDROUTINE ;
* ;
* Process Tree Item Expansion : Get associated function details ;
* ;
EVTROUTINE HANDLING(#PROCLIST.ItemExpanding);
DEFINE FIELD(#FUNSP1) TYPE(*CHAR) LENGTH(1);
DEFINE FIELD(#FUNSP2) TYPE(*CHAR) LENGTH(12);
DEF_LIST NAME(#FUNCWORK) FIELDS(#FUNCTION #FUNSP1 #FUNCDESC #FUNSP2) TYPE(*WORKING) ENTRYS(9999);
IF '(#PROCLIST.CURRENTITEM.LEVEL = 1) *AND *FUNLVLSEC';
execute setBusy (ON);
CLR_LIST NAMED(#FUNCWORK);
USE BUILTIN(GET_FUNCTION_LIST) WITH_ARGS(#PROCESS) TO_GET(#FUNCWORK);
SELECTLIST #FUNCWORK;
add_entry #proclist ;
endselect;
execute setBusy (OFF);
endif ;
ENDROUTINE ;
* ;
* Process Tree Item Collapsed : Standard logic ;
* ;
EVTROUTINE HANDLING(#PROCLIST.ITEMCOLLAPSED );
SET #PROCLIST.CURRENTITEM HASCHILDREN(UNKNOWN);
endroutine ;
* ;
* Item selected from process-function tree view ;
* ;
EVTROUTINE HANDLING(#PROCLIST.ITEMGOTFOCUS );
IF '#PROCLIST.CURRENTITEM.LEVEL = 1';
CHANGE #S_019OBJ #PROCESS;
CHANGE #S_019EXT *BLANKS ;
change #S_019des #procdesc ;
EXECUTE SUBROUTINE(LOADAUTH) WITH_PARMS( PD );
else ;
CHANGE #S_019OBJ #PROCESS;
CHANGE #S_019EXT #FUNCTION ;
CHANGE #S_019DES #FUNCDESC ;
EXECUTE SUBROUTINE(LOADAUTH) WITH_PARMS( PF );
endif ;
endroutine ;
* ;
* Field Tab Opening ;
* ;
EVTROUTINE HANDLING(#FLDTAB.Opening);
define #fldload *char 1 default(N);
if '#fldload *ne Y';
define #lastcmp reffld(#std_obj);
define #lastfrm reffld(#S_019frm);
define #lastretc *char 2;
execute setBusy (ON);
Message 'Locating form details .... please wait' type(*status);
USE BUILTIN(GET_COMPONENT_LIST) WITH_ARGS(CMP *BLANKS) TO_GET(#FLDLIST #LASTCMP #LASTFRM #LASTRETC);
change #fldload Y;
execute setBusy (OFF);
endif ;
ENDROUTINE ;
* ;
* Load authority details for requested object ;
* ;
SUBROUTINE NAME(LOADAUTH) PARMS((#S_019TYP *RECEIVED));
execute setBusy (ON);
CLR_LIST NAMED(#AUTHLIST);
MESSAGE MSGTXT('Locating autghority details') TYPE(*STATUS);
USE BUILTIN(GET_AUTHORITIES) WITH_ARGS(#S_019OBJ #S_019EXT #S_019TYP) TO_GET(#RETCODE #AUTHLIST);
if *erreturn;
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK INFORMATION ERROR 'Security Information cannot be displayed');
ENDIF ;
SET #GPBX_AUTH VISIBLE(*OKRETURN);
SET #GPBX_USER VISIBLE(FALSE);
CHANGE #USER *BLANKS;
SET #BTN_NEW ENABLED(*VALIDUSER);
execute setBusy (OFF);
ENDROUTINE ;
* ;
* File selected from file list view;
* ;
EVTROUTINE HANDLING(#FILELIST.ItemGotSelection);
EXECUTE SUBROUTINE(LOADAUTH) WITH_PARMS( FD );
ENDROUTINE ;
* ;
* Field selected from field list view;
* ;
EVTROUTINE HANDLING(#FLDLIST.ItemGotSelection);
CHANGE FIELD(#S_019EXT) TO(*NULL);
EXECUTE SUBROUTINE(LOADAUTH) WITH_PARMS( DF );
ENDROUTINE ;
* ;
* Item in user authority list lost selection;
* ;
EVTROUTINE HANDLING(#AUTHLIST.ITEMLOSTSELECTION);
SET #GPBX_USER VISIBLE(FALSE);
ENDROUTINE ;
* ;
* Item in user authority list got selected;
* ;
EVTROUTINE HANDLING(#AUTHLIST.ItemGotSelection);
SET #GPBX_USER VISIBLE(TRUE);
CHANGE #USER *BLANKS;
SET #BTN_NEW ENABLED(*VALIDUSER);
SET #GPBX_USER CAPTION(#S_019USR);
set #GPBX_DEFN visible(true);
SET #GPBX_DATA VISIBLE(*ISFILE);
execute SetChkBox;
ENDROUTINE ;
* ;
* Set details of all authority check boxes for presentation;
* ;
subroutine SetChkBox ;
DEFINE FIELD(#TEST_TYP) REFFLD(#S_019TYP);
DEFINE FIELD(#WRKLAR) REFFLD(#S_019LAR);
DEFINE FIELD(#XX) REFFLD(#STD_NUM);
DEF_ARRAY NAME(#LAR) INDEXES(#XX) OVERLAYING(#WRKLAR) TYPE(*CHAR) TOT_ENTRY(10) ENTRY_LEN(2);
* ;
SET #CK_DEFNUD BUTTONSTATE(UnChecked);
SET #CK_DEFNMD BUTTONSTATE(UnChecked);
SET #CK_DEFNDD BUTTONSTATE(UnChecked);
SET #CK_DATADS BUTTONSTATE(UnChecked);
SET #CK_DATAAD BUTTONSTATE(UnChecked);
SET #CK_DATACH BUTTONSTATE(UnChecked);
SET #CK_DATADL BUTTONSTATE(UnChecked);
* ;
CHANGE FIELD(#WRKLAR) TO(#S_019LAR);
* ;
BEGIN_LOOP FROM(1) TO(10) USING(#XX);
case #LAR#XX;
when '= UD';
SET #CK_DEFNUD BUTTONSTATE(Checked);
when '= MD';
SET #CK_DEFNMD BUTTONSTATE(Checked);
when '= DD';
SET #CK_DEFNDD BUTTONSTATE(Checked);
when '= DS';
SET #CK_DATADS BUTTONSTATE(Checked);
when '= AD';
SET #CK_DATAAD BUTTONSTATE(Checked);
when '= CH';
SET #CK_DATACH BUTTONSTATE(Checked);
when '= DL';
SET #CK_DATADL BUTTONSTATE(Checked);
endcase ;
END_LOOP ;
* ;
endroutine ;
* ;
* New user name details changed;
* ;
EVTROUTINE HANDLING(#USER.Changed);
SET #BTN_NEW ENABLED(*VALIDUSER);
ENDROUTINE ;
* ;
* New user button clicked;
* ;
EVTROUTINE HANDLING(#BTN_NEW.CLICK);
SET #GPBX_USER VISIBLE(FALSE);
CHANGE FIELD(#FOUND) TO(N);
SELECTLIST #AUTHLIST ;
if '#S_019usr = #user';
CHANGE FIELD(#FOUND) TO(Y);
SET #AUTHLIST.CURRENTITEM Selected(TRUE) ;
LEAVE ;
endif ;
ENDSELECT ;
if '#found = N';
change #S_019usr #user;
if *isfile;
CHANGE #S_019LAR UDDSADCHDL;
else ;
CHANGE #S_019LAR UD;
endif ;
EXECUTE SUBROUTINE(UPDATEAUTH);
ADD_ENTRY #AUTHLIST;
SET #AUTHLIST.CURRENTITEM ENSUREVISIBLE(TRUE) ;
SET #AUTHLIST.CURRENTITEM Selected(TRUE) ;
ENDIF ;
CHANGE #USER *BLANKS;
SET #BTN_NEW ENABLED(*VALIDUSER);
invoke #user.setfocus;
ENDROUTINE ;
* ;
* Any security Check box clicked ;
* ;
EVTROUTINE HANDLING(#CK_DEFNUD.CLICK #CK_DEFNMD.CLICK #CK_DEFNDD.CLICK #CK_DATADS.CLICK #CK_DATAAD.CLICK #CK_DATACH.CLICK #CK_DATADL.CLICK);
change #wrklar *blanks;
change #xx 1;
if '#CK_DEFNUD.ButtonState = Checked';
change #lar#xx UD;
change #xx '#xx + 1';
endif ;
if '#CK_DEFNMD.ButtonState = Checked';
change #lar#xx MD;
change #xx '#xx + 1';
endif ;
if '#CK_DEFNDD.ButtonState = Checked';
change #lar#xx DD;
change #xx '#xx + 1';
endif ;
if '#CK_DATADS.ButtonState = Checked';
change #lar#xx DS;
change #xx '#xx + 1';
endif ;
if '#CK_DATAAD.ButtonState = Checked';
change #lar#xx AD;
change #xx '#xx + 1';
endif ;
if '#CK_DATACH.ButtonState = Checked';
change #lar#xx CH;
change #xx '#xx + 1';
endif ;
if '#CK_DATADL.ButtonState = Checked';
change #lar#xx DL;
change #xx '#xx + 1';
endif ;
CHANGE FIELD(#S_019LAR) TO(#WRKLAR);
UPD_ENTRY IN_LIST(#AUTHLIST);
EXECUTE SUBROUTINE(UPDATEAUTH);
endroutine ;
* ;
* Update authority for specified object / user;
* ;
subroutine updateauth;
IF COND(*ISPROCESS);
USE BUILTIN(SET_AUTHORITY) WITH_ARGS(#S_019OBJ *blanks #S_019TYP #S_019USR #S_019LAR) TO_GET(#RETCODE);
else ;
USE BUILTIN(SET_AUTHORITY) WITH_ARGS(#S_019OBJ #S_019EXT #S_019TYP #S_019USR #S_019LAR) TO_GET(#RETCODE);
endif ;
IF *ERRETURN;
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK INFORMATION ERROR 'Security Information was NOT updated');
ENDIF ;
ENDROUTINE ;
;
END_COM ;