****************************************************************************** * * 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