******************************************************************************
*
* 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
,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: ; * position cursor
temp=temp.form
CALL *CINPUT.B(SEC.PRMPT,temp,special,form,form)
******************************************************************************
* 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=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:PRMPT:
IF temp.form # NULL THEN
TPRINT temp.form:
TPRINT STR(SPACE,form-LEN(temp.form))
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:PRMPT:
IF temp.form # NULL THEN
TPRINT temp.form:
TPRINT STR(SPACE,form-LEN(temp.form))
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,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=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=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=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 = 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=NULL
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
END
temp.form=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=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=NULL
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
temp.form = 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="TCP/IP"
GOTO help.loop
END
IF NOT(temp MATCHES "TCP/IP") THEN
CALL *HELP.BOX.B(17,5,50,UVREADMSG(073817,""))
temp.form="TCP/IP"
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,1)
GOTO help.loop
END
temp.form = temp
CASE form.line=4 ; * Enter Service
IF temp="*" THEN GOTO help.loop
temp.form = temp
CASE form.line=5 ; * Enter Host
IF temp="*" THEN GOTO help.loop
temp.form = 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:PRMPT:temp.form:
TPRINT STR(SPACE,form-LEN(temp.form)):
form.line +=1
IF form.line=3 THEN
temp.form="TCP/IP"
TPRINT form:PRMPT:temp.form:
TPRINT STR(SPACE,form-LEN(temp.form)):
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, "=", 2))
temp.form<3> = trim(field(lSRVRS, "=", 2))
temp.form<4> = trim(field(lSRVRS, "=", 2))
temp.form<5> = trim(field(lSRVRS, "=", 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:">" to cfgfile else goto writeerr
writeseq lSRVRS to cfgfile else goto writeerr
writeseq lSRVRS to cfgfile else goto writeerr
writeseq lSRVRS to cfgfile else goto writeerr
writeseq lSRVRS to cfgfile else goto writeerr
svpars = dcount(lSRVRS,@SVM)
for k=1 to svpars
writeseq lSRVRS to cfgfile else goto writeerr
next k
mvpars = dcount(lSRVRS,@SVM)
for k=1 to mvpars
writeseq lSRVRS to cfgfile else goto writeerr
next k
next i
for i=1 to dcount(CDBMS,@FM)
writeseq "[":CDBMS:"]" to cfgfile else goto writeerr
svpars = dcount(CDBMS,@SVM)
for k=1 to svpars
writeseq CDBMS to cfgfile else goto writeerr
next k
mvpars = dcount(CDBMS,@SVM)
for k=1 to mvpars
writeseq CDBMS 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 = lSRVRS
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
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 in print.array<1> by "AL" setting dbmsloc else
print.array = insert(print.array,dbmsloc;IDBMS)
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 in print.array<1> by "AL" setting dbmsloc else
print.array = insert(print.array,dbmsloc;CDBMS)
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
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=temp.form<1>
lSRVRS="DBMSTYPE = ":temp.form<2>
lSRVRS="NETWORK = ":temp.form<3>
lSRVRS="SERVICE = ":temp.form<4>
lSRVRS="HOST = ":temp.form<5>
RETURN
STOP @(-1)
END