1 &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI ADM1
6 &Scoped-define WINDOW-NAME CURRENT-WINDOW
7 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS V-table-Win
8 /*------------------------------------------------------------------------
11 ------------------------------------------------------------------------*/
13 /* *************************** Definitions
************************** */
15 DEF VAR user-name
AS CHAR INITIAL "Andrew" NO-UNDO.
17 &GLOB REPORT-ID "implnk"
19 /* _UIB-CODE-BLOCK-END
*/
23 &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
25 /* ******************** Preprocessor Definitions
******************** */
27 &Scoped-define PROCEDURE-TYPE SmartViewer
28 &Scoped-define DB-AWARE no
30 &Scoped-define ADM-SUPPORTED-LINKS Record-Source,Record-Target,TableIO-Target
32 /* Name of first Frame and
/or Browse and
/or first Query
*/
33 &Scoped-define FRAME-NAME F-Main
36 &Scoped-define EXTERNAL-TABLES RP
37 &Scoped-define FIRST-EXTERNAL-TABLE RP
40 /* Need to scope the external tables to this procedure
*/
41 DEFINE QUERY external_tables
FOR RP.
42 /* Standard List Definitions
*/
43 &Scoped-Define ENABLED-FIELDS RP.Char5 RP.Char6 RP.Char1 RP.Char2 RP.Log2
44 &Scoped-define ENABLED-TABLES RP
45 &Scoped-define FIRST-ENABLED-TABLE RP
46 &Scoped-define DISPLAYED-TABLES RP
47 &Scoped-define FIRST-DISPLAYED-TABLE RP
48 &Scoped-Define ENABLED-OBJECTS Btn_Browse Btn_OK RECT-1
49 &Scoped-Define DISPLAYED-FIELDS RP.Char5 RP.Char6 RP.Char1 RP.Char2 RP.Log2
51 /* Custom List Definitions
*/
52 /* ADM-CREATE-FIELDS
,ADM-ASSIGN-FIELDS
,List-3
,List-4
,List-5
,List-6
*/
54 /* _UIB-PREPROCESSOR-BLOCK-END
*/
59 /* *********************** Control Definitions
********************** */
62 /* Definitions of the field level widgets
*/
63 DEFINE BUTTON Btn_Browse
67 DEFINE BUTTON Btn_OK
AUTO-GO DEFAULT
72 DEFINE RECTANGLE RECT-1
73 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL
77 /* ************************ Frame Definitions
*********************** */
80 RP.Char5
AT ROW 1.2 COL 1.57 NO-LABEL
81 VIEW-AS RADIO-SET VERTICAL
83 "Apply changes from update file", "zip":U
,
84 "Restart incomplete update", "restart":U
,
85 "Select system components to update", ""
88 RP.Char6
AT ROW 1.2 COL 27 COLON-ALIGNED HELP
89 "" NO-LABEL FORMAT "X(256)"
92 Btn_Browse
AT ROW 1.2 COL 64.43
93 RP.Char1
AT ROW 4.4 COL 1.57 NO-LABEL
94 VIEW-AS RADIO-SET VERTICAL
96 "Don't Compile Anything", "",
97 "Compile All Programs", "compile-all":U
,
98 "Compile All Uncompiled Programs", "compile-rest":U
,
99 "Compile Important Programs", "compile-important":U
,
100 "Compile Specified Programs", "compile-list":U
103 RP.Char2
AT ROW 4.6 COL 28.43 NO-LABEL
104 VIEW-AS EDITOR NO-WORD-WRAP SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL
107 RP.Log2
AT ROW 11.6 COL 2.14
108 LABEL "Rebuild Menus"
112 Btn_OK
AT ROW 13.4 COL 58.72
113 RECT-1
AT ROW 1 COL 1
114 WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
115 SIDE-LABELS NO-UNDERLINE THREE-D
116 AT COL 1 ROW 1 SCROLLABLE
118 DEFAULT-BUTTON Btn_OK.
121 /* *********************** Procedure Settings
************************ */
123 &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
124 /* Settings for
THIS-PROCEDURE
126 External Tables
: ttpl.RP
127 Allow
: Basic
,DB-Fields
129 Add Fields to
: EXTERNAL-TABLES
130 Other Settings
: PERSISTENT-ONLY
COMPILE
133 /* This procedure should always be
RUN PERSISTENT. Report the error
, */
134 /* then cleanup and return.
*/
135 IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
136 MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U
137 VIEW-AS ALERT-BOX ERROR BUTTONS OK.
141 &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
143 /* ************************* Create Window
************************** */
145 &ANALYZE-SUSPEND _CREATE-WINDOW
146 /* DESIGN Window definition
(used by the UIB
)
147 CREATE WINDOW V-table-Win
ASSIGN
150 /* END WINDOW DEFINITION
*/
154 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB V-table-Win
155 /* ************************* Included-Libraries
*********************** */
157 {src
/adm
/method
/viewer.i
}
158 {inc
/method
/m-mntvwr.i
}
160 /* _UIB-CODE-BLOCK-END
*/
166 /* *********** Runtime Attributes and AppBuilder Settings
*********** */
168 &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
169 /* SETTINGS
FOR WINDOW V-table-Win
170 VISIBLE,,RUN-PERSISTENT
*/
171 /* SETTINGS
FOR FRAME F-Main
172 NOT-VISIBLE Size-to-Fit
*/
174 FRAME F-Main
:SCROLLABLE = FALSE
175 FRAME F-Main
:HIDDEN = TRUE.
177 /* SETTINGS
FOR EDITOR RP.Char2
IN FRAME F-Main
180 RP.Char2
:RETURN-INSERTED IN FRAME F-Main
= TRUE.
182 /* SETTINGS
FOR FILL-IN RP.Char6
IN FRAME F-Main
183 EXP-LABEL EXP-FORMAT EXP-HELP
*/
184 /* SETTINGS
FOR TOGGLE-BOX RP.Log2
IN FRAME F-Main
186 /* _RUN-TIME-ATTRIBUTES-END
*/
190 /* Setting information for Queries and Browse Widgets fields
*/
192 &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
193 /* Query rebuild information for
FRAME F-Main
196 */ /* FRAME F-Main
*/
203 /* ************************ Control Triggers
************************ */
205 &Scoped-define SELF-NAME Btn_Browse
206 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Browse V-table-Win
207 ON CHOOSE OF Btn_Browse
IN FRAME F-Main
/* Browse
*/
212 /* _UIB-CODE-BLOCK-END
*/
216 &Scoped-define SELF-NAME Btn_OK
217 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_OK V-table-Win
218 ON CHOOSE OF Btn_OK
IN FRAME F-Main
/* OK */
220 DISABLE {&SELF-NAME} WITH FRAME {&FRAME-NAME}.
222 ENABLE {&SELF-NAME} WITH FRAME {&FRAME-NAME}.
225 /* _UIB-CODE-BLOCK-END
*/
229 &Scoped-define SELF-NAME RP.Char1
230 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL RP.Char1 V-table-Win
231 ON VALUE-CHANGED
OF RP.Char1
IN FRAME F-Main
/* Char1
*/
233 RUN dispatch
( 'enable-fields'
:U
).
236 /* _UIB-CODE-BLOCK-END
*/
240 &Scoped-define SELF-NAME RP.Char5
241 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL RP.Char5 V-table-Win
242 ON VALUE-CHANGED
OF RP.Char5
IN FRAME F-Main
/* Char5
*/
244 RUN base-select-changed.
247 /* _UIB-CODE-BLOCK-END
*/
253 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK V-table-Win
256 /* *************************** Main Block
*************************** */
258 /* _UIB-CODE-BLOCK-END
*/
262 /* ********************** Internal Procedures
*********************** */
264 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available V-table-Win _ADM-ROW-AVAILABLE
265 PROCEDURE adm-row-available
:
266 /*------------------------------------------------------------------------------
267 Purpose
: Dispatched to this procedure when the Record-
268 Source has a new row available. This procedure
269 tries to get the new row
(or foriegn keys
) from
270 the Record-Source and process it.
272 ------------------------------------------------------------------------------*/
274 /* Define variables needed by this internal procedure.
*/
275 {src
/adm
/template
/row-head.i
}
277 /* Create a list of all the tables that we need to get.
*/
278 {src
/adm
/template
/row-list.i
"RP"}
280 /* Get the record
ROWID's from the RECORD-SOURCE.
*/
281 {src
/adm
/template
/row-get.i
}
283 /* FIND each record specified by the RECORD-SOURCE.
*/
284 {src
/adm
/template
/row-find.i
"RP"}
286 /* Process the newly available records
(i.e. display fields
,
287 open queries
, and
/or pass records on to any RECORD-TARGETS
).
*/
288 {src
/adm
/template
/row-end.i
}
292 /* _UIB-CODE-BLOCK-END
*/
295 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE base-select-changed V-table-Win
296 PROCEDURE base-select-changed
:
297 /*------------------------------------------------------------------------------
299 ------------------------------------------------------------------------------*/
300 DO WITH FRAME {&FRAME-NAME}:
301 IF INPUT RP.Char5
= 'zip'
THEN DO:
302 ENABLE RP.Char6 btn_Browse.
303 DISABLE ALL EXCEPT RP.Char5 RP.Char6 Btn_Browse Btn_OK.
305 ELSE IF INPUT RP.Char5
= "restart" THEN DO:
306 DISABLE ALL EXCEPT RP.Char5 Btn_OK.
310 IF INPUT RP.Char1
= "compile-list" THEN DO:
311 ENABLE RP.Char1 RP.Char2 .
312 RP.Char2
:READ-ONLY = No.
317 RP.Char2
:READ-ONLY = Yes.
323 /* _UIB-CODE-BLOCK-END
*/
326 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE choose-filename V-table-Win
327 PROCEDURE choose-filename
:
328 /*------------------------------------------------------------------------------
330 ------------------------------------------------------------------------------*/
331 DEF VAR file-chosen
AS LOGICAL INITIAL Yes
NO-UNDO.
332 DEF VAR temp-filename
AS CHAR NO-UNDO FORMAT "X(200)".
333 DEF VAR directory-string
AS CHAR NO-UNDO.
335 temp-filename
= INPUT FRAME {&FRAME-NAME} RP.Char1 .
336 directory-string
= SUBSTRING( temp-filename
, 1, R-INDEX( temp-filename
, "\") ).
337 SYSTEM-DIALOG GET-FILE temp-filename
338 FILTERS "Update Zip files" "UPDATE*.ZIP", "All files" "*.*"
340 DEFAULT-EXTENSION "*.TXT"
341 INITIAL-DIR directory-string
MUST-EXIST
343 TITLE "Select System Update File" USE-FILENAME
346 IF file-chosen
THEN DO:
347 RP.Char6
:SCREEN-VALUE = temp-filename.
352 /* _UIB-CODE-BLOCK-END
*/
355 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI V-table-Win _DEFAULT-DISABLE
356 PROCEDURE disable_UI
:
357 /*------------------------------------------------------------------------------
358 Purpose
: DISABLE the User Interface
360 Notes
: Here we clean-up the user-interface by deleting
361 dynamic widgets we have created and
/or hide
362 frames. This procedure is usually called when
363 we are ready to
"clean-up" after running.
364 ------------------------------------------------------------------------------*/
365 /* Hide all frames.
*/
367 IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
370 /* _UIB-CODE-BLOCK-END
*/
373 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-enable-fields V-table-Win
374 PROCEDURE inst-enable-fields
:
375 /*------------------------------------------------------------------------------
376 Purpose
: Any special mucking around enabling fields.
377 ------------------------------------------------------------------------------*/
378 RUN base-select-changed.
381 /* _UIB-CODE-BLOCK-END
*/
384 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE inst-initialize V-table-Win
385 PROCEDURE inst-initialize
:
386 /*------------------------------------------------------------------------------
387 Purpose
: Initialise the necessary bits and pieces
388 ------------------------------------------------------------------------------*/
390 RUN get-username
IN sec-mgr
( OUTPUT user-name
).
391 FIND RP
WHERE RP.ReportID
= {&REPORT-ID}
392 AND RP.UserName
= user-name
395 IF NOT AVAILABLE( RP
) THEN DO:
398 RP.ReportID
= {&REPORT-ID}
399 RP.UserName
= user-name
406 RUN dispatch
( 'display-fields'
:U
).
408 FIND UsrGroupMember
WHERE UsrGroupMember.UserName
= user-name
409 AND UsrGroupMember.GroupName
= "Programmer" NO-LOCK NO-ERROR.
410 IF NOT AVAILABLE(UsrGroupMember
) THEN
411 RP.Char5
:SCREEN-VALUE IN FRAME {&FRAME-NAME} = "zip".
413 RUN dispatch
( 'enable-fields'
:U
).
417 /* _UIB-CODE-BLOCK-END
*/
420 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE pre-destroy V-table-Win
421 PROCEDURE pre-destroy
:
422 /*------------------------------------------------------------------------------
424 ------------------------------------------------------------------------------*/
425 RUN check-modified
( 'clear'
:U
).
428 /* _UIB-CODE-BLOCK-END
*/
431 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE run-report V-table-Win
432 PROCEDURE run-report
:
433 /*------------------------------------------------------------------------------
434 Purpose
: Actually run the report program.
435 ------------------------------------------------------------------------------*/
436 DEF VAR process-options
AS CHAR NO-UNDO.
437 DEF VAR cmpl
AS CHAR NO-UNDO INITIAL "".
438 DEF VAR plst
AS CHAR NO-UNDO INITIAL "".
440 RUN dispatch
IN THIS-PROCEDURE ('update-record'
:U
).
441 IF RP.Char5
= "zip" THEN DO:
442 process-options
= "UpdateFile," + RP.Char6.
444 ELSE IF RP.Char5
= "restart" THEN DO:
445 process-options
= "Restart".
448 IF RP.Char1
BEGINS "compile" THEN cmpl
= ENTRY(2, RP.Char1
, "-").
449 IF cmpl
= "important" THEN ASSIGN
451 plst
= "vwr/sel/*.w~n" + "win/*.w~n"
452 + "trigger/*.p~n" + "rplctn/*~n"
453 + "lnk/*~n" + "sec/*~n"
455 + "vwr/mnt/v-ivoice.w~n" + "vwr/mnt/v-vouchr.w~n"
456 + "vwr/mnt/v-proper.w~n" + "vwr/mnt/v-crdtor.w~n"
457 + "vwr/mnt/v-tenant.w~n"
458 + "vwr/drl/b-act*.w~n" + "vwr/drl/b-choact.w~n"
459 + "vwr/drl/b-crdtor.w~n" + "vwr/drl/b-proper.w~n"
460 + "vwr/drl/b-vouchr.w~n" + "vwr/drl/b-projct.w~n"
461 + "vwr/drl/b-tenant.w".
462 ELSE IF cmpl
= "list" THEN
465 process-options
= (IF RP.Log2
THEN "UpdateMenus~n" ELSE "")
466 + (IF cmpl
<> "" THEN "Compile," + cmpl
+ "~n" ELSE "")
467 + (IF plst
<> "" THEN "ProgramList~n" + plst
ELSE "").
470 IF TRIM( ENTRY( 1, process-options
, "~n") ) = "" THEN DO:
471 MESSAGE "Select something to do or close the window!"
472 VIEW-AS ALERT-BOX INFORMATION TITLE "Nothing to do!".
477 /* The update process controls it's own busy
/non-busy status
478 * so there is no need for this here
, except to ensure it ain't
480 * RUN notify
( 'set-busy
,container-source'
:U
).
482 RUN process
/linkimpt.p
( process-options
).
483 RUN notify
( 'set-idle
,container-source'
:U
).
485 FIND UsrGroupMember
WHERE UsrGroupMember.UserName
= user-name
486 AND UsrGroupMember.GroupName
= "Programmer" NO-LOCK NO-ERROR.
487 IF NOT AVAILABLE(UsrGroupMember
) THEN
488 RUN dispatch
( 'exit'
:U
).
492 /* _UIB-CODE-BLOCK-END
*/
495 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records V-table-Win _ADM-SEND-RECORDS
496 PROCEDURE send-records
:
497 /*------------------------------------------------------------------------------
498 Purpose
: Send record
ROWID's for all tables used by
500 Parameters
: see template
/snd-head.i
501 ------------------------------------------------------------------------------*/
503 /* Define variables needed by this internal procedure.
*/
504 {src
/adm
/template
/snd-head.i
}
506 /* For each requested table
, put it's
ROWID in the output list.
*/
507 {src
/adm
/template
/snd-list.i
"RP"}
509 /* Deal with any unexpected table requests before closing.
*/
510 {src
/adm
/template
/snd-end.i
}
514 /* _UIB-CODE-BLOCK-END
*/
517 &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed V-table-Win
518 PROCEDURE state-changed
:
519 /* -----------------------------------------------------------
523 -------------------------------------------------------------*/
524 DEFINE INPUT PARAMETER p-issuer-hdl
AS HANDLE NO-UNDO.
525 DEFINE INPUT PARAMETER p-state
AS CHARACTER NO-UNDO.
528 /* Object instance CASEs can go here to replace standard behavior
530 {src
/adm
/template
/vstates.i
}
534 /* _UIB-CODE-BLOCK-END
*/