687 lines
27 KiB
Plaintext
687 lines
27 KiB
Plaintext
|
******************************************************************************
|
||
|
|
*
|
||
|
|
* Routine to handle UniVerse SQLCO Data Source Management
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 11/18/93 12592 CSM Change Server to Data Source
|
||
|
|
* 10/08/93 12380 CSM comments, cleanup
|
||
|
|
* 10/05/93 ---- CSM Initial programming
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
|
||
|
|
$OPTIONS INFORMATION
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE FILENAMES.H
|
||
|
|
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
|
||
|
|
|
||
|
|
common /sqlcocfg/ GNRC, IDBMS, SRVRS, CDBMS, PARMS, config2
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* Various other variables
|
||
|
|
******************************************************************************
|
||
|
|
equ Default to 1
|
||
|
|
equ Y.N.Start to 17 ; * Starting location of y/n box
|
||
|
|
******************************************************************************
|
||
|
|
* Strings representing shell scripts to be executed and files used
|
||
|
|
******************************************************************************
|
||
|
|
Blank.Message = @SYS.BELL:UVREADMSG(071004,"")
|
||
|
|
******************************************************************************
|
||
|
|
temp=NULL
|
||
|
|
CALL *ISUSER.B(0,temp)
|
||
|
|
IF temp=0 THEN
|
||
|
|
TPRINT UVREADMSG(071000,"")
|
||
|
|
SLEEP 3
|
||
|
|
STOP
|
||
|
|
END
|
||
|
|
server.name=NULL
|
||
|
|
help.message=CONVERT(@FM," ",UVREADMSG(073644,""))
|
||
|
|
*****************************************************************************
|
||
|
|
* go to all initialization routines
|
||
|
|
*****************************************************************************
|
||
|
|
GOSUB init.vars ; * initialize local variables
|
||
|
|
******************************************************************************
|
||
|
|
* In this section, we draw the first screen, print the menu bar and help
|
||
|
|
* areas, and put up the first title and form to fill out.
|
||
|
|
******************************************************************************
|
||
|
|
CALL *DRAW.SCRN.B(UVREADMSG(073801,""),1)
|
||
|
|
CALL *HELP.PRINT.B(CONVERT(@FM," ",UVREADMSG(073802,"")),2)
|
||
|
|
GOSUB init.menu ; * Initialize menu bar items
|
||
|
|
CALL *MNU.BAR.PR.B(Menu.Bar,1)
|
||
|
|
GOSUB init.form ; * Initialize forms to be used
|
||
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
|
||
|
|
CALL READ.CONFIG
|
||
|
|
lSRVRS = SRVRS
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* Starting point for routines actual activity. Paint help message and
|
||
|
|
* continue
|
||
|
|
******************************************************************************
|
||
|
|
help.loop:
|
||
|
|
|
||
|
|
CALL *HELP.PRINT.B(form<form.line,4>,1)
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* Starting point for actual data input. Here we position the cursor to the
|
||
|
|
* place of the secondary prompt and get the input character, which is returned
|
||
|
|
* in special, if a special character was encountered, or in temp, is data
|
||
|
|
* was entered.
|
||
|
|
******************************************************************************
|
||
|
|
input.loop:
|
||
|
|
|
||
|
|
TPRINT form<form.line,2>: ; * position cursor
|
||
|
|
temp=temp.form<form.line>
|
||
|
|
CALL *CINPUT.B(SEC.PRMPT,temp,special,form<form.line,6>,form<form.line,7>)
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* First section handles all the special characters.
|
||
|
|
******************************************************************************
|
||
|
|
IF special # 0 THEN ; * if special character encountered
|
||
|
|
BEGIN CASE
|
||
|
|
******************************************************************************
|
||
|
|
* Special character was Function Key F10. FALSE menu bar, get more data
|
||
|
|
* Unless operation = Maintain, then do menu bar actions...
|
||
|
|
******************************************************************************
|
||
|
|
|
||
|
|
CASE special = F.10 ; * Function key F10 was pressed
|
||
|
|
action.value = 1
|
||
|
|
CALL *DO.MNU.BAR.B(Menu.Bar,action.value,form.size,form,temp.form)
|
||
|
|
BEGIN CASE
|
||
|
|
CASE action.value = 1 ; * Delete current entry
|
||
|
|
flag=FALSE
|
||
|
|
CALL *HELP.PRINT.B(NULL,3)
|
||
|
|
IF server.name = NULL THEN
|
||
|
|
CALL *HELP.BOX.B(5,5,50,UVREADMSG(073821,""))
|
||
|
|
GOTO end.f10
|
||
|
|
END
|
||
|
|
CALL *YES.NO.BOX.B(17,UVREADMSG(073062,server.name),flag)
|
||
|
|
IF flag=TRUE THEN
|
||
|
|
locname=server.name
|
||
|
|
gosub locatesrvr
|
||
|
|
IF NOT(srvrloc=0) then
|
||
|
|
lSRVRS = delete(lSRVRS,srvrloc)
|
||
|
|
GOSUB init.vars
|
||
|
|
CALL *HELP.PRINT.B(UVREADMSG(073804,server.name),2)
|
||
|
|
server.name=NULL
|
||
|
|
temp.form<1>=NULL
|
||
|
|
END
|
||
|
|
ELSE CALL *HELP.PRINT.B(UVREADMSG(073835,server.name),2)
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
CALL *HELP.PRINT.B(UVREADMSG(073805,server.name),2)
|
||
|
|
END
|
||
|
|
CASE action.value = 2 ; * Rename currently selected server
|
||
|
|
IF temp.form<1>=NULL THEN
|
||
|
|
CALL *HELP.BOX.B(5,5,50,UVREADMSG(073806,""))
|
||
|
|
GOTO end.f10
|
||
|
|
END
|
||
|
|
msg.new=UVREADMSG(073807,"")
|
||
|
|
CALL *HELP.PRINT.B(NULL,3)
|
||
|
|
loop.here:
|
||
|
|
CALL *ENTER.BOX.B(17,5,20,msg.new,temp,1)
|
||
|
|
IF temp="*" THEN GOTO loop.here
|
||
|
|
form.line=1
|
||
|
|
special.action=1
|
||
|
|
CALL *PUT.FORM.B(form.size, form, temp.form, PRMPT,1)
|
||
|
|
GOTO new.enter
|
||
|
|
CASE action.value = 3 ; * copy contents into another server
|
||
|
|
IF temp.form<1>=NULL THEN
|
||
|
|
CALL *HELP.BOX.B(5,5,50,UVREADMSG(073806,""))
|
||
|
|
GOTO end.f10
|
||
|
|
END
|
||
|
|
msg.new=UVREADMSG(073807,"")
|
||
|
|
CALL *HELP.PRINT.B(NULL,3)
|
||
|
|
loop.here1:
|
||
|
|
CALL *ENTER.BOX.B(17,5,20,msg.new,temp,1)
|
||
|
|
IF temp="*" THEN GOTO loop.here1
|
||
|
|
form.line=1
|
||
|
|
special.action=2
|
||
|
|
CALL *PUT.FORM.B(form.size, form, temp.form, PRMPT,1)
|
||
|
|
GOTO new.enter
|
||
|
|
CASE action.value = 5 ; * Refresh screen
|
||
|
|
flag = TRUE
|
||
|
|
IF temp.form<1> # NULL THEN
|
||
|
|
CALL *HELP.PRINT.B(NULL,3)
|
||
|
|
CALL *YES.NO.BOX.B(Y.N.Start,UVREADMSG(073061,""),flag)
|
||
|
|
IF flag=TRUE THEN
|
||
|
|
GOSUB init.vars
|
||
|
|
form.line=1
|
||
|
|
temp.form<form.line>=NULL
|
||
|
|
server.name=NULL
|
||
|
|
END
|
||
|
|
END
|
||
|
|
lSRVRS=SRVRS
|
||
|
|
CASE action.value = 6 ; * Save changes
|
||
|
|
flag=TRUE
|
||
|
|
CALL *HELP.PRINT.B(NULL,3)
|
||
|
|
CALL *YES.NO.BOX.B(Y.N.Start,UVREADMSG(073066,""),flag)
|
||
|
|
IF flag=TRUE THEN
|
||
|
|
GOSUB Write.Server
|
||
|
|
END
|
||
|
|
GOSUB init.vars
|
||
|
|
temp.form=NULL
|
||
|
|
form.line=1
|
||
|
|
server.name=NULL
|
||
|
|
CASE action.value = 7 ; * Exit
|
||
|
|
IF temp.form<1> # NULL THEN
|
||
|
|
flag = FALSE
|
||
|
|
CALL *HELP.PRINT.B(NULL,3)
|
||
|
|
CALL *YES.NO.BOX.B(Y.N.Start,UVREADMSG(073066,""),flag)
|
||
|
|
IF flag=TRUE THEN
|
||
|
|
GOSUB Write.Server
|
||
|
|
END
|
||
|
|
END
|
||
|
|
STOP @(-1)
|
||
|
|
CASE action.value = 4 ; * help on Application
|
||
|
|
message=UVREADMSG(073808,"")
|
||
|
|
CONVERT @FM TO " " IN message
|
||
|
|
CALL *HELP.BOX.B(4,10,60,message)
|
||
|
|
CASE action.value = 8 ; * help on Keys
|
||
|
|
message=UVREADMSG(076001,"")
|
||
|
|
CONVERT @FM TO " " IN message
|
||
|
|
CALL *HELP.BOX.B(3,10,60,message)
|
||
|
|
CASE action.value = 9 ; * help on version
|
||
|
|
CALL *HELP.BOX.B(6,4,45,UVREADMSG(076000,""))
|
||
|
|
END CASE
|
||
|
|
end.f10:
|
||
|
|
CALL *PUT.FORM.B(form.size, form, temp.form, PRMPT,1)
|
||
|
|
GOTO help.loop ; * repaint and get new value
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* Up arrow was pressed.
|
||
|
|
******************************************************************************
|
||
|
|
CASE special = UP.ARROW ; * Up arrow was pressed
|
||
|
|
TPRINT form<form.line,2>:PRMPT:
|
||
|
|
IF temp.form<form.line> # NULL THEN
|
||
|
|
TPRINT temp.form<form.line>:
|
||
|
|
TPRINT STR(SPACE,form<form.line,6>-LEN(temp.form<form.line>))
|
||
|
|
END
|
||
|
|
form.line-=1
|
||
|
|
IF form.line < 1 THEN
|
||
|
|
form.line=form.size
|
||
|
|
END
|
||
|
|
GOTO help.loop ; * get more input
|
||
|
|
******************************************************************************
|
||
|
|
* Down arrow was pressed.
|
||
|
|
******************************************************************************
|
||
|
|
CASE special = DOWN.ARROW ; * Down arrow was pressed
|
||
|
|
TPRINT form<form.line,2>:PRMPT:
|
||
|
|
IF temp.form<form.line> # NULL THEN
|
||
|
|
TPRINT temp.form<form.line>:
|
||
|
|
TPRINT STR(SPACE,form<form.line,6>-LEN(temp.form<form.line>))
|
||
|
|
END
|
||
|
|
form.line+=1
|
||
|
|
IF form.line > form.size THEN
|
||
|
|
form.line=1
|
||
|
|
END
|
||
|
|
GOTO help.loop ; * get more input
|
||
|
|
******************************************************************************
|
||
|
|
* Function key F1 was pushed. This key is used to display more involved
|
||
|
|
* Help messages
|
||
|
|
******************************************************************************
|
||
|
|
CASE special = F.1
|
||
|
|
CALL *HELP.PRINT.B(form<form.line,5>,3)
|
||
|
|
GOTO input.loop ; * get more input
|
||
|
|
******************************************************************************
|
||
|
|
* Escape key pressed. This is the systems signal to return to the calling
|
||
|
|
* procedure. First clear the screen however
|
||
|
|
******************************************************************************
|
||
|
|
CASE special = ESCAPE ; * escape was pressed
|
||
|
|
STOP @(-1)
|
||
|
|
CASE special = F.4
|
||
|
|
temp="*"
|
||
|
|
GOTO new.enter
|
||
|
|
CASE Default
|
||
|
|
GOTO help.loop
|
||
|
|
END CASE ; * end of case
|
||
|
|
END ; * end of if statement
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* If we reach here, we must have had data input, which is returned from
|
||
|
|
* *NINPUT in the variable temp. Therefore, process it and execute the
|
||
|
|
* desired operation.
|
||
|
|
******************************************************************************
|
||
|
|
ELSE
|
||
|
|
new.enter:
|
||
|
|
sel.val=1
|
||
|
|
CALL *HELP.PRINT.B(NULL,3) ; * Clears help area
|
||
|
|
BEGIN CASE
|
||
|
|
CASE form.line=1
|
||
|
|
IF temp="*" THEN
|
||
|
|
CALL *HELP.PRINT.B(UVREADMSG(073058,""),2)
|
||
|
|
CALL *HELP.PRINT.B(help.message,2)
|
||
|
|
GOSUB prlstsrv
|
||
|
|
CALL *HELP.PRINT.B(NULL,3)
|
||
|
|
IF sel.val=-1 THEN
|
||
|
|
temp=NULL
|
||
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
|
||
|
|
GOTO help.loop
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
temp=sel.val
|
||
|
|
temp.form<form.line>=temp
|
||
|
|
END
|
||
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
|
||
|
|
END
|
||
|
|
IF temp=NULL THEN
|
||
|
|
CALL *HELP.BOX.B(17,5,50,Blank.Message)
|
||
|
|
GOTO help.loop
|
||
|
|
END
|
||
|
|
IF NOT(temp MATCHES "1A0X") THEN
|
||
|
|
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073814,""))
|
||
|
|
temp.form<form.line>=NULL
|
||
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
|
||
|
|
GOTO help.loop
|
||
|
|
END
|
||
|
|
IF special.action=1 THEN
|
||
|
|
locname=temp
|
||
|
|
gosub locatesrvr
|
||
|
|
if NOT(srvrloc=0) then
|
||
|
|
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073809,temp))
|
||
|
|
temp.form<form.line>=NULL
|
||
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
|
||
|
|
GOTO help.loop
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
locname=server.name
|
||
|
|
gosub locatesrvr
|
||
|
|
if NOT(srvrloc=0) then lSRVRS<srvrloc,1> = temp
|
||
|
|
END
|
||
|
|
END
|
||
|
|
IF special.action=2 THEN
|
||
|
|
locname=temp
|
||
|
|
gosub locatesrvr
|
||
|
|
if NOT(srvrloc=0) then
|
||
|
|
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073809,temp))
|
||
|
|
temp.form<form.line>=NULL
|
||
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
|
||
|
|
GOTO help.loop
|
||
|
|
END
|
||
|
|
END
|
||
|
|
temp.form<form.line>=temp
|
||
|
|
server.name=temp
|
||
|
|
IF special.action = 0 THEN
|
||
|
|
GOSUB Read.Server
|
||
|
|
END
|
||
|
|
special.action=0
|
||
|
|
CASE form.line=2 ; * Enter DBMS type
|
||
|
|
IF temp="*" THEN
|
||
|
|
CALL *HELP.PRINT.B(UVREADMSG(073058,""),2)
|
||
|
|
CALL *HELP.PRINT.B(help.message,2)
|
||
|
|
GOSUB prlstdbms
|
||
|
|
CALL *HELP.PRINT.B(NULL,3)
|
||
|
|
IF sel.val=-1 THEN
|
||
|
|
temp=NULL
|
||
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
|
||
|
|
GOTO help.loop
|
||
|
|
END
|
||
|
|
ELSE
|
||
|
|
temp=sel.val
|
||
|
|
temp.form<form.line>=temp
|
||
|
|
END
|
||
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
|
||
|
|
END
|
||
|
|
IF temp=NULL THEN
|
||
|
|
CALL *HELP.BOX.B(17,5,50,Blank.Message)
|
||
|
|
GOTO help.loop
|
||
|
|
END
|
||
|
|
IF NOT(temp MATCHES "1A0X") THEN
|
||
|
|
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073815,""))
|
||
|
|
temp.form<form.line>=NULL
|
||
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
|
||
|
|
GOTO help.loop
|
||
|
|
END
|
||
|
|
temp.form<form.line> = temp
|
||
|
|
CASE form.line=3 ; * Enter Network
|
||
|
|
IF temp="*" THEN GOTO help.loop
|
||
|
|
IF temp=NULL THEN
|
||
|
|
CALL *HELP.BOX.B(17,5,50,Blank.Message)
|
||
|
|
temp.form<form.line>="TCP/IP"
|
||
|
|
GOTO help.loop
|
||
|
|
END
|
||
|
|
IF NOT(temp MATCHES "TCP/IP") THEN
|
||
|
|
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073817,""))
|
||
|
|
temp.form<form.line>="TCP/IP"
|
||
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
|
||
|
|
GOTO help.loop
|
||
|
|
END
|
||
|
|
temp.form<form.line> = temp
|
||
|
|
CASE form.line=4 ; * Enter Service
|
||
|
|
IF temp="*" THEN GOTO help.loop
|
||
|
|
temp.form<form.line> = temp
|
||
|
|
CASE form.line=5 ; * Enter Host
|
||
|
|
IF temp="*" THEN GOTO help.loop
|
||
|
|
temp.form<form.line> = temp
|
||
|
|
END CASE
|
||
|
|
END
|
||
|
|
IF form.line > 1 AND server.name=NULL THEN
|
||
|
|
CALL *HELP.BOX.B(17,5,50,Blank.Message)
|
||
|
|
form.line=1
|
||
|
|
GOTO help.loop
|
||
|
|
END
|
||
|
|
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
|
||
|
|
TPRINT STR(SPACE,form<form.line,6>-LEN(temp.form<form.line>)):
|
||
|
|
form.line +=1
|
||
|
|
IF form.line=3 THEN
|
||
|
|
temp.form<form.line>="TCP/IP"
|
||
|
|
TPRINT form<form.line,2>:PRMPT:temp.form<form.line>:
|
||
|
|
TPRINT STR(SPACE,form<form.line,6>-LEN(temp.form<form.line>)):
|
||
|
|
form.line +=1
|
||
|
|
END
|
||
|
|
IF form.line <= form.size THEN GOTO help.loop
|
||
|
|
flag=FALSE
|
||
|
|
CALL *YES.NO.BOX.B(Y.N.Start,UVREADMSG(073065,""),flag)
|
||
|
|
IF flag = FALSE THEN
|
||
|
|
flag=TRUE
|
||
|
|
CALL *YES.NO.BOX.B(Y.N.Start,UVREADMSG(073066,""),flag)
|
||
|
|
IF flag=TRUE THEN GOSUB Write.Server
|
||
|
|
ELSE CALL *HELP.BOX.B(17,5,50,UVREADMSG(073810,""))
|
||
|
|
END
|
||
|
|
form.line = 1
|
||
|
|
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
|
||
|
|
GOTO help.loop
|
||
|
|
|
||
|
|
STOP @(-1)
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* init.menu -
|
||
|
|
* Routine that initializes Menu Bar values for Maintain Servers section
|
||
|
|
* of code.
|
||
|
|
******************************************************************************
|
||
|
|
init.menu:
|
||
|
|
scratch=UVREADMSG(073811,"")
|
||
|
|
Menu.Bar = NULL
|
||
|
|
Menu.Bar<1,1> = 3 ; * Number of Items in Menu.Bar
|
||
|
|
Menu.Bar<1,2> = 1 ; * Line # on which to print the Menu Bar
|
||
|
|
* First Item
|
||
|
|
Menu.Bar<2,1,1>=scratch<1> ; * SubMenu Title
|
||
|
|
Menu.Bar<2,1,2>=3 ; * # of items in SubMenu
|
||
|
|
* SubMenu #1
|
||
|
|
Menu.Bar<2,2,1>=scratch<2> ; * SubMenu Item
|
||
|
|
Menu.Bar<2,2,2>=5 ; * Action Code (Returned to calling process)
|
||
|
|
Menu.Bar<2,2,3>=scratch<3>
|
||
|
|
Menu.Bar<2,3,1>=scratch<4>
|
||
|
|
Menu.Bar<2,3,2>=6
|
||
|
|
Menu.Bar<2,3,3>=scratch<5>
|
||
|
|
Menu.Bar<2,4,1>=scratch<6>
|
||
|
|
Menu.Bar<2,4,2>=7
|
||
|
|
Menu.Bar<2,4,3>=scratch<7>
|
||
|
|
* Second Item
|
||
|
|
Menu.Bar<3,1,1>=scratch<8> ; * SubMenu Title
|
||
|
|
Menu.Bar<3,1,2>=3 ; * # of items in SubMenu
|
||
|
|
* SubMenu #1
|
||
|
|
Menu.Bar<3,2,1>=scratch<9> ; * SubMenu Item
|
||
|
|
Menu.Bar<3,2,2>=1 ; * Action Code
|
||
|
|
Menu.Bar<3,2,3>=scratch<10>
|
||
|
|
Menu.Bar<3,3,1>=scratch<11> ; * SubMenu Item
|
||
|
|
Menu.Bar<3,3,2>=2 ; * Action Code
|
||
|
|
Menu.Bar<3,3,3>=scratch<12>
|
||
|
|
Menu.Bar<3,4,1>=scratch<13> ; * SubMenu Item
|
||
|
|
Menu.Bar<3,4,2>=3 ; * Action Code
|
||
|
|
Menu.Bar<3,4,3>=scratch<14>
|
||
|
|
scratch=UVREADMSG(073089,"")
|
||
|
|
Menu.Bar<4,1,1>=scratch<1>
|
||
|
|
Menu.Bar<4,1,2>=3
|
||
|
|
Menu.Bar<4,2,1>=scratch<2>
|
||
|
|
Menu.Bar<4,2,2>=4
|
||
|
|
Menu.Bar<4,2,3>=scratch<3>
|
||
|
|
Menu.Bar<4,3,1>=scratch<4>
|
||
|
|
Menu.Bar<4,3,2>=8
|
||
|
|
Menu.Bar<4,3,3>=scratch<5>
|
||
|
|
Menu.Bar<4,4,1>=scratch<6>
|
||
|
|
Menu.Bar<4,4,2>=9
|
||
|
|
Menu.Bar<4,4,3>=scratch<7>
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* Init.form
|
||
|
|
* This routine initializes all the positional parameters, help strings,
|
||
|
|
* text strings, and default values for the form used in this subroutine
|
||
|
|
******************************************************************************
|
||
|
|
init.form:
|
||
|
|
form.size=5
|
||
|
|
form=NULL
|
||
|
|
scratch=UVREADMSG(073803,"")
|
||
|
|
form<1,1>=@(5,5) ; * Start of Field Text
|
||
|
|
form<1,2>=@(22,5) ; * Start of Field Data
|
||
|
|
form<1,3>=scratch<1> ; * Message File Field Text
|
||
|
|
form<1,4>=scratch<2> ; * Message File Field Help
|
||
|
|
form<1,5>=form<1,4> ; * Message File Field long help, if any
|
||
|
|
form<1,6>=31 ; * Field data length
|
||
|
|
form<1,7>=1 ; * Field data upper-case
|
||
|
|
form<2,1>=@(5,6)
|
||
|
|
form<2,2>=@(22,6)
|
||
|
|
form<2,3>=scratch<3>
|
||
|
|
form<2,4>=scratch<4>
|
||
|
|
form<2,5>=scratch<5>
|
||
|
|
form<2,6>=31
|
||
|
|
form<2,7>=1
|
||
|
|
form<3,1>=@(5,7)
|
||
|
|
form<3,2>=@(22,7)
|
||
|
|
form<3,3>=scratch<6>
|
||
|
|
form<3,4>=scratch<7>
|
||
|
|
form<3,5>=scratch<8>
|
||
|
|
form<3,6>=31
|
||
|
|
form<3,7>=1
|
||
|
|
form<4,1>=@(5,8)
|
||
|
|
form<4,2>=@(22,8)
|
||
|
|
form<4,3>=scratch<9>
|
||
|
|
form<4,4>=scratch<10>
|
||
|
|
form<4,5>=scratch<11>
|
||
|
|
form<4,6>=31
|
||
|
|
form<4,7>=1
|
||
|
|
form<5,1>=@(5,9)
|
||
|
|
form<5,2>=@(22,9)
|
||
|
|
form<5,3>=scratch<12>
|
||
|
|
form<5,4>=scratch<13>
|
||
|
|
form<5,5>=scratch<14>
|
||
|
|
form<5,6>=31
|
||
|
|
form<5,7>=1
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* Read.Server -
|
||
|
|
* This routine will search through the list of servers for the specified
|
||
|
|
* server.
|
||
|
|
******************************************************************************
|
||
|
|
Read.Server:
|
||
|
|
tmpname=server.name
|
||
|
|
GOSUB init.vars
|
||
|
|
server.name=tmpname
|
||
|
|
temp.form<1>=server.name
|
||
|
|
locname=server.name
|
||
|
|
gosub locatesrvr
|
||
|
|
if NOT(srvrloc=0) then
|
||
|
|
temp.form<2> = trim(field(lSRVRS<srvrloc,2>, "=", 2))
|
||
|
|
temp.form<3> = trim(field(lSRVRS<srvrloc,3>, "=", 2))
|
||
|
|
temp.form<4> = trim(field(lSRVRS<srvrloc,4>, "=", 2))
|
||
|
|
temp.form<5> = trim(field(lSRVRS<srvrloc,5>, "=", 2))
|
||
|
|
end
|
||
|
|
|
||
|
|
CALL *PUT.FORM.B(form.size, form, temp.form, PRMPT,1)
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* Write.Server -
|
||
|
|
* This routine will write out the various lists to the configuration file.
|
||
|
|
******************************************************************************
|
||
|
|
Write.Server:
|
||
|
|
rewrite:
|
||
|
|
openseq config2 to cfgfile else
|
||
|
|
retry=0
|
||
|
|
m1=UVREADMSG(073800,"")
|
||
|
|
call *ERROR.BOX.B(10,3,0,UVREADMSG(073005,config2),retry,m1)
|
||
|
|
if retry#0 then stop @(-1)
|
||
|
|
else goto rewrite
|
||
|
|
end
|
||
|
|
line=1
|
||
|
|
OK=1
|
||
|
|
locname=temp.form<1>
|
||
|
|
if NOT(locname="") then gosub addserver
|
||
|
|
|
||
|
|
m1=UVREADMSG(073818,"")
|
||
|
|
writeseq "[ODBC DATA SOURCES]" to cfgfile else goto writeerr
|
||
|
|
|
||
|
|
for i=1 to dcount(lSRVRS,@FM)
|
||
|
|
writeseq "<":lSRVRS<i,1>:">" to cfgfile else goto writeerr
|
||
|
|
writeseq lSRVRS<i,2> to cfgfile else goto writeerr
|
||
|
|
writeseq lSRVRS<i,3> to cfgfile else goto writeerr
|
||
|
|
writeseq lSRVRS<i,4> to cfgfile else goto writeerr
|
||
|
|
writeseq lSRVRS<i,5> to cfgfile else goto writeerr
|
||
|
|
svpars = dcount(lSRVRS<i,6>,@SVM)
|
||
|
|
for k=1 to svpars
|
||
|
|
writeseq lSRVRS<i,6,k> to cfgfile else goto writeerr
|
||
|
|
next k
|
||
|
|
mvpars = dcount(lSRVRS<i,7>,@SVM)
|
||
|
|
for k=1 to mvpars
|
||
|
|
writeseq lSRVRS<i,7,k> to cfgfile else goto writeerr
|
||
|
|
next k
|
||
|
|
next i
|
||
|
|
|
||
|
|
for i=1 to dcount(CDBMS,@FM)
|
||
|
|
writeseq "[":CDBMS<i,1>:"]" to cfgfile else goto writeerr
|
||
|
|
svpars = dcount(CDBMS<i,2>,@SVM)
|
||
|
|
for k=1 to svpars
|
||
|
|
writeseq CDBMS<i,2,k> to cfgfile else goto writeerr
|
||
|
|
next k
|
||
|
|
mvpars = dcount(CDBMS<i,3>,@SVM)
|
||
|
|
for k=1 to mvpars
|
||
|
|
writeseq CDBMS<i,3,k> to cfgfile else goto writeerr
|
||
|
|
next k
|
||
|
|
next i
|
||
|
|
|
||
|
|
weofseq cfgfile
|
||
|
|
closeseq cfgfile
|
||
|
|
|
||
|
|
special.action = 0
|
||
|
|
SRVRS = lSRVRS
|
||
|
|
CALL *HELP.BOX.B(5,5,50,UVREADMSG(073816,""))
|
||
|
|
goto end.wr.server
|
||
|
|
|
||
|
|
writeerr:
|
||
|
|
m1=UVREADMSG(073818,"")
|
||
|
|
retry=0
|
||
|
|
CALL *ERROR.BOX.B(5,9,0,UVREADMSG(073070,config2),retry,m1)
|
||
|
|
IF retry#0 THEN STOP @(-1)
|
||
|
|
GOTO rewrite
|
||
|
|
end.wr.server:
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* Init.vars -
|
||
|
|
* Routine which initializes various global variables
|
||
|
|
******************************************************************************
|
||
|
|
init.vars:
|
||
|
|
special.action = 0
|
||
|
|
form.line = 1
|
||
|
|
temp.form = NULL
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* Prlstsrv -
|
||
|
|
* Routine which prints the list of servers
|
||
|
|
******************************************************************************
|
||
|
|
prlstsrv:
|
||
|
|
heading=""
|
||
|
|
heading=UVREADMSG(073813,"")
|
||
|
|
|
||
|
|
IF lSRVRS=""
|
||
|
|
THEN srvn=0
|
||
|
|
ELSE srvn = dcount(lSRVRS, @FM)
|
||
|
|
print.array=""
|
||
|
|
print.count=srvn
|
||
|
|
FOR i = 1 TO srvn
|
||
|
|
print.array<i> = lSRVRS<i,1>
|
||
|
|
NEXT i
|
||
|
|
IF srvn = 0 THEN
|
||
|
|
print.array<1>=UVREADMSG(073812,"")
|
||
|
|
print.count=1
|
||
|
|
END
|
||
|
|
sel.val=1
|
||
|
|
CALL *LIST.BOX.B(heading,4,10,print.array,print.count,1,sel.val,0)
|
||
|
|
IF sel.val=-1 THEN RETURN
|
||
|
|
IF srvn=0 THEN sel.val=-1
|
||
|
|
else sel.val=print.array<sel.val>
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* Prlstdbms -
|
||
|
|
* Routine which prints the list of dbms types
|
||
|
|
******************************************************************************
|
||
|
|
prlstdbms:
|
||
|
|
heading=""
|
||
|
|
heading=UVREADMSG(073819,"")
|
||
|
|
print.array=""
|
||
|
|
print.count=0
|
||
|
|
|
||
|
|
IF IDBMS=""
|
||
|
|
THEN dbmsn=0
|
||
|
|
ELSE dbmsn = dcount(IDBMS, @FM)
|
||
|
|
FOR i = 1 TO dbmsn
|
||
|
|
locate IDBMS<i,1> in print.array<1> by "AL" setting dbmsloc else
|
||
|
|
print.array = insert(print.array,dbmsloc;IDBMS<i,1>)
|
||
|
|
print.count=print.count+1
|
||
|
|
end
|
||
|
|
NEXT i
|
||
|
|
|
||
|
|
IF CDBMS=""
|
||
|
|
THEN dbmsn=0
|
||
|
|
ELSE dbmsn = dcount(CDBMS, @FM)
|
||
|
|
FOR i = 1 TO dbmsn
|
||
|
|
locate CDBMS<i,1> in print.array<1> by "AL" setting dbmsloc else
|
||
|
|
print.array = insert(print.array,dbmsloc;CDBMS<i,1>)
|
||
|
|
print.count=print.count+1
|
||
|
|
end
|
||
|
|
NEXT i
|
||
|
|
|
||
|
|
dbmsn = print.count
|
||
|
|
IF print.count = 0 THEN
|
||
|
|
print.array<1>=UVREADMSG(73820,"")
|
||
|
|
print.count=1
|
||
|
|
END
|
||
|
|
sel.val=1
|
||
|
|
CALL *LIST.BOX.B(heading,4,10,print.array,print.count,1,sel.val,0)
|
||
|
|
IF dbmsn=0 THEN sel.val=-1
|
||
|
|
IF NOT(sel.val=-1) THEN sel.val=print.array<sel.val>
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* locatesrvr -
|
||
|
|
* Routine which finds the location of locname in the list of servers lSRVRS
|
||
|
|
******************************************************************************
|
||
|
|
locatesrvr:
|
||
|
|
srvrloc = 0
|
||
|
|
if lSRVRS[1, len(locname)+1] = locname:@VM then srvrloc = 1
|
||
|
|
else
|
||
|
|
loc = index(lSRVRS, @FM:locname:@VM, 1)
|
||
|
|
if loc then srvrloc = dcount(lSRVRS[1,loc], @FM)
|
||
|
|
end
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
******************************************************************************
|
||
|
|
* addserver -
|
||
|
|
* Routine which adds a server to the list of servers lSRVRS or updates it
|
||
|
|
******************************************************************************
|
||
|
|
addserver:
|
||
|
|
gosub locatesrvr
|
||
|
|
if srvrloc=0 then srvrloc=dcount(lSRVRS, @FM)+1
|
||
|
|
lSRVRS<srvrloc,1>=temp.form<1>
|
||
|
|
lSRVRS<srvrloc,2>="DBMSTYPE = ":temp.form<2>
|
||
|
|
lSRVRS<srvrloc,3>="NETWORK = ":temp.form<3>
|
||
|
|
lSRVRS<srvrloc,4>="SERVICE = ":temp.form<4>
|
||
|
|
lSRVRS<srvrloc,5>="HOST = ":temp.form<5>
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
STOP @(-1)
|
||
|
|
END
|