Liren Large Software Subsidy 5/05.iso/a/a070/1.ddi/FOXPRO/ADDUSER.PRG

Text File | 1990-02-09 | 21.8 KB | 714 lines

*********************************************************************
* ADDUSER - This program should be run for each work station that    *
* is attached to your FoxPro multi-user system.  It enables each    *
* individual work station to be optimally configured for providing     *
* the best performance.                                                *
*********************************************************************

* Do setup and initialization

ON ERROR DO abort
CREATE VIEW adduser
DO cleanup
PUBLIC keyword[6], loc[6], totopts, bootdisk, savedir, cr, success, maxpath
PUBLIC defdir
DO setup

* Here's the interactive part

IF proceed()
    IF config()
        FOR option = 1 TO totopts
            loc[option] = ALLTRIM(loc[option])
        ENDFOR
        IF bootdisk = 'A' .OR. bootdisk = 'B'
            DO floppy
        ENDIF
        success = autoexec()
        IF success
            success = config_fp()
            IF success
                DO resource
            ENDIF
        ENDIF
        DO final
    ENDIF
ENDIF

* Now clean up and restore the environment

RELEASE MODULE isdiskin
ON ERROR
DO cleanup
SET VIEW TO adduser
IF SET("TALK") = "ON"
    SET TALK OFF
    DELETE FILE adduser.vue
    SET TALK ON
ELSE
    DELETE FILE adduser.vue
ENDIF
RETURN

*************************************************************
* SETUP - Initialize CONFIG.FP parameters and other globals *
*************************************************************
PROCEDURE setup

* Setup the environment *

SET TALK OFF
SET ESCAPE OFF
SET MESSAGE TO 24 CENTER
SET STATUS OFF
SET MOUSE OFF
SET SYSMENU OFF
SET DEBUG OFF

* Close any open windows *

DO WHILE .T.
    wname = WONTOP()
    IF LEN(wname) = 0
        EXIT
    ENDIF
    RELEASE WINDOW &wname
ENDDO

* Fiddle with the color scheme

myscheme = SCHEME(1)
spos = AT(",", myscheme, 4) + 1
len = AT(",", myscheme, 5) - spos
myscheme = STUFF(myscheme, spos, len, SCHEME(1,4))
SET COLOR OF SCHEME 1 TO &myscheme
myscheme = SCHEME(2)
spos = AT(",", myscheme, 4) + 1
len = AT(",", myscheme, 5) - spos
myscheme = STUFF(myscheme, spos, len, SCHEME(1,4))
SET COLOR OF SCHEME 2 TO &myscheme
CLEAR

* Bring in the floppy disk checking utility

LOAD isdiskin

* Initialize globals

keyword[1] = ""
keyword[2] = "RESOURCE"
keyword[3] = "OVERLAY"
keyword[4] = "EDITWORK"
keyword[5] = "SORTWORK"
keyword[6] = "PROGWORK"

bootdisk = UPPER(LEFT(GETENV('comspec'), 1))
savedir = SYS(5)+SYS(2003)
totopts = 6
cr = CHR(13)+CHR(10)+CHR(13)+CHR(10)
maxpath = 130
defdir = SPACE(maxpath)
IF bootdisk <> 'A' .AND. bootdisk <> 'B'

* Use current working directory of boot disk as default location

    SET DEFAULT TO (bootdisk)
    STORE PADR(bootdisk+ ":" + SYS(2003), 130)    TO defdir
    SET DEFAULT TO (savedir)
ENDIF

RETURN

**************************************************************************
* GETDEFAULTS - Initialize directories and pathnames with default values *
**************************************************************************
PROCEDURE getdefaults

* Initialize file location parameter values

FOR option = 1 TO totopts
    loc[option] = defdir
    IF RIGHT(loc[option], 1) <> '\'
        loc[option] = loc[option] + '\'
    ENDIF
ENDFOR
loc[1] = loc[1] + "CONFIG.FP"
loc[2] = loc[2] + "FOXUSER.DBF"

* See if there is a default config file

cfgdef = FOPEN(SYS(2004)+"CONFIG.DEF", 0)    && Try opening default config
IF cfgdef <> -1                                && Does it exist?
    filesize = FSEEK(cfgdef, 0, 2)
    = FSEEK(cfgdef, 0, 0)
    contents = FREAD(cfgdef, filesize)        && Read its contents
    = FCLOSE(cfgdef)
    FOR option = 2 TO totopts                && Look for overriding parameters
        spos = ATC(keyword[option], contents)
        IF spos <> 0                        && Found parameter, extract it
            spos = spos + AT("=", SUBSTR(contents, spos))
            len = AT(CHR(13)+CHR(10), SUBSTR(contents, spos)) - 1
            loc[option] = ALLTRIM(SUBSTR(contents, spos, IIF(len <> 0, len, filesize)))
        ENDIF
    ENDFOR
ENDIF

FOR option = 1 TO totopts
    IF LEN(loc[option]) < maxpath
        loc[option] = PADR(loc[option], maxpath)
    ENDIF
ENDFOR

RETURN

************************************
* CONFIG - Do the interactive part *
************************************
FUNCTION config
DIMENSION say[6]
say[1] = "CONFIG.FP pathname         "
say[2] = "FOXUSER pathname           "
say[3] = "Overlay files directory    "
say[4] = "Editor work files directory"
say[5] = "Sort work files directory  "
say[6] = "Program work file directory"
DEFINE WINDOW explain FROM 10,4 TO 22,75 DOUBLE ;
        TITLE ' Description of Configuration Option '

ok = .F.
ans = 1
@ 1,0 TO 24,79 CLEAR
@ 1, 62 SAY "Free Disk Space"
DO WHILE ans = 1
    FOR option = 1 TO totopts
        row = option + IIF(option < 3, 1, 2)
        @ row,3 SAY say[option] GET loc[option] FUNCTION "S30" ;
            WHEN getinfo() VALID validinfo() ;
            ERROR "Invalid directory or pathname";
            MESSAGE "Press F10 or PgDn when you have completed your modifications."
    ENDFOR
    option = 0
    READ
    @ option + IIF(option < 3, 1, 2), 64 SAY SPACE(11)
    @ 24,0                            && Clear message line
    @ 23,15 PROMPT " \<Modify " ;
        MESSAGE "Modify the configuration options displayed above."
    @ 23,29 PROMPT " \<Proceed " ;
        MESSAGE "Your AUTOEXEC.BAT will be modified and a CONFIG.FP created."
    @ 23,44 PROMPT " \<Abort " ;
        MESSAGE "Cancel the configuration procedure without making any changes."
    @ 23,57 PROMPT " \<Filer " ;
            MESSAGE "Browse the directories on your disk ... Press ESCAPE to continue."
    MENU TO ans
    IF ans = 4
        FILER
        IF WEXIST("Filer")
            DEACTIVATE WINDOW FILER
        ENDIF
        DO WHILE .T.        && Close any editor windows opened from filer
            wname = WONTOP()
            IF UPPER(wname) <> "EXPLAIN"
                RELEASE WINDOW &wname
            ELSE
                EXIT
            ENDIF
        ENDDO
        ans = 1
    ENDIF
    @ 23,0
ENDDO
RELEASE WINDOW explain
RETURN IIF(ans = 2, .T., .F.)

******************************************
* GETFINFO - This is the WHEN clause UDF *
******************************************
FUNCTION getinfo
error = .F.

* Clear old stats *

IF option <> 0
    @ option + IIF(option < 3, 1, 2), 64 SAY SPACE(11)
ENDIF

getvar = SYS(18)
option = VAL(SUBSTR(getvar, 5))
pathname = loc[option]

* Show available disk space *

IF LEN(ALLTRIM(&getvar)) <> 0
    ON ERROR error = .T.
    SET DEFAULT TO LEFT(pathname, 1)
    ON ERROR DO abort
    IF .NOT. error .AND. .NOT. INLIST(SYS(5), "A:", "B:")
        @ option + IIF(option < 3, 1, 2), 64 SAY TRANSFORM(DISKSPACE(),"999,999,999")
    ENDIF
    SET DEFAULT TO (savedir)
    IF error
        DO abort
    ENDIF
ENDIF

* Display explanation of configuration option *

DO explanation
RETURN .T.

********************************************
* VALIDINFO - This is the VALID clause UDF *
********************************************
FUNCTION validinfo
ok = .T.
getvar = SYS(18)
option = VAL(SUBSTR(getvar, 5))
pathname = UPPER(ALLTRIM(loc[option]))

* Validate the parameter *

DO CASE option
CASE option = 1
    basename = "CONFIG.FP"
CASE option = 2
    basename = "FOXUSER.DBF"
OTHERWISE
    basename = ""
ENDCASE
ok = validparm()

* Save validated directory or pathname *

IF ok
    loc[option] = IIF(LEN(pathname) > maxpath, pathname, PADR(pathname, maxpath))
ENDIF
RETURN ok

******************************************
* ABORT - Error occurred: Just shut down *
******************************************
PROCEDURE abort
ON ERROR
CLEAR TYPEAHEAD
WAIT MESSAGE() WINDOW TIMEOUT 20
IF ERROR() = 1001
    ON ERROR DO abort
    RETURN
ENDIF
DO cleanup
QUIT

*************************************************
* CLEANUP - Close everything down                *
*************************************************
PROCEDURE cleanup
CLEAR MACROS
CLEAR ALL
CLEAR
ON KEY
SET MOUSE ON
RETURN

************************************************
* CHECKDISK - Make sure boot disk is available *
************************************************
FUNCTION checkdisk
PARAMETER drive, disktype
diskin = .F.
checking = .T.
dletter = UPPER(drive)
DO WHILE .NOT. diskin .AND. checking
    CALL isdiskin WITH dletter
    IF dletter = '0'
        dletter = UPPER(drive)
        WAIT "Insert your " + IIF(LEN(disktype) = 0, "work files", disktype) ;
        + " disk in Drive " + dletter + ".  Press any key to continue." WINDOW
        IF LASTKEY() = 27
            checking = .F.
        ENDIF
    ELSE
        diskin = .T.
    ENDIF
ENDDO
RETURN diskin

*************************************************************
* AUTOEXEC - Create or modify the workstation autoexec file *
*************************************************************
FUNCTION autoexec
IF !checkdisk(bootdisk, "boot")
    RETURN .F.
ENDIF
filename = bootdisk + ":\AUTOEXEC.BAT"
setcmd = "SET FOXPROCFG="+loc[1]+CHR(13)+CHR(10)
autoexec = FOPEN(filename, 2)
IF autoexec == -1                        && Can't find autoexec.bat
    autoexec = FCREATE(filename, 0)        && Create an autoexec.bat
    IF autoexec == -1
        RETURN .F.
    ELSE
        = FWRITE(autoexec, setcmd)
        = FCLOSE(autoexec)
        RETURN .T.
    ENDIF
ELSE                                && Found one so modify it
    filesize = FSEEK(autoexec, 0, 2)
    = FSEEK(autoexec, 0, 0)
    contents = FREAD(autoexec, filesize)
    spos = ATC("SET FOXPROCFG", contents)
    IF spos <> 0                    && Already there, just modify
        len = AT(CHR(13)+CHR(10), SUBSTR(contents, spos)) + 1
        IF len = 0
            len = LEN(SUBSTR(contents, spos))
        ENDIF
    ELSE                            && Not there, append
        len = AT(CHR(26), contents)
        IF len <> 0
            contents = LEFT(contents, len - 1)
            len = 0
        ENDIF
        spos = RAT(CHR(13)+CHR(10), contents, ;
                    IIF(RIGHT(contents, 2) <> CHR(13)+CHR(10), 1, 2))
        spos = spos + IIF(spos = 0, 1, 2)
    ENDIF
    contents = STUFF(contents, spos, len, setcmd)
    = FSEEK(autoexec, 0, 0)
    = FWRITE(autoexec, contents)
    = FCHSIZE(autoexec, LEN(contents))
    = FCLOSE(autoexec)
ENDIF
RETURN .T.

********************************************************
* CONFIG_FP - Create or modify workstation CONFIG file *
********************************************************
FUNCTION config_fp
IF !checkdisk(LEFT(loc[1], 1), loc[1])
    RETURN .F.
ENDIF

config = FOPEN(loc[1], 2)            && Open the config file
IF config == -1                        && Can't find it?
    config = FCREATE(loc[1], 0)        && Create a config file
    IF config == -1
        RETURN .F.
    ELSE                            && Use default config file as basis
        cfgdef = FOPEN(SYS(2004)+"CONFIG.DEF", 0)    && Open default config
        IF cfgdef <> -1                                && Does it exist?
            filesize = FSEEK(cfgdef, 0, 2)
            = FSEEK(cfgdef, 0, 0)
            contents = FREAD(cfgdef, filesize)        && Read its contents
            = FCLOSE(cfgdef)
            IF RIGHT(contents, 2) <> CHR(13)+CHR(10)
                contents = contents + CHR(13)+CHR(10)
            ENDIF
            FOR option = 2 TO totopts    && Remove default config options
                spos = ATC(keyword[option], contents)
                IF spos <> 0        && Found it
                    len = AT(CHR(13)+CHR(10), SUBSTR(contents, spos)) + 1
                    contents = STUFF(contents, spos, len, "")
                ENDIF
            ENDFOR
        ELSE
            contents = ""
        ENDIF
        FOR option = 2 TO totopts                    && Now append directory options
            contents = contents + keyword[option] + "=" + loc[option] + ;
                        IIF(option=3," OVERWRITE","") + CHR(13) + CHR(10)
        ENDFOR
        = FWRITE(config, contents)
        = FCLOSE(config)
        RETURN .T.
    ENDIF
ELSE                                && Found one so modify it
    filesize = FSEEK(config, 0, 2)
    = FSEEK(config, 0, 0)
    contents = FREAD(config, filesize)
    FOR option = 2 TO totopts
        configcmd = keyword[option] + "=" + loc[option] + ;
                    IIF(option=3," OVERWRITE","") + CHR(13) + CHR(10)
        spos = ATC(keyword[option], contents)
        IF spos <> 0                    && Already there, just modify
            len = AT(CHR(13)+CHR(10), SUBSTR(contents, spos)) + 1
            IF len = 0
                len = LEN(SUBSTR(contents, spos))
            ENDIF
        ELSE                            && Not there, append
            IF RIGHT(contents, 2) <> CHR(13)+CHR(10)
                configcmd = CHR(13)+CHR(10)+configcmd
            ENDIF
            spos = filesize + 1
            len = 0
        ENDIF
        contents = STUFF(contents, spos, len, configcmd)
    ENDFOR

    = FSEEK(config, 0, 0)
    = FWRITE(config, contents)
    = FCHSIZE(config, LEN(contents))
    = FCLOSE(config)
ENDIF
RETURN .T.

************************************************************************
* RESOURCE - If FOXUSER file doesn't exist for this work station, copy *
*            DEFUSER file as FOXUSER for this work station.               *
************************************************************************
PROCEDURE resource
deffile = SYS(2004)+"DEFUSER.DBF"
IF .NOT. FILE(deffile)
    RETURN        && Don't bother if default resource doesn't exist
ENDIF

IF FILE(loc[2])        && Resource file for work station already exists
    RETURN
ENDIF

USE (deffile)
COPY TO (loc[2])
USE
RETURN

*****************************************************************
* VALIDPARM - Make sure you have a valid pathname or directory     *
*****************************************************************
PROCEDURE validparm
IF .NOT. checkdisk(LEFT(pathname, 1), basename)
    RETURN .F.
ENDIF

needdir = IIF(LEN(basename) = 0, .T., .F.)
IF .NOT. needdir
    extension = SUBSTR(basename, AT(".", basename))
ENDIF
STORE .T. TO ok, isdir

ON ERROR isdir = .F.
SET DEFAULT TO (pathname)                && See if it is a directory
ON ERROR DO abort                        && Restore error condition
SET DEFAULT TO (savedir)                && Restore old default value
IF .NOT. isdir                            && It was not a valid directory
    IF needdir
        ok = mkdir(pathname)
    ELSE                                && It's supposed to be a pathname
        lastpos = RAT('\', pathname)
        IF lastpos > 3                    && Make sure all dirs. exist
            IF lastpos <> LEN(pathname)    && Remove any filename part
                isdir = .T.
                ON ERROR isdir = .F.
                SET DEFAULT TO (LEFT(pathname, lastpos-1))
                ON ERROR DO abort
                SET DEFAULT TO (savedir)
            ENDIF
            IF .NOT. isdir
                ok = mkdir(LEFT(pathname, lastpos-1))
            ENDIF
        ENDIF
        IF ok .AND. lastpos <> LEN(pathname)    && Must be a filename
            isdir = .F.
            IF AT('.', pathname) = 0
                pathname = pathname + extension
            ENDIF
        ENDIF
    ENDIF
ENDIF
IF isdir                                && Must have been a valid directory
    IF RIGHT(pathname,1) <> "\"
        pathname = pathname + "\"
    ENDIF
    IF .NOT. needdir                    && Must need a filename
        pathname = pathname + basename
    ENDIF
ENDIF
RETURN ok

********************************************************
* MKDIR - Find out if user wants to create a directory *
********************************************************
FUNCTION mkdir
PARAMETER directory
STORE .T. TO ok
ans = 2
DEFINE WINDOW alert FROM 13,14 to 18,66 COLOR SCHEME 7 DOUBLE
ACTIVATE WINDOW alert
?? CHR(7)
?? directory + " does not exist.  Do you want to " + ;
    "create it?" ;
    AT 1 FUNCTION "v49"
@ 3,11 PROMPT "   \<Yes   "
@ 3,31 PROMPT "   \<No   "
MENU TO ans
RELEASE WINDOW alert
IF ans <> 1
    ok = .F.
ELSE
    isdir = .T.
    next = 2                        && Start looking after the root
    ok = checkdisk(LEFT(directory,1), basename)
    DO WHILE ok
        pos = AT('\', directory, next)
        work = IIF(pos <> 0, LEFT(directory, pos-1), directory)
        ON ERROR isdir = .F.
        SET DEFAULT TO (work)        && See if it is a directory
        ON ERROR DO abort            && Restore error condition
        IF .NOT. isdir
            command = "RUN mkdir " + work
            &command
            isdir = .T.
            ON ERROR isdir = .F.
            SET DEFAULT TO (work)        && Check if successful
            ON ERROR DO abort
            ok = isdir
        ENDIF
        IF pos = LEN(directory)
            pos = 0
        ENDIF
        IF pos = 0 .OR. .NOT. ok
            EXIT
        ELSE
            next = next + 1
        ENDIF
    ENDDO
    SET DEFAULT TO (savedir)    && Restore old default value
ENDIF
RETURN ok

************************************************
* PROCEED - Describe the configuration process *
************************************************
FUNCTION proceed
lmarg = 4
@ 0,0 SAY PADC("Configuring Your FoxPro Work Station", 80)
? "The ADDUSER utility enables you to customize your individual work station and "+;
   "configure it for optimal performance on your FoxPro multi-user system.";
   AT lmarg FUNCTION "v72"
?
?  "Each work station should have its own CONFIG.FP and FOXUSER files.  "+;
   "The CONFIG.FP file contains a set of options that specify the default  "+;
   "environment when FoxPro starts up.  The FOXUSER file contains "+;
   "a variety of information affecting your operating environment "+;
   "including window sizes and positions, color sets, diary entries, etc.  "+;
   "ADDUSER insures that these two files exist either on your local "+;
   "drive or in a network directory assigned to your individual work "+;
   "station.";
   AT lmarg FUNCTION "v72"
?
? "There are other FoxPro files that should reside on your local hard "+;
   "drive (if at all possible) in order to reduce the amount of traffic "+;
   "between the server and your work station.  These include the FoxPro "+;
   "overlay and temporary work files.";
   AT lmarg FUNCTION "v72"
?
*? "The first step is to determine where these FoxPro files will reside...";
*   AT lmarg FUNCTION "v72"
? "Displayed below is the directory that will be used as a starting point "+;
  "for finetuning your configuration.  Make any changes and press ENTER "+;
  "to continue." AT lmarg FUNCTION "v72"
@ 22, 3 TO 24, 74 DOUBLE
@ 23, 6 GET defdir FUNCTION "s65"
READ
defdir = ALLTRIM(defdir)
DO getdefaults

@ 23, 6 TO 23, 73 CLEAR
@ 23, 6 PROMPT " \<Continue with configuration "
@ 23, 41 PROMPT " \<Abort configuration procedure "
MENU TO ans
RETURN IIF(ans = 1, .T., .F.)

**********************************************************************
* EXPLANATION - Display an explanation for each configuration option *
**********************************************************************
PROCEDURE explanation
ACTIVATE WINDOW explain
CLEAR
DO CASE
CASE option = 1
   msg = "The "+;
   "CONFIG.FP file contains a set of options that specify the default "+;
   "environment when FoxPro starts up.  It is typically small "+;
   "(less than 1024 bytes) but can be several thousand bytes if it contains "+;
   "many options.  Since it is accessed only on startup, performance will "+;
   "not be affected if it is located on the network.  It must, however, "+;
   "have either a unique location or filename that is designated for your "+;
   "work station."+cr+"A new SET command will be added to your "+;
   "AUTOEXEC.BAT file which tells FoxPro where to find your CONFIG.FP."
CASE option = 2
   msg = "FOXUSER, the FoxPro resource file, is actually a standard FoxPro "+;
   "database with a memo field and an index.  It contains a variety of "+;
   "information affecting your operating environment including window sizes "+;
   "and positions, color sets, diary entries, etc.  FOXUSER "+;
   "requires a minimum of 12K of disk space.  As you use FOXPRO interactively, "+;
   "new records may be added to this file."+cr+"If you do not "+;
   "specify either a directory or filename that is unique to your work "+;
   "station, access to the resource file will be disabled."
CASE option = 3
   msg = "FoxPro's overlay files require about 575K bytes of disk space.  These "+;
   "files are accessed very frequently while operating FoxPro so they "+;
   "should be located on the highest speed device available.  Usually, it is "+;
   "desirable to place these files on your local hard drive or on a RAM disk.  "+;
   cr+"On startup, FoxPro always insures that there are valid copies of these files "+;
   "in the directory you specified; therefore, you never have to "+;
   "copy these files yourself."
CASE option = 4
   msg = "For each editor session, FoxPro creates a temporary work file "+;
   "that can become as large as the original file being edited.  "+;
   "And, of course, you may have several editing sessions in progress simultaneously."+;
   cr+"For the best response time while editing your files you should "+;
   "place these files on your local drive if at all possible.  "+;
   "In any case, you should insure that you have enough disk space on "+;
   "the device you specify for your editing sessions."
CASE option = 5
   msg = "FoxPro creates temporary work files when SORTing and INDEXing.  The "+;
   "work files for sorting can be as much as three times the size of the "+;
   "original database.  The work files for indexing can be as much as three times "+;
   "the size of the resulting index file."+cr+"High speed access to these work "+;
   "files is a critical factor in performance for sorting and indexing "+;
   "so these files should be placed on your local drive if at all possible.  "+;
   "In any case, you should insure that you have enough disk space on "+;
   "the device you specify for sorting and indexing your databases."
CASE option = 6
   msg = "FoxPro uses a special work file for managing the programs you call "+;
   "while running your applications.  This file is generally less than "+;
   "256K bytes and is a good candidate to be situated on a RAM disk if you "+;
   "have one."
ENDCASE
?? msg AT 1 FUNCTION "v67"
RETURN

***********************************************************************
* FLOPPY - If booting from floppy, display message to insert bootdisk *
***********************************************************************
PROCEDURE floppy
DEFINE WINDOW explain FROM 10,10 to 17,70 DOUBLE
ACTIVATE WINDOW explain
msg = "Your AUTOEXEC.BAT will be modified to tell FoxPro where to "+;
    "find your CONFIG.FP file.  Please insert your boot disk in Drive "+;
    bootdisk + ": and make sure that it is not write-protected."+;
    cr+"Press any key to continue..."
?? msg AT 1 FUNCTION "v57"
WAIT ""
RETURN

*****************************************************************************
* FINAL - Display message to reboot system before next invokation of FoxPro *
*****************************************************************************
PROCEDURE final
DEFINE WINDOW explain FROM 10,10 to 17,70 DOUBLE
ACTIVATE WINDOW explain
IF success
    msg = "Your AUTOEXEC.BAT file has been modified to tell FoxPro where to "+;
    "find your CONFIG.FP file.  Exit FoxPro in the normal manner and reboot "+;
    "your system before you "+;
    "start up FoxPro again in order for your changes to take effect."+;
    cr+"Press any key to continue..."
ELSE
    msg = "Unable to create or modify your AUTOEXEC.BAT and/or your "+;
    "CONFIG.FP file.  Please consult your network administrator."+cr+;
    "Press any key to continue..."
ENDIF
?? msg AT 1 FUNCTION "v57"
WAIT ""
RETURN