Liren Large Software Subsidy 5

home *** CD-ROM | disk | FTP | other *** search

/ Liren Large Software Subsidy 5 / 05.iso / a / a107 / 1.ddi / DKSETUP.PR_ / DKSETUP.bin

Wrap

Text File | 1994-04-28 | 100.6 KB | 3,019 lines

*!***************************************************************************** *! *: Program: DKSETUP.PRG *! *!***************************************************************************** * Microsoft FoxPro SetupWizard -- FoxPro 2.5 for Windows * This program is designed to simplify the process of creating the installation * disks for a FoxPro developer to install a FoxPro application on a user's machine. * Copyright, Microsoft Corp., 1993 * Written by Walter J. Kennamer PROCEDURE dksetup EXTERNAL SCREEN dkscrn1, dkscrn2, dkscrn3, dkscrn4, dkscrn5, dkscrn6, dkscrn7,; dkscrn8, dkscrn9, dkscrn10 EXTERNAL LIBRARY foxtools.fll PRIVATE ALL * Carriage return/line feed #DEFINE c_crlf CHR(13)+CHR(10) * View file name #DEFINE c_vuename dksetup.vue #DEFINE c_vuename_str "DKSETUP.VUE" * File names for standard files used by Wizard or by SETUP.EXE #DEFINE c_setupinf "SETUP.INF" #DEFINE c_setuplst "SETUP.LST" #DEFINE c_eslfile "FOXW250B.ESL" * File names for obsolete compressed files #DEFINE c_oldesl "FOXW2500.ESL" #DEFINE c_oldesl1 "FOXW250A.ESL" * Default max 512-byte units before file split. May be changed in INI file #DEFINE c_units 710 * User push button actions #DEFINE c_cancel 0 #DEFINE c_back 1 #DEFINE c_next 2 #DEFINE c_done 3 * Error message codes #DEFINE c_status 1 #DEFINE c_warning 2 #DEFINE c_fatal 3 #DEFINE c_entry 4 && data entry validation error #DEFINE c_entry1 5 && data entry validation error, with option to cancel #DEFINE c_entry2 6 && data entry validation error, with Yes/No prompt * Error numbers--indexes into error_array #DEFINE en_extension 1 #DEFINE en_foxtools 2 #DEFINE en_dir1 3 #DEFINE en_dir2 4 #DEFINE en_dir3 5 #DEFINE en_noexe 6 #DEFINE en_fxtver 7 #DEFINE en_nortfiles 8 #DEFINE en_missing 9 #DEFINE en_notfound 10 #DEFINE en_getfile 11 #DEFINE en_hidden 12 #DEFINE en_blanksrc 13 #DEFINE en_noreq 14 #DEFINE en_ufopen 15 #DEFINE en_cprserr 16 #DEFINE en_toobig 17 #DEFINE en_blankexe 18 #DEFINE en_exemiss 19 #DEFINE en_exem1 20 #DEFINE en_toolong 21 #DEFINE en_nocompress 22 #DEFINE en_missreq 23 #DEFINE en_nogroup 24 #DEFINE en_oldver 25 #DEFINE en_cprsdead 26 #DEFINE en_badpath 27 #DEFINE en_nocfg 28 #DEFINE en_baddir 29 #DEFINE en_dir4 30 * Displayed as message box title #DEFINE e_error_title "Microsoft FoxPro SetupWizard Error" * Disk types, corresponding to dtype entry in DISKS.DBF #DEFINE c_dsk144 1 #DEFINE c_dsk12 2 #DEFINE c_dsk720 3 * User Modification options #DEFINE c_modall 1 && User can modify both default directory and PM Group #DEFINE c_modgroup 2 && User can modify just the PM group #DEFINE c_modnone 3 && User can modify neither directory or PM Group * The name of the compress directory, off the destination tree #DEFINE c_cprsdir "COMPRESS" * Preferences constants--no translation needed #DEFINE c_setupini SYS(2004)+"DKSETUP.INI" #DEFINE c_pref "Preferences" #DEFINE c_sourcedir "SourceDirectory" #DEFINE c_destdir "DestinationDirectory" #DEFINE c_runtime "RuntimeDirectory" #DEFINE c_make144 "Make1.44MegDisks" #DEFINE c_make12 "Make1.2MegDisks" #DEFINE c_make720 "Make720KDisks" #DEFINE c_instgraph "InstallGraph" #DEFINE c_targetdir "UserDefaultDirectory" #DEFINE c_appname "ApplicationName" #DEFINE c_pmdescript "ProgManDescript" #DEFINE c_runanother "PostExecute" #DEFINE c_setuptitle "SetupBanner" #DEFINE c_copyright "Copyright" #DEFINE c_splitsize "SplitSize" #DEFINE c_algorithm "Algorithm" #DEFINE c_usermod "UserCanModify" #DEFINE c_pmgroup "ProgManGroup" #DEFINE c_nologo "SuppressLogo" #DEFINE c_parameters "EXEParameters" #DEFINE c_altcfgfile "ConfigFile" * Message box responses, from WIN16.H file. #DEFINE idok 1 #DEFINE idcancel 2 #DEFINE idabort 3 #DEFINE idretry 4 #DEFINE idignore 5 #DEFINE idyes 6 #DEFINE idno 7 * Number of columns in the disk statistics array #DEFINE c_diskcols 3 * Extension of files that are given random names #DEFINE c_randext "SET" * Strings used in the program #DEFINE c_product "Microsoft FoxPro" #DEFINE c_setupname "SetupWizard" #DEFINE c_thermprompt "Creating setup disks..." * SET MESSAGE TO strings -- these need to be translated #DEFINE s_winonly "The SetupWizard requires FoxPro for Windows" #DEFINE s_to "to" #DEFINE s_for "for" #DEFINE s_filling "Scanning application files" #DEFINE s_compressing "Checking for name uniqueness" #DEFINE s_batch "Preparing to compress files" #DEFINE s_cprs "Compressing application files" #DEFINE s_canceling "Canceling setup" #DEFINE s_mkdir "Creating output directories" #DEFINE s_copying "Copying" #DEFINE s_required "Installing setup support files" #DEFINE s_assign "Assigning files" #DEFINE s_ufsize "Determining uncompressed file size" #DEFINE s_cprssize "Determining compressed file sizes" #DEFINE s_makeinf "Creating setup information file" #DEFINE s_splitting "Splitting" #DEFINE s_again "again. Please do not interrupt." #DEFINE s_setuptitle "Setup" && default title #DEFINE s_setupinit "Initializing Setup..." #DEFINE s_escape "Exiting the SetupWizard" #DEFINE s_cleanup "Cleaning up entries for" #DEFINE e_foxtools "The SetupWizard requires FOXTOOLS.FLL" IF SET("TALK") = "ON" SET TALK OFF m.mtalk = "ON" ELSE m.mtalk = "OFF" ENDIF * SET state variables. Declared here so as to be visible in both init and cleanup. STORE "" TO m.mtrbet,m.mecho,m.mdebug,m.mstep,m.mudfparms,m.mcompat,m.mexact,; m.mnear,m.munique,m.mansi,m.mcarry, m.mstatus, m.mescape, m.merror, m.mlibrary, ; m.mdefault, m.mpoint, m.mdecimals IF _WINDOWS DO init DO main DO cleanup ELSE WAIT WINDOW s_winonly NOWAIT ENDIF RETURN *!***************************************************************************** *! *! Procedure: MAIN *! *!***************************************************************************** PROCEDURE main DIMENSION error_array[30] error_array = "" error_array[en_extension] = "The file extension must be EXE, COM, PIF or BAT" error_array[en_foxtools] = "The SetupWizard requires FOXTOOLS.FLL." error_array[en_fxtver] = "The SetupWizard requires version 1.01"+c_crlf+"or higher of FOXTOOLS.FLL." error_array[en_dir1] = "The source and compressed"+c_crlf+"directories must be different." error_array[en_dir2] = "The source and destination"+c_crlf+"directories must be different." error_array[en_dir3] = "The compressed and destination"+c_crlf+"directories must be different." error_array[en_noexe] = "There are not any APP, PRG, FXP or EXE"+c_crlf+"files in this directory." error_array[en_nortfiles] = "There aren't any files in the runtime directory." error_array[en_missing] = "(missing)" error_array[en_notfound] = "could not be found." error_array[en_getfile] = "Locate it?." error_array[en_hidden] = "Hidden or system file found in" error_array[en_blanksrc] = "The directory name cannot be blank." error_array[en_blankexe] = "The application name cannot be blank." error_array[en_noreq] = "One of the required files is missing unexpectedly." error_array[en_ufopen] = "Error determining uncompressed file size." error_array[en_cprserr] = "Error compressing" error_array[en_toobig] = "File is too big for COMPRESS"+c_crlf+"to split into 9 or fewer pieces." error_array[en_exemiss] = "The application EXE file could not be found" error_array[en_exem1] = "The application EXE file could not be found"+c_crlf+"in the application directory tree." error_array[en_toolong] = "The compression command exceeds the 128 byte DOS limit."+c_crlf; +"Try shortening some directory names or put COMPRESS.EXE"+c_crlf; +"on the DOS path." error_array[en_nocompress]= "COMPRESS.EXE could not be found." error_array[en_missreq] = "Required file missing: "+c_crlf error_array[en_nogroup] = "The Program Manager group cannot be blank." error_array[en_oldver] = "Your DKCONTRL.DBF file is outdated. Please delete it." error_array[en_cprsdead] = "Error during compression. Compression may have been interrupted." error_array[en_badpath] = "That path or file name is invalid." error_array[en_nocfg] = "The alternate CONFIG file name is blank." error_array[en_baddir] = "Could not create directory" error_array[en_dir4] = "The destination directory cannot be in the application tree." m.g_defdrive = SET("DEFAULT") * Default values for data items prompted for in the interface. Once the user runs the * Wizard the first time, his previous choices are stored in DKSETUP.INI and become the * defaults for future sessions. m.g_sourcedir = "" && the "root" of the application m.g_cprsdir = "" && where the compressed files go m.g_destdir = "" && root of destination tree m.g_targetdir = "" && default directory on ultimate user's machine m.g_dsk144 = .T. && make 1.44 meg disks? m.g_dsk12 = .F. && make 1.2 meg disks? m.g_dsk720 = .F. && make 720K disks? m.g_instgraph = .F. && Install MSGraph? m.g_pmdescript = "" && ProgMan description m.g_pmgroup = "" && ProgMan group m.g_usealtcfg = 0 && Use alternative CONFIG.FPW file? m.g_altcfgfile = "" && name of alternative CONFIG.FPW file m.g_modoptions = 1 && allow user to modify PM Group and directory? m.g_nologo = 1 && suppress FoxPro logo m.g_appname = "" && name of application m.g_executable = "" && name of program to run after completion of setup m.g_title = "" && Banner to display during setup m.g_copyright = "" && Copyright notice to display during setup m.g_parameters = "" && optional parameters passed to user EXE * Find the runtime files m.g_runtimedir = SYS(2004)+"DKSETUP" && where the runtime files are by default * Items that are stored in the INI file but not prompted for. m.g_splitsize = c_units * 512 && split files down to this size m.g_algorithm = "2" && compression algorithm. Can be 2 or 3. 2 is faster. 3 is smaller. * Where is FOXW2500.ESL? m.g_esl = SYS(2004)+c_eslfile && name and location of ESL file m.g_eslextra = .F. && is the ESL file outside the app tree? * Name of the control file that records the files involved in this setup, their locations * and sizes, and the disks they are assigned to. This file is written to the application * root directory. It is not installed onto user disks. m.g_dkcname = "DKCONTRL.DBF" m.g_dbalias = "DKCONTRL" m.g_firstset = .T. && first set of disks (e.g., 1.44 meg) not yet completed m.g_newctrl = .T. && assume we are making a new DKCONTRL database. m.g_foxprint = .T. && is FoxPrint being installed? m.g_thermwidth = 0 && set in Acttherm() * Dimension the array that contains disk statistics (one row per disk). * Column 1 contains the number of files on the disk. Column 2 contains the * actual nominal file size total for the disk. Column 3 contains the bytes * in allocated clusters for the disk. m.g_diskcount = 1 DIMENSION g_disks[1,c_diskcols] g_disks = 0 * Install the FOXTOOLS library. This library contains many functions used throughout * the Wizard, including the filename parsing functions, the MessageBox function and the * CALLDLLs functions that we use to manage the DKSETUP.INI file. IF FILE(SYS(2004)+"FOXTOOLS.FLL") SET LIBRARY TO (SYS(2004)+"FOXTOOLS.FLL") ADDITIVE IF foxtoolver() < "1.01" DO errormsg WITH en_fxtver, c_fatal RETURN ENDIF ELSE * Don't use message box here, since the function to display it is inside FoxTools. WAIT WINDOW e_foxtools NOWAIT RETURN ENDIF * Retrieve last set of user's responses DO getpreferences WITH c_setupini * Start the wizard and allow the user to run through the screens IF dispatch() = c_cancel RETURN TO dksetup ENDIF * Record this set of responses DO putpreferences WITH c_setupini DO putpreferences WITH addbs(m.g_sourcedir)+justfname(c_setupini) * Determine the compress directory m.g_cprsdir = addbs(m.g_destdir) + c_cprsdir * Start the thermometer DO acttherm WITH c_setupname =updtherm(5) * Create or open the control database m.dkcname = getctrl(addbs(m.g_sourcedir)+m.g_dkcname, @m.g_dbalias) =updtherm(10) * Fill in the dkcontrl file with the names of all the files we want to install DO gatherdir =updtherm(15) * Generate unique compression names for the files in the application tree. DO genuniq WITH m.dkcname =updtherm(25) * Add the list of required files (e.g., those used by the Setup Toolkit, such as * SHELL.DLL and VER.DLL) to the dkcontrl database. DO reqfiles * Install FoxPrint fonts if they are present in the DKSETUP directory DO fpinst =updtherm(35) * Add any optional components (e.g., Graph runtime) that user has selected DO optinst * Add the file to be executed at conclusion of setup, if any DO executinst =updtherm(40) * Lay out the files into disks. Start with a new array for each set. IF m.g_dsk144 m.g_diskcount = 1 g_disks = 0 && initialize the array to 0 DO makedisks WITH c_dsk144, m.g_destdir m.g_firstset = .F. ENDIF IF m.g_dsk12 m.g_diskcount = 1 g_disks = 0 DO makedisks WITH c_dsk12, m.g_destdir m.g_firstset = .F. ENDIF IF m.g_dsk720 m.g_diskcount = 1 g_disks = 0 DO makedisks WITH c_dsk720, m.g_destdir m.g_firstset = .F. ENDIF =updtherm(100) DO deactthermo DO showsumry *!***************************************************************************** *! *! Procedure: INIT *! *!***************************************************************************** PROCEDURE init CREATE VIEW c_vuename CLOSE DATABASES m.mlibrary = SET("LIBRARY",1) m.mstatus = SET("STATUS BAR") SET MESSAGE TO c_product + " " + c_setupname && suppress database names, etc. * These will be restored to their original values when the VUE file is restored. m.mtrbet = SET("TRBETWEEN") SET TRBETWEEN OFF m.mecho = SET("ECHO") SET ECHO OFF m.mdebug = SET("DEBUG") SET DEBUG OFF m.mstep = SET("STEP") SET STEP OFF m.mudfparms = SET("UDFPARMS") SET UDFPARMS TO VALUE m.mcompat = SET("COMPATIBLE") SET COMPATIBLE FOXPLUS m.mexact = SET("EXACT") SET EXACT OFF m.mnear = SET("NEAR") SET NEAR OFF m.munique = SET("UNIQUE") SET UNIQUE OFF m.mansi = SET("ANSI") SET ANSI OFF m.mcarry = SET("CARRY") SET CARRY OFF m.mpoint = SET("POINT") SET POINT TO "." m.decimals = SET("DECIMALS") m.mdefault = SET("DEFAULT")+CURDIR() m.mescape = ON("ESCAPE") ON ESCAPE DO esc_handler m.merror = ON("ERROR") ON ERROR DO errorhandler WITH MESSAGE(), c_fatal SELECT 0 USE DISKS EXCLUSIVE SET ORDER TO TAG dtype SELECT 0 USE required EXCLUSIVE SELECT 0 USE naughty EXCLUSIVE SET ORDER TO TAG filname *!***************************************************************************** *! *! Procedure: CLEANUP *! *!***************************************************************************** PROCEDURE cleanup IF WEXIST("thermomete") DO deactthermo ENDIF IF WEXIST("dksetup") RELEASE WINDOW dksetup ENDIF IF USED("naughty") SELECT naughty USE ENDIF IF USED("required") SELECT required USE ENDIF IF USED("disks") SELECT disks USE ENDIF IF USED("dkcontrl") SELECT dkcontrl USE ENDIF IF FILE(c_vuename_str) SET VIEW TO c_vuename DELETE FILE c_vuename ENDIF ON ESCAPE &mescape ON ERROR &merror IF !("FOXTOOLS" $ UPPER(m.mlibrary)) RELEASE LIBRARY (SYS(2004)+"FOXTOOLS.FLL") ENDIF SET DEFAULT TO &mdefault SET STATUS BAR &mstatus SET TRBETWEEN &mtrbet SET ECHO &mecho SET DEBUG &mdebug SET STEP &mstep SET UDFPARMS TO &mudfparms SET COMPATIBLE &mcompat SET EXACT &mexact SET NEAR &mnear SET UNIQUE &munique SET ANSI &mansi SET CARRY &mcarry SET TALK &mtalk SET DECIMALS TO &mdecimals SET POINT TO "&mpoint" *!***************************************************************************** *! *! Function: ERRORMSG *! *!***************************************************************************** FUNCTION errormsg PARAMETER m.msg, m.howbad PRIVATE m.icons, m.choice * If the first parameter is a number, it's the index into the error_array array IF TYPE("m.msg") = "N" m.msg = error_array[m.msg] ENDIF * Message box defines #DEFINE mb_ok 0 #DEFINE mb_okcancel 1 #DEFINE mb_abortretryignore 2 #DEFINE mb_yesnocancel 3 #DEFINE mb_yesno 4 #DEFINE mb_retrycancel 5 #DEFINE mb_iconhand 16 #DEFINE mb_iconquestion 32 #DEFINE mb_iconexclamation 48 #DEFINE mb_iconasterisk 64 #DEFINE mb_iconinformation mb_iconasterisk #DEFINE mb_iconstop mb_iconhand DO CASE CASE m.howbad = c_entry m.icons = mb_iconstop + mb_ok CASE m.howbad = c_entry1 m.icons = mb_iconstop + mb_okcancel CASE m.howbad = c_entry2 m.icons = mb_iconstop + mb_yesno CASE m.howbad = c_status m.icons = mb_iconexclamation + mb_okcancel CASE m.howbad = c_warning m.icons = mb_iconstop + mb_ok CASE m.howbad = c_fatal m.icons = mb_iconstop + mb_ok OTHERWISE m.icons = mb_iconstop + mb_ok ENDCASE m.choice = msgbox(msg,e_error_title,m.icons) DO CASE CASE m.howbad = c_fatal RETURN idcancel CASE m.howbad = c_entry2 RETURN m.choice && Yes or No CASE (m.howbad = c_warning) ; OR (INLIST(m.howbad,c_status,c_entry1) AND m.choice = idcancel) RETURN idcancel OTHERWISE RETURN idok ENDCASE *!***************************************************************************** *! *! Procedure: ESC_HANDLER *! *!***************************************************************************** PROCEDURE esc_handler WAIT WINDOW s_escape NOWAIT RETURN TO dksetup *!***************************************************************************** *! *! Procedure: GETHELP *! *!***************************************************************************** PROCEDURE gethelp PARAMETER seekstrg m.in_area = SELECT() IF USED("dkhelp") SELECT dkhelp SET ORDER TO TAG topics ELSE SELECT 0 USE dkhelp AGAIN ORDER TAG topics ENDIF SEEK seekstrg IF FOUND() DO disphelp.spr ENDIF USE SELECT (m.in_area) *!***************************************************************************** *! *! Procedure: DISPATCH *! *!***************************************************************************** PROCEDURE dispatch * Manage the navigation from screen to screen m.nextscrn = 1 m.action = c_next DO WHILE m.action <> c_cancel AND m.action <> c_done m.thisscrn = m.nextscrn && nextscrn was set in the DKSCRNx.SPR program. * Form the name of the next screen to go to. The screens have to be numbered * consecutively for this scheme to work properly. DO ("dkscrn"+ALLTRIM(STR(nextscrn,2))+".spr") WITH m.action, m.thisscrn, m.nextscrn @ 0.213,15.600 CLEAR TO 18.616, 97.800 ENDDO * Free the window that the interface uses IF WEXIST("DKSETUP") RELEASE WINDOW dksetup ENDIF RETURN m.action *!***************************************************************************** *! *! Procedure: CREATECTRL *! *!***************************************************************************** PROCEDURE createctrl PARAMETER m.dbfname * Create the DBCONTRL file, which lists each file being copied to the destination disks. * It has one record per file in the application tree, one record for each piece of a split * file, and also contains records for Graph (if chosen), the executable program to run at * the conclusion of setup, plus any required setup files or DLLs. * * Its fields are as follows: * * Fname -- Character type File name * Filsize -- Numeric File size (see expndsize for split files, however) * Fdate -- Date File date last changed * Ftime -- Character File time * Fattrib -- Character Attribute string * Cprsname -- Character Name of file when compressed * Cprssize -- Numeric Size of file when compressed * Cprsflag -- Logical Does file need to be compressed this pass? * Expndsize-- Numeric Expanded size, if a split file. Same as filsize otherwise. * Compress -- Logical Is file ever compressed? * Filfound -- Logical Can the file be found? * dest144 -- Numeric Which 1.44meg disk does it go on? * dest12 -- Numeric Which 1.2 meg disk does it go on? * dest720 -- Numeric Which 720K disk does it go on? * Setupfile-- Logical Required file for SETUP.EXE? * Extrafile-- Logical Optional component (e.g., graph runtime)? * Splitfile-- Logical Is this a part of a split file? * Parent -- Character Ultimate parent file, if this is a split file * UniqueID -- Character Matches parents and children * PRIVATE ALL CREATE TABLE (m.dbfname) ( ; fname C(80), ; filsize N(10,0), ; fdate D, ; ftime C(10), ; fattrib C(5), ; cprsname C(12), ; cprssize N(10,0), ; expndsize N(10,0), ; filfound l, ; dest144 N(10,0), ; dest12 N(10,0), ; dest720 N(10,0), ; setupfile l, ; extrafile l, ; cprsflag l, ; COMPRESS l, ; parent C(12), ; splitfile l, ; uniqueid C(12) ; ) * Now construct the indexes we need INDEX ON UPPER(fname) TAG fname INDEX ON UPPER(cprsname) TAG cprsname INDEX ON STR(100000000-cprssize,10)+parent+cprsname TAG cprssize INDEX ON STR(dest144,3)+cprsname TAG dest144 INDEX ON STR(dest12,3)+cprsname TAG dest12 INDEX ON STR(dest720,3)+cprsname TAG dest720 *!***************************************************************************** *! *! Function: GETCTRL *! *!***************************************************************************** FUNCTION getctrl PARAMETER m.dbfname, m.aliasname PRIVATE m.numfiles * First check for a zero-byte DKCONTRL file, which can be left hanging around * if a previous run of COMPRESS failed. m.numfiles = ADIR(rtdir,m.dbfname) IF m.numfiles = 1 AND rtdir[1,2] = 0 DELETE FILE (m.dbfname) IF FILE(forceext(m.dbfname,"CDX")) DELETE FILE (forceext(m.dbfname,"CDX")) ENDIF ENDIF * Create the control database if it doesn't already exist. Open it. Return the * name of the database and the alias, which was passed in by reference. IF !FILE(m.dbfname) OR !FILE(forceext(m.dbfname,"CDX")) DO createctrl WITH m.dbfname m.g_newctrl = .T. ELSE m.g_newctrl = .F. ENDIF m.dbfstem = juststem(m.dbfname) IF USED(m.dbfstem) SELECT (m.dbfstem) ELSE SELECT 0 USE (m.dbfname) AGAIN EXCLUSIVE ENDIF IF TYPE("uniqueid") = "U" DO errormsg WITH error_array[en_oldver],c_fatal RETURN TO dksetup ENDIF IF EMPTY(TAG(1)) AND FILE(forceext(m.dbfname,"CDX")) SET INDEX TO (forceext(m.dbfname,"CDX")) REINDEX ENDIF SET ORDER TO TAG fname m.aliasname = ALIAS() RETURN m.dbfname *!***************************************************************************** *! *! Procedure: GATHERDIR *! *!***************************************************************************** PROCEDURE gatherdir * Read the application tree and record all the files in it. PRIVATE m.numeslfiles, m.eslaction SET MESSAGE TO s_filling SELECT (m.g_dbalias) REPLACE ALL filfound WITH .F. && nothing found yet * These get installed later DELETE ALL FOR extrafile AND !(UPPER(justfname(fname)) == UPPER(justfname(m.g_esl))) PACK * Filldir is a recursive function that puts the files in g_sourcedir and all * its subdirectories into the dkcontrl database. DO filldir WITH addbs(m.g_sourcedir)+"*.*",m.dkcname,"",m.g_dbalias SELECT (m.g_dbalias) GOTO TOP * Verify that the application EXE file was in there somewhere LOCATE FOR UPPER(ALLTRIM(justfname(fname))) == UPPER(ALLTRIM(justfname(m.g_appname))) IF !FOUND() DO errormsg WITH error_array[en_exem1],c_fatal RETURN TO dksetup ENDIF DO instesl *!***************************************************************************** *! *! Procedure: FILLDIR *! *!***************************************************************************** PROCEDURE filldir * * Note: Recursive procedure! * * Find file names in the specified directory and all subdirectories beneath it. Put * the filenames in dbfname. Preface is the path to get to the files in the * directory we are searching. * * Dbalias is the alias of the DBCONTRL file. * PARAMETER m.dirmask, m.dbfname, m.preface, m.dbalias, m.prevthere PRIVATE ALL m.in_defa = SET("DEFAULT")+CURDIR() && both drive and directory name * Get actual filenames (no directories) in this directory m.numfiles = ADIR(dirlist,m.dirmask) FOR m.i = 1 TO m.numfiles * First make sure that this file isn't on the list of files we won't install. Such * files include portions of the FoxPro system that are not licensed to be distributed, * miscellaneous files that the SetupWizard puts into the application tree (e.g., * the DKCONTRL files, etc. SELECT naughty SET ORDER TO TAG filname SEEK ALLTRIM(UPPER(justfname(dirlist[m.i,1]))) IF !FOUND() && not a prohibited file SELECT (m.dbalias) SET ORDER TO TAG fname m.srchterm = addbs(m.preface) + dirlist[m.i,1] LOCATE FOR ALLTRIM(UPPER(fname)) == ALLTRIM(UPPER(m.srchterm)) AND EMPTY(parent) ; AND !DELETED() IF !FOUND() APPEND BLANK m.prevthere = .F. ELSE m.prevthere = .T. ENDIF REPLACE fname WITH addbs(m.preface) + dirlist[m.i,1], ; filsize WITH dirlist[m.i,2],; fdate WITH dirlist[m.i,3],; ftime WITH dirlist[m.i,4],; fattrib WITH dirlist[m.i,5] IF !m.prevthere REPLACE expndsize WITH filsize REPLACE parent WITH "" REPLACE splitfile WITH .F. && assume no split for new file REPLACE uniqueid WITH SYS(3) ENDIF REPLACE COMPRESS WITH .T. && all application files are candidates for compression REPLACE filfound WITH .T. REPLACE extrafile WITH .F. REPLACE setupfile WITH .F. && not a required file ENDIF SELECT (m.dbalias) ENDFOR * Next, get all my child subdirectories. This program structure keeps us from * having too many big arrays hanging around on the stack as we recurse. SET DEFAULT TO (justpath(m.dirmask)) m.numfiles = ADIR(dirlist,"","D") FOR m.i = 1 TO m.numfiles IF !INLIST(dirlist[m.i,1], ".","..") * recursive call! DO filldir WITH addbs(justpath(m.dirmask))+ dirlist[m.i,1]+"\*.*", ; m.dbfname, addbs(m.preface) + dirlist[m.i,1], m.dbalias ENDIF ENDFOR SET DEFAULT TO &in_defa *!***************************************************************************** *! *! Procedure: INSTESL *! *!***************************************************************************** PROCEDURE instesl PRIVATE m.numfiles, m.eslaction, m.cprscount, m.esldir, m.cprsdir, m.origsize * Find the ESL file SELECT (m.g_dbalias) GOTO TOP LOCATE FOR UPPER(ALLTRIM(justfname(fname))) == UPPER(ALLTRIM(justfname(m.g_esl))); AND !DELETED() AND EMPTY(parent) IF FOUND() m.g_esl = TRIM(fname) m.numfiles = ADIR(esldir,IIF(extrafile,TRIM(fname),addbs(m.g_sourcedir)+TRIM(fname))) m.g_eslextra = extrafile IF m.numfiles > 0 REPLACE filfound WITH .T. * ESL file was in the DKCONTRL file and the original file exists. Are we updating it? m.origsize = filsize REPLACE filsize WITH esldir[1,2], ; fdate WITH esldir[1,3], ; ftime WITH esldir[1,4], ; fattrib WITH esldir[1,5] m.cprscount = ADIR(cprsdir, addbs(m.g_cprsdir)+TRIM(cprsname)) IF m.cprscount > 0 IF (fdate > cprsdir[1,3]) OR (fdate = cprsdir[1,3] AND ftime > cprsdir[1,4]) ; OR (filsize <> m.origsize) * Delete earlier split pieces if we are updating the esl file DO zapfrag WITH justfname(fname), justext(cprsname), .F. ENDIF ENDIF ELSE REPLACE filfound WITH .F. ENDIF ELSE m.eslaction = 1 DO noesl.spr WITH m.eslaction, c_eslfile DO CASE CASE m.eslaction = 1 * Find it. m.g_esl = GETFILE("ESL","ESL File","OK") IF !EMPTY(m.g_esl) m.numeslfiles = ADIR(esldir,m.g_esl) IF m.numeslfiles > 0 APPEND BLANK REPLACE fname WITH m.g_esl REPLACE filsize WITH esldir[1,2] REPLACE fdate WITH esldir[1,3] REPLACE ftime WITH esldir[1,4] REPLACE fattrib WITH esldir[1,5] REPLACE expndsize WITH filsize REPLACE parent WITH "" REPLACE splitfile WITH .F. REPLACE COMPRESS WITH .T. && all application files are candidates for compression REPLACE cprsflag WITH .T. REPLACE filfound WITH .T. REPLACE extrafile WITH .T. && not in application tree REPLACE setupfile WITH .F. && not a required file REPLACE uniqueID WITH SYS(3) m.g_eslextra = .T. * Delete any occurrences of prior versions of ESL file from DKCONTRL.DBF file SET EXACT ON SCAN FOR INLIST(ALLTRIM(UPPER(justfname(fname))),UPPER(c_oldesl),UPPER(c_oldesl1)) IF FILE(addbs(m.g_cprsdir)+ALLTRIM(cprsname)) DELETE FILE (addbs(m.g_cprsdir)+ALLTRIM(cprsname)) ENDIF DELETE ENDSCAN PACK SET EXACT OFF ENDIF ELSE RETURN TO dksetup ENDIF CASE m.eslaction = 2 * Continue m.g_esl = SYS(3) && to avoid any matches CASE m.eslaction = 3 RETURN TO dksetup ENDCASE ENDIF GOTO TOP *!***************************************************************************** *! *! Procedure: GENUNIQ *! *!***************************************************************************** PROCEDURE genuniq PARAMETER m.dbfname PRIVATE m.startplace, m.thename * Generate unique names for the file names in "dbfname" SET MESSAGE TO s_compressing SELECT (m.g_dbalias) SET ORDER TO 0 * Start by assuming that all files compress to their original names, except for * SCT, FRT, etc. files that have the last two letters of their extensions reversed * so as not to collide with their SCX and FRX counterparts. Don't overwrite the * random names just yet so that we have a fighting chance of detecting whether their * source file needs to be compressed again. Don't overwrite split filenames either * since their cprsnames are already set. * Also account for the $ naming substitution that COMPRESS does. It puts a $ in the * last available position of the extension to indicate that this is a compressed file. SCAN DO CASE CASE setupfile REPLACE cprsname WITH justfname(fname) CASE splitfile * Leave the compress name alone. This was a split file. CASE !COMPRESS && file isn't compressed, so use its regular name REPLACE cprsname WITH justfname(fname) CASE EMPTY(cprsname) REPLACE cprsname WITH gencprsname(mapname(justfname(fname))) OTHERWISE REPLACE cprsname WITH gencprsname(cprsname) ENDCASE ENDSCAN * Ensure that there aren't any filename collisions among files in the application tree. SET ORDER TO TAG cprsname SCAN m.thename = ALLTRIM(cprsname) m.startplace = RECNO() SKIP * Replace any further occurrences of this compressed file name with a random name DO WHILE !EOF() AND cprsmatch(m.thename,ALLTRIM(cprsname)) REPLACE cprsname WITH gencprsname(SYS(3)+"."+c_randext) * Back to original record, since the last REPLACE moved the index position. We * are in cprsname order and substituting the SYS(3) name moved us someplace else in * the index. GOTO m.startplace SKIP ENDDO GOTO m.startplace ENDSCAN SET ORDER TO TAG fname *!***************************************************************************** *! *! Procedure: MAKEDISKS *! *!***************************************************************************** PROCEDURE makedisks PARAMETERS m.disktype, m.destination PRIVATE m.retval * Figure out what needs to be compressed and does the compression. Allocates * files to disks. Copies files to the destination directory tree. IF m.g_firstset m.destination = trimpath(m.destination) m.g_cprsdir = trimpath(m.g_cprsdir) * Simple check to handle \FOO\BAR\ when neither FOO nor BAR exists now. Only * go to two levels, however. IF !EMPTY(justpath(m.destination)) AND justpath(m.destination) <> "\" m.retval = mkdir(justpath(m.destination)) IF m.retval <> 0 AND m.retval <> 6 DO errormsg WITH error_array[en_baddir] + " " + justpath(m.destination), c_fatal RETURN TO dksetup ENDIF ENDIF m.retval = mkdir(m.destination) && silently create the destination/compress directories. IF m.retval <> 0 AND m.retval <> 6 DO errormsg WITH error_array[en_baddir] + " " + m.destination, c_fatal RETURN TO dksetup ENDIF m.retval = mkdir(m.g_cprsdir) IF m.retval <> 0 AND m.retval <> 6 DO errormsg WITH error_array[en_baddir] + " " + m.g_cprsdir, c_fatal RETURN TO dksetup ENDIF * Delete files from DKCONTRL.DBF that couldn't be found. Don't delete records * for split files, however, unless their parent file was deleted from the application * tree. Split files aren't in the app directory, but they are in the compressed directory. DO killctrl * Make and execute the batch file to compress files. DO makecprsbatch WITH m.disktype =updtherm(75) * Determine compressed file sizes and update the dkcontrl database. This procedure * also detects which files were split (if any) and records them in the dkcontrl database. DO getcprssize ENDIF * Assign compressed files to specific disks in dkcontrl DO shuffle WITH m.disktype, m.destination DO makeinf WITH m.disktype, addbs(m.g_runtimedir)+c_setupinf * Put the INF file onto disk 1 in DBCONTRL.DBF =putondisk(c_setupinf, 1,.T.,.T.,.F.,"") * Create the SETUP.LST file and put it on disk 1 DO makelst WITH addbs(m.g_runtimedir)+c_setuplst =putondisk(c_setuplst, 1,.T.,.T.,.F.,"") g_disks = 0 g_diskcount = 0 * Do it again to make sure that the INF file can fit on disk 1 DO shuffle WITH m.disktype, m.destination DO makeinf WITH m.disktype, addbs(m.g_runtimedir)+c_setupinf * Copy the files to the destination tree DO copyfiles WITH m.disktype, m.destination *!***************************************************************************** *! *! Procedure: KILLCTRL *! *!***************************************************************************** PROCEDURE killctrl PRIVATE m.numfiles, m.thisrec, m.thisid, m.therec, m.therec1, m.killfname SELECT (m.g_dbalias) SET ORDER TO 0 * Get rid of any records in the control file that don't have corresponding * files in the source tree. This would occur if the user was updating a previous * run of the SetupWizard and had deleted some of his files in the meantime. DELETE ALL FOR !filfound AND !splitfile * Delete all splitfiles that don't have a record in the compress directory already SCAN FOR splitfile m.killfname = "" DO CASE CASE EMPTY(parent) AND !filfound && this is a parent file that isn't in the app tree m.killfname = ALLTRIM(justfname(fname)) CASE !FILE(addbs(m.g_cprsdir) + TRIM(cprsname)) && child m.killfname = ALLTRIM(justfname(fname)) ENDCASE * If any of the pieces are deleted from the compress directory, delete the rest of them * now and also clean out the DKCONTRL file of all references to this file. IF !EMPTY(m.killfname) WAIT WINDOW s_cleanup + " " + m.killfname NOWAIT m.therec = RECNO() GOTO TOP * Scan through all the children SCAN FOR !EMPTY(parent) ; AND UPPER(ALLTRIM(justfname(fname))) == UPPER(ALLTRIM(m.killfname)) DELETE * Delete the compressed file, if it exists IF FILE(addbs(m.g_cprsdir) + TRIM(cprsname)) DELETE FILE (addbs(m.g_cprsdir) + TRIM(cprsname)) ENDIF ENDSCAN * Now get the parent SCAN FOR EMPTY(parent) ; AND UPPER(ALLTRIM(justfname(fname))) == UPPER(ALLTRIM(m.killfname)) * Delete the first compressed file if it exists IF FILE(addbs(m.g_cprsdir) + TRIM(cprsname)) DELETE FILE (addbs(m.g_cprsdir) + TRIM(cprsname)) ENDIF REPLACE splitfile WITH .F. IF !filfound && not in application tree either DELETE ENDIF ENDSCAN GOTO m.therec ENDIF ENDSCAN PACK =inkey(1) WAIT CLEAR *!***************************************************************************** *! *! Procedure: MAKECPRSBATCH *! *!***************************************************************************** PROCEDURE makecprsbatch PARAMETER m.dsktype PRIVATE m.in_safe, m.i, m.numcprs, m.batname, m.got_one, m.in_area, m.in_defa, m.j, ; m.nextfile, m.pos * Use MAKE logic to decide what needs to be compressed. Create a batch file * to call the compression program. SET MESSAGE TO s_batch * Assume everything needs to be compressed that can be compressed. REPLACE ALL cprsflag WITH COMPRESS * Now get a list of files that are already in the compress directory from an * earlier run of the SetupWizard. SET ORDER TO cprsname m.numcprs = ADIR(rtdir,addbs(m.g_cprsdir)+"*.*") IF m.numcprs > 0 =ASORT(rtdir) && to make sure that children always follow parents ENDIF m.i = 1 DO WHILE m.i <= m.numcprs * If the file exists already, match it with the date of the file in the application * directory. If it has the same or a later date, don't compress it again. If it * is earlier, compress it again. * * If there is a file in the compress directory that doesn't correspond to one in the * application directory, it's probably a file that the user deleted. Delete it from the * compress directory also. SEEK UPPER(ALLTRIM(rtdir[m.i,1])) DO CASE CASE FOUND() && it's one we want to include and it's already there. DO CASE CASE (rtdir[m.i,3] > fdate OR (rtdir[m.i,3] = fdate AND rtdir[m.i,4] >= TRIM(ftime))) ; AND rtdir[m.i,2] > 0 * The compressed file is current. No need to compress it again. Also, it isn't a * zero byte file, possibly left over from a previous failed COMPRESS. REPLACE cprsflag WITH .F. REPLACE cprssize WITH rtdir[m.i,2] CASE splitfile * The file exists in the compress directory and in DKCONTRL. The compress directory * one is older. Delete it and its relations now so that the user doesn't get a * confusing question from COMRPESS.EXE about overwriting the file. DO zapfrag WITH justfname(fname), justext(cprsname), .F. REPLACE cprsflag WITH .T., compress WITH .T. * Refresh the directory list now that some files have been deleted * Find the next file to be scanned. Skip deleted files, which are probably * children of the one we started with that have recently been zapped. m.pos = m.i + 1 DO WHILE m.pos <= m.numcprs AND !FILE(addbs(m.g_cprsdir)+rtdir[m.pos,1]) m.pos = m.pos + 1 ENDDO IF m.pos > m.numcprs m.nextfile = "" ELSE m.nextfile = rtdir[m.pos,1] ENDIF * Get the revised directory m.numcprs = ADIR(rtdir,addbs(m.g_cprsdir)+"*.*") IF m.numcprs > 0 =ASORT(rtdir) && to make sure that children always follow parents ENDIF m.i = m.i - 1 && default position of next file to scan IF !EMPTY(m.nextfile) * Find the next file in the new, revised array FOR m.j = 1 TO m.numcprs IF rtdir[m.j,1] == m.nextfile m.i = m.j - 1 EXIT ENDIF ENDFOR ENDIF OTHERWISE * The file exists in the compress directory and in DKCONTRL. The compress directory * one is older. Delete it now so that the user doesn't get a confusing question from * COMRPESS.EXE about overwriting the file. DELETE FILE (addbs(m.g_cprsdir)+TRIM(cprsname)) REPLACE cprsflag WITH .T., compress WITH .T. ENDCASE CASE !m.g_newctrl * The file is there, but not in the DKCONTRL database (which we didn't just create). * Is it a split file? m.stem = juststem(rtdir[m.i,1]) IF ISDIGIT(RIGHT(m.stem,1)) * Can we find a plausable parent? SEEK CHRTRAN(m.stem,"0123456789","") IF FOUND() AND justext(cprsname) == justext(rtdir[m.i,1]) * It appears to be a split file. Leave it here. REPLACE cprsflag WITH .F. && don't compress a split file again ELSE DELETE FILE (addbs(m.g_cprsdir) + rtdir[m.i,1]) ENDIF ELSE DELETE FILE (addbs(m.g_cprsdir) + rtdir[m.i,1]) ENDIF OTHERWISE DELETE FILE (addbs(m.g_cprsdir) + rtdir[m.i,1]) ENDCASE m.i = m.i + 1 ENDDO m.in_defa = SET("DEFAULT") + CURDIR() SET DEFAULT TO (m.g_runtimedir) * Find the COMPRESS.EXE file. DO CASE CASE FILE("COMPRESS.EXE") m.cprsexe = "COMPRESS" && no need for path information. CASE FILE(addbs(m.g_runtimedir)+"COMPRESS.EXE") m.cprsexe = addbs(m.g_runtimedir)+"COMPRESS.EXE" CASE FILE(FULLPATH("COMPRESS.EXE",1)) && search DOS path m.cprsexe = "COMPRESS" && no need for path information. CASE FILE(SYS(2004)+"DKSETUP\COMPRESS.EXE") m.cprsexe = SYS(2004)+"DKSETUP\COMPRESS" OTHERWISE m.cprsexe = GETFILE("EXE","COMPRESS.EXE") IF EMPTY(m.cprsexe) DO errormsg WITH error_array[en_nocompress], c_fatal RETURN TO dksetup ENDIF ENDCASE * Create a compression batch file in the current directory. The file name must match the * one that the PIF file is expecting. m.batname = "SETUPWIZ.BAT" m.in_safe = SET("SAFETY") SET SAFETY OFF COPY FILE setup.pif TO setupbat.pif SET TEXTMERGE TO (m.batname) SET TEXTMERGE ON SET CONSOLE OFF SET DECIMALS TO 0 && don't add extra 0's to file size, etc. m.got_one = .F. && nothing to compress yet SCAN FOR cprsflag AND COMPRESS m.got_one = .T. * Make sure line will fit in 128-byte DOS command line IF LEN(m.cprsexe+addbs(m.g_sourcedir)+TRIM(fname)+addbs(m.g_cprsdir)+TRIM(cprsname))+17 > 128 SET TEXTMERGE OFF SET TEXTMERGE TO SET CONSOLE ON IF FILE(m.batname) DELETE FILE (m.batname) ENDIF DELETE FILE setupbat.pif DO errormsg WITH error_array[en_toolong],c_fatal RETURN TO dksetup ENDIF IF extrafile * These are files such as the Graph runtime that aren't stored in the application * tree. Fname contains a complete path specification. \\<<m.cprsexe>> -a<<m.g_algorithm>> -befl -z<<INT(m.g_splitsize/512)>> \\ <<TRIM(fname)>> \\ <<addbs(m.g_cprsdir)+TRIM(cprsname)>> \ ELSE * Regular application file. Fname contains a path relative to the g_sourcedir * directory. The "710" here determines the size of the chunks that COMPRESS will * split a file into and is not directly related to the cluster size of any specific * disk we are creating. It's the max number of 512-byte blocks that the output file * will contain before being split. (710 x 512 = 363,520: two chunks will fit on a * 720K disk, 3 on a 1.2 meg and 4 on a 1.44meg floppy.) \\<<m.cprsexe>> -a<<m.g_algorithm>> -befl -z<<INT(m.g_splitsize/512)>> \\ <<addbs(m.g_sourcedir)+TRIM(fname)>> \\ <<addbs(m.g_cprsdir)+TRIM(cprsname)>> \ ENDIF ENDSCAN SET DECIMALS TO &mdecimals SET CONSOLE ON SET TEXTMERGE OFF SET TEXTMERGE TO IF m.got_one m.choice = idyes * Remove the following comment to prompt before beginning compress operation * m.choice = msgbox("Ready to compress files. Start now?","SetupWizard",35) DO CASE CASE m.choice = idyes SET MESSAGE TO s_cprs RUN setupbat.pif CASE m.choice = idcancel RETURN TO dksetup ENDCASE ENDIF * See if any files were split. If so, continue splitting them until they fit. DO filsplit DELETE FILE (m.batname) DELETE FILE setupbat.pif SET SAFETY &in_safe SET DEFAULT TO &in_defa RETURN *!***************************************************************************** *! *! Procedure: FILSPLIT *! *!***************************************************************************** PROCEDURE filsplit PRIVATE m.done, m.i, m.j, m.fnum, m.stem, m.ext, m.nextnum, m.parentrec, ; m.prevrec, m.prevname, m.nextname, m.batname, m.srch, m.prevnum, m.done * See if any files were split. If so, add the new split file to the DKCONTRL database, * and compress it. Keep going until no new split files appear, which means that we've * compressed everything down as far as it will go. m.batname = "SETUPWIZ.BAT" m.in_safe = SET("SAFETY") SET SAFETY OFF COPY FILE setup.pif TO setupbat.pif * Do while more split files turn up in the compressed directory m.done = .F. DO WHILE !m.done m.done = .T. && assume no more files to split/compress m.numfiles = ADIR(rtdir,addbs(m.g_cprsdir)+"*.*") IF m.numfiles > 0 =ASORT(rtdir,1) ENDIF FOR m.i = 1 TO m.numfiles SELECT (m.g_dbalias) SET ORDER TO TAG cprsname SEEK rtdir[m.i,1] IF !FOUND() * see if it looks like a newly-created split file m.stem = juststem(rtdir[m.i,1]) IF ISDIGIT(RIGHT(m.stem,1)) m.fnum = getfnum(m.stem) * Can we find a plausable parent? DO CASE CASE m.fnum = 1 * Look for stemname ending in 0 LOCATE FOR LEFT(juststem(cprsname),LEN(m.stem)-1) == LEFT(m.stem,LEN(m.stem)-1) ; AND RIGHT(juststem(cprsname),1) = "0" ; AND justext(cprsname) == justext(rtdir[m.i,1]) CASE m.fnum = 2 * Look for stemname ending in 1 LOCATE FOR LEFT(juststem(cprsname),LEN(m.stem)-1) == LEFT(m.stem,LEN(m.stem)-1) ; AND (RIGHT(juststem(cprsname),1) == "1") ; AND justext(cprsname) == justext(rtdir[m.i,1]) IF !FOUND() DO CASE CASE LEN(juststem(m.stem)) = 8 * Look for stemname ending in non-digit LOCATE FOR LEN(juststem(cprsname)) >= 7 ; AND LEFT(juststem(cprsname),7) == LEFT(m.stem,7) ; AND !ISDIGIT(RIGHT(juststem(cprsname),1)) ; AND justext(cprsname) == justext(rtdir[m.i,1]) OTHERWISE * Look for stemname ending in blank LOCATE FOR LEFT(juststem(cprsname),LEN(m.stem)-1); == LEFT(m.stem,LEN(m.stem)-1) ; AND justext(cprsname) == justext(rtdir[m.i,1]) ENDCASE ENDIF OTHERWISE m.prevnum = ALLTRIM(STR(fnum - 1,4)) m.srch = LEFT(m.stem,LEN(m.stem)-LEN(m.prevnum))+m.prevnum LOCATE FOR LEFT(juststem(cprsname),LEN(m.srch)) == m.srch ; AND justext(cprsname) == justext(rtdir[m.i,1]) ENDCASE IF FOUND() * Found the previous file m.done = .F. m.parentrec = IIF(EMPTY(parent),uniqueid,parent) m.prevrec = RECNO() m.prevname = fname * Make a new record for this new file APPEND BLANK m.childrec = RECNO() REPLACE fname WITH m.prevname, ; filsize WITH rtdir[m.i,2],; fdate WITH rtdir[m.i,3],; ftime WITH rtdir[m.i,4],; fattrib WITH rtdir[m.i,5] REPLACE cprsname WITH rtdir[m.i,1] REPLACE cprssize WITH rtdir[m.i,2] REPLACE expndsize WITH filsize && subject to revision REPLACE COMPRESS WITH .T. && all application files are candidates for compression REPLACE filfound WITH .T. REPLACE extrafile WITH IIF(justfname(fname)==justfname(m.g_esl); AND m.g_eslextra,.T.,.F.) REPLACE setupfile WITH .F. && not a required file REPLACE parent WITH m.parentrec REPLACE uniqueID WITH SYS(3) REPLACE splitfile WITH .T. * If we just created file 9 and it is exactly the same size as the maximum * file, then report that we couldn't split this file into enough pieces. IF getfnum(cprsname) = 9 AND cprssize = m.g_splitsize DO errormsg WITH error_array[en_cprserr]+justfname(fname); +c_crlf+error_array[en_toobig], e_fatal RETURN TO dksetup ENDIF * Record the uncompressed size of the last chunk GOTO m.prevrec IF rtdir[m.i,2] >= filsize && detect previous unsuccessful splits DO zapfrag WITH justfname(fname), justext(cprsname), .T. RETURN TO dksetup ENDIF REPLACE expndsize WITH filsize - rtdir[m.i,2] REPLACE splitfile WITH .T. GOTO m.childrec IF rtdir[m.i,2] > m.g_splitsize * Compress the new one. m.batname = "SETUPWIZ.BAT" COPY FILE setup.pif TO setupbat.pif SET TEXTMERGE TO (m.batname) SET TEXTMERGE ON SET CONSOLE OFF IF LEN(s_splitting+" "+TRIM(fname)+" "+s_again) <= 60 WAIT WINDOW s_splitting+" "+TRIM(fname)+" "+s_again NOWAIT ELSE WAIT WINDOW s_splitting+" "+TRIM(justfname(fname))+" "+s_again NOWAIT ENDIF * Rename the fragment to be the original file name, but in the * compressed directory. IF FILE(addbs(m.g_cprsdir)+justfname(fname)) DELETE FILE (addbs(m.g_cprsdir)+justfname(fname)) ENDIF * Rename the excess file back to the original name RENAME (addbs(m.g_cprsdir))+rtdir[m.i,1] TO (addbs(m.g_cprsdir)+justfname(fname)) m.stem = juststem(rtdir[m.i,1]) m.ext = justext(rtdir[m.i,1]) m.fnum = getfnum(m.stem) m.nextnum = ALLTRIM(STR(m.fnum+1,4)) m.nextname = LEFT(m.stem,LEN(m.stem) - LEN(m.nextnum)) + m.nextnum + "." + m.ext \\<<m.cprsexe>> -a<<m.g_algorithm>> -befl -z<<INT(m.g_splitsize / 512)>> \\ <<addbs(m.g_cprsdir)+justfname(fname)>> \\ <<addbs(m.g_cprsdir)+rtdir[m.i,1]>> \ SET TEXTMERGE OFF SET TEXTMERGE TO SET CONSOLE ON RUN setupbat.pif DELETE FILE (m.batname) DELETE FILE setupbat.pif * Delete the previous excess file IF FILE(addbs(m.g_cprsdir)+justfname(fname)) DELETE FILE (addbs(m.g_cprsdir)+justfname(fname)) ENDIF IF !FILE(addbs(m.g_cprsdir)+rtdir[m.i,1]) * Compression was interrupted. Clean up as best we can. DO errormsg WITH error_array[en_cprsdead], c_fatal * Get rid of the DKCONTRL entries and the compressed files m.thename = justfname(fname) SCAN FOR justfname(fname) == m.thename IF FILE(addbs(m.g_cprsdir) + cprsname) DELETE FILE (addbs(m.g_cprsdir) + cprsname) ENDIF DELETE ENDSCAN PACK RETURN TO dksetup ENDIF SET SAFETY &in_safe ENDIF ENDIF ENDIF ENDIF ENDFOR ENDDO WAIT CLEAR * Detect previous unsuccessful runs. This is a second level check. Theoretically, * all errors like this should have been caught in killctrl where we match the compress * directory files up against the DKCONTRL entries. SCAN FOR expndsize <= 0 AND splitfile DO zapfrag WITH justfname(fname), justext(cprsname), .T. RETURN TO dksetup ENDSCAN *!***************************************************************************** *! *! Function: GETFNUM *! *!***************************************************************************** FUNCTION getfnum PARAMETER m.filname PRIVATE ALL RETURN VAL(RIGHT(juststem(m.filname),1)) *!***************************************************************************** *! *! Procedure: GETCPRSSIZE *! *!***************************************************************************** PROCEDURE getcprssize * This routine figures out the compressed file sizes of all the files in DKCONTRL.DBF. PRIVATE m.i, m.numcprs, m.thestem, m.parentname, m.parentrec, m.thisrec, m.in_msg, ; m.parentstem SET MESSAGE TO s_cprssize SELECT (m.g_dbalias) SET ORDER TO TAG cprsname * Get the size of compressed files in the g_cprsdir directory m.numcprs = ADIR(rtdir,addbs(m.g_cprsdir)+"*.*") FOR m.i = 1 TO m.numcprs SEEK UPPER(ALLTRIM(rtdir[m.i,1])) IF FOUND() && it's one we want to include and it's already there. REPLACE cprssize WITH rtdir[m.i,2] ENDIF ENDFOR * Show that files that aren't compressed have the same "compressed" size as the * uncompressed size. SET ORDER TO 0 REPLACE ALL cprssize WITH filsize FOR !COMPRESS AND !splitfile *!***************************************************************************** *! *! Procedure: SHUFFLE *! *!***************************************************************************** PROCEDURE shuffle PARAMETER m.disktype, m.rootdir * Assign the files to specific disks. This routine uses the following * algorithm to decide which disks to put the files on. It starts by * allocating the setup files to the first disk. SETUP.EXE requires most of * its files to be on disk1. Next, it allocates the largest file to the * first disk. Then it takes the second largest file and puts it on the first * disk it will fit on, and so forth. There are other restrictions also. * The number of files that can fit in the root directory is limited ' * (224 for 1.44 meg disks, for example). Also, if a file has been split, * all the pieces must appear successively. SPLIT2 can't be on a disk before * split1. They don't have to be consecutive (i.e., SPLIT1 could be * on disk2 and SPLIT2 could be on disk4).This alorithm will sometimes not * result in the tightest packing, but it will usually produce good results. PRIVATE m.cluster, m.totsize, m.dirname, m.maxfilenum SELECT DISKS SEEK m.disktype IF FOUND() m.cluster = DISKS->clustsize && cluster size for this type of disk m.totsize = DISKS->disksize && max bytes on this disk m.dirname = DISKS->dname && name of disk type (e.g., 1.44 megabyte disks) m.maxfilenum = DISKS->maxfiles && max files in root directory of this type disk SELECT (m.g_dbalias) REPLACE ALL (DISKS->diskfld) WITH 0 ELSE WAIT WINDOW "Invalid disk type specified." NOWAIT && shouldn't be possible RETURN TO dksetup ENDIF SELECT (m.g_dbalias) * Put the setup files on first SCAN FOR setupfile DO diskassgn WITH m.disktype, m.cluster, m.totsize, m.maxfilenum, m.dirname, splitfile ENDSCAN * Now allocate the remaining ordinary files to disks, making new disks as necessary SELECT (m.g_dbalias) SET ORDER TO TAG cprssize && descending order by cprssize SCAN FOR !setupfile AND !splitfile DO diskassgn WITH m.disktype, m.cluster, m.totsize, m.maxfilenum, m.dirname, splitfile ENDSCAN * Finally, allocate the split files to disk in the split order (i.e., split2 comes before * split3) SCAN FOR splitfile DO diskassgn WITH m.disktype, m.cluster, m.totsize, m.maxfilenum, m.dirname, splitfile ENDSCAN *!***************************************************************************** *! *! Procedure: DISKASSGN *! *!***************************************************************************** PROCEDURE diskassgn PARAMETERS m.disktype, m.cluster, m.totsize, m.maxfilenum, m.dirname, m.split * Take the current record in the dkcontrl file and assign it to a disk PRIVATE m.numdisks, m.asize, m.dnum SET MESSAGE TO s_assign + " " + s_to + " " +DISKS->dname m.asize = allocsize(cprssize, m.cluster) IF !m.split m.dnum = 1 * Check for available space on each disk, but don't put more files onto the disk than * can fit in the root directory for this disk type (e.g., 224 for 1.44/1.2 meg, 112 for 720K) DO WHILE m.dnum <= m.g_diskcount ; AND ( (m.totsize - g_disks[m.dnum,3] < m.asize) ; OR (g_disks[m.dnum,1] >= m.maxfilenum) ) m.dnum = m.dnum + 1 ENDDO * If there isn't any room on any of the existing disks, make a new disk IF m.dnum > m.g_diskcount m.g_diskcount = m.g_diskcount + 1 DIMENSION g_disks[m.g_diskcount,c_diskcols] g_disks[m.g_diskcount,1] = 1 g_disks[m.g_diskcount,2] = cprssize g_disks[m.g_diskcount,3] = m.asize ELSE g_disks[m.dnum,1] = g_disks[m.dnum,1] + 1 g_disks[m.dnum,2] = g_disks[m.dnum,2] + cprssize g_disks[m.dnum,3] = g_disks[m.dnum,3] + m.asize ENDIF ELSE * Split files have to appear in successive order (SPLIT2 can't show up before SPLIT1). * If there is room, put on the last disk. Otherwise make a new one. IF g_disks[m.g_diskcount,1] < m.maxfilenum ; AND m.totsize - g_disks[m.g_diskcount,3] >= m.asize * There is room for this file on the last disk g_disks[m.g_diskcount,1] = g_disks[m.g_diskcount,1] + 1 g_disks[m.g_diskcount,2] = g_disks[m.g_diskcount,2] + cprssize g_disks[m.g_diskcount,3] = g_disks[m.g_diskcount,3] + m.asize ELSE m.g_diskcount = m.g_diskcount + 1 DIMENSION g_disks[m.g_diskcount,c_diskcols] g_disks[m.g_diskcount,1] = 1 g_disks[m.g_diskcount,2] = cprssize g_disks[m.g_diskcount,3] = m.asize ENDIF m.dnum = m.g_diskcount ENDIF SELECT DISKS SEEK m.disktype IF FOUND() SELECT (m.g_dbalias) REPLACE (DISKS->diskfld) WITH m.dnum ENDIF SELECT (m.g_dbalias) *!***************************************************************************** *! *! Procedure: REQFILES *! *!***************************************************************************** PROCEDURE reqfiles * Put the files in the REQUIRED.DBF list onto the disks, starting with disk1. * These files may be compressed, but if so, then the ones in the g_runtimedir * have already been compressed, so I don't have to worry about the ultimate file * size on the install disks differing from their size in the g_runtimedir * directory. PRIVATE m.in_dir, m.thefile, m.gotit, m.i SET MESSAGE TO s_required * Find the files in the runtime directory. It's possible that there could * be files here that we don't want to install, so we can't just copy the filename * information into the dkcontrl file without further checking against the REQUIRED.DBF * file, stored inside the app. m.numfiles = ADIR(rtdir,addbs(m.g_runtimedir)+"*.*") IF m.numfiles = 0 DO errormsg WITH error_array[en_nortfiles], c_fatal RETURN TO dksetup ENDIF SELECT (m.g_dbalias) SET ORDER TO TAG fname SELECT required SCAN m.gotit = .F. * Find the directory information for this file FOR m.i = 1 TO m.numfiles IF ALLTRIM(UPPER(rtdir[m.i,1])) == ALLTRIM(UPPER(required->reqname)) * At this point, we have a match between a file we need and a file we found * in the g_runtimedir directory. Add a record for this file to the dkcontrl * file. SELECT (m.g_dbalias) SEEK UPPER(rtdir[m.i,1]) && seek the file name DO CASE CASE !FOUND() APPEND BLANK CASE DELETED() RECALL ENDCASE REPLACE fname WITH rtdir[m.i,1], ; filsize WITH rtdir[m.i,2], ; fdate WITH rtdir[m.i,3], ; ftime WITH rtdir[m.i,4], ; fattrib WITH rtdir[m.i,5] REPLACE expndsize WITH filsize REPLACE cprsname WITH fname && not compressed, so no different name REPLACE COMPRESS WITH .F. && required files are never compressed REPLACE filfound WITH .T. && we did find it REPLACE extrafile WITH .T. && not relative to application tree REPLACE setupfile WITH .T. && this is a required file REPLACE parent WITH "" && assume no split REPLACE splitfile WITH .F. REPLACE uniqueid WITH SYS(3) m.gotit = .T. EXIT && from the FOR loop ENDIF ENDFOR IF !m.gotit * This shouldn't be possible since any missing files should have been detected * when the runtime directory was specified. DO errormsg WITH TRIM(required->reqname) + " " + error_array[en_notfound], c_fatal ENDIF SELECT required ENDSCAN SELECT (m.g_dbalias) RETURN *!***************************************************************************** *! *! Procedure: FPINST *! *!***************************************************************************** PROCEDURE fpinst PRIVATE m.targ, m.in_area * Install FOXPRINT font if all associated files are in the runtime directory m.in_area = SELECT() SELECT 0 USE foxprint SCAN DO CASE CASE foxprint->reldir = 0 && full path specified m.targ = foxprint->fname CASE foxprint->reldir = 1 && relative to FoxPro dir m.targ = SYS(2004) + foxprint->fname CASE foxprint->reldir = 2 && relative to runtime dir m.targ = addbs(m.g_runtimedir) + foxprint->fname ENDCASE IF !FILE(m.targ) m.g_foxprint = .F. ENDIF ENDSCAN USE SELECT (m.in_area) IF m.g_foxprint DO instfromdbf WITH "foxprint.dbf" ENDIF *!***************************************************************************** *! *! Procedure: OPTINST *! *!***************************************************************************** PROCEDURE optinst * Install any optional components the user choses. Each optional component needs * to have its own DBF in the SETUP.APP file to list which files are associated with * it. IF m.g_instgraph DO instfromdbf WITH "msgraph.dbf" ENDIF *!***************************************************************************** *! *! Procedure: INSTFROMDBF *! *!***************************************************************************** PROCEDURE instfromdbf PARAMETER m.optfname * Put the files in the optfname list onto the disks. PRIVATE m.in_area, m.thefile, m.gotit, m.i, m.grphpath, m.numfiles, m.srchname, m.in_dir m.in_area = SELECT() SELECT 0 USE (m.optfname) ALIAS optfname EXCLUSIVE AGAIN SCAN DO CASE CASE reldir = 0 && file path is full path m.srchname = UPPER(TRIM(optfname->fname)) IF !FILE(m.srchname) DO CASE CASE FILE(FULLPATH(m.srchname,1)) && search the DOS PATH for this file m.srchname = FULLPATH(m.srchname,1) CASE FILE(FULLPATH(m.srchname)) && search the FoxPro PATH for this file m.srchname = FULLPATH(m.srchname) OTHERWISE * Just leave it alone and display a GETFILE dialog below ENDCASE ENDIF CASE reldir = 1 && relative to FoxPro directory m.srchname = UPPER(SYS(2004) + TRIM(optfname->fname)) CASE reldir = 2 && Relative to runtime files directory m.srchname = addbs(m.g_runtimedir) + TRIM(optfname->fname) ENDCASE m.optpath = justpath(m.srchname) * Find the files. m.numfiles = ADIR(rtdir,m.srchname) IF m.numfiles = 0 && one of the files couldn't be found. Give option to locate it. DIMENSION rtdir[1,1] IF errormsg(justfname(TRIM(optfname->fname))+" "+error_array[en_notfound]+c_crlf; +error_array[en_getfile], c_entry2) == idyes rtdir[1,1] = GETFILE("","Find "+TRIM(optfname->fname)) IF EMPTY(rtdir[1,1]) && user pressed cancel in GETFILE() WAIT WINDOW s_canceling NOWAIT RETURN TO dksetup ELSE * Get the rest of the file specifications (e.g., size) m.optpath = justpath(rtdir[1,1]) m.numfiles = ADIR(rtdir,rtdir[1,1]) ENDIF ELSE WAIT WINDOW s_canceling NOWAIT RETURN TO dksetup ENDIF ENDIF SELECT (m.g_dbalias) SET ORDER TO TAG fname SEEK UPPER(rtdir[1,1]) DO CASE CASE !FOUND() APPEND BLANK CASE DELETED() RECALL ENDCASE REPLACE fname WITH addbs(m.optpath)+rtdir[1,1], ; filsize WITH rtdir[1,2], ; fdate WITH rtdir[1,3], ; ftime WITH rtdir[1,4], ; fattrib WITH rtdir[1,5], ; cprsname WITH justfname(rtdir[1,1]) REPLACE expndsize WITH optfname->expndsize REPLACE cprssize WITH optfname->cprssize REPLACE filfound WITH .T. && here it is REPLACE extrafile WITH .T. && not relative to application tree REPLACE setupfile WITH .F. && not a file required by setup REPLACE COMPRESS WITH optfname->COMPRESS && may or may not be compressable REPLACE parent WITH "" && assume no split REPLACE splitfile WITH .F. REPLACE uniqueid WITH SYS(3) ENDSCAN SELECT optfname USE SELECT (m.in_area) RETURN *!***************************************************************************** *! *! Procedure: EXECUTINST *! *!***************************************************************************** PROCEDURE executinst PRIVATE m.numfiles, m.cpname, m.therec, m.spath * Install file to be executed upon completion of setup. IF !EMPTY(m.g_executable) AND FILE(wordnum(m.g_executable,1)) * Look up file size, etc. m.numfiles = ADIR(rtdir,wordnum(m.g_executable,1)) IF m.numfiles > 0 && it should be SELECT (m.g_dbalias) * See if the file is in the application tree already m.spath = addbs(m.g_sourcedir) LOCATE FOR m.spath == addbs(LEFT(justpath(wordnum(m.g_executable,1)),LEN(m.spath))) ; AND justfname(fname) == justfname(wordnum(m.g_executable,1)) IF !FOUND() APPEND BLANK REPLACE fname WITH wordnum(m.g_executable,1) ; filsize WITH rtdir[1,2], ; fdate WITH rtdir[1,3], ; ftime WITH rtdir[1,4], ; fattrib WITH rtdir[1,5] REPLACE expndsize WITH filsize REPLACE filfound WITH .T. && here it is REPLACE extrafile WITH .T. && not relative to application tree REPLACE setupfile WITH .F. && not a file required by setup REPLACE COMPRESS WITH .T. && is compressable REPLACE parent WITH "" && not split yet. REPLACE splitfile WITH .F. REPLACE uniqueID WITH SYS(3) * Ensure there isn't a compressed name collision m.therec = RECNO() m.cpname = gencprsname(rtdir[1,1]) IF !israndom(cprsname) GOTO TOP LOCATE FOR UPPER(TRIM(cprsname)) == UPPER(m.cpname) ; AND UPPER(ALLTRIM(fname)) <> UPPER(ALLTRIM(wordnum(m.g_executable,1))) IF FOUND() && collision GOTO m.therec REPLACE cprsname WITH gencprsname(SYS(3)+"."+c_randext) ELSE GOTO m.therec REPLACE cprsname WITH m.cpname ENDIF ENDIF ENDIF ENDIF ENDIF *!***************************************************************************** *! *! Procedure: COPYFILES *! *!***************************************************************************** PROCEDURE copyfiles * Copy files from the compress directory to the correct branch on the destination * tree for the disk type selected. PARAMETER m.disktype, m.destination PRIVATE m.child, m.leafnum, m.leaf, m.outdir, m.batname, m.i, m.fldname SELECT DISKS SEEK m.disktype IF FOUND() m.child = DISKS->diskdir m.fldname = TRIM(DISKS->diskfld) SELECT (m.g_dbalias) CALCULATE MAX(&fldname) TO m.lastdisk ELSE WAIT WINDOW "Invalid disk type specified" NOWAIT && shouldn't happen RETURN TO dksetup ENDIF SELECT (m.g_dbalias) SET ORDER TO TAG fname SET MESSAGE TO s_mkdir * Remove any existing DISK144/DISK12/DISK720 directory DO zapdir WITH addbs(m.destination)+m.child, m.error_array * Recreate the DISK144/DISK12/DISK720 directory =mkdir(addbs(m.destination)+m.child) * Make the disk1...diskn directories FOR m.i = 1 TO INT(m.lastdisk) =mkdir(addbs(m.destination)+addbs(m.child)+"DISK"+ALLTRIM(STR(m.i,4))) ENDFOR SET ORDER TO TAG &fldname SCAN FOR !EMPTY(cprsname) m.leafnum = &fldname m.leaf = ALLTRIM(STR(m.leafnum,4)) * Construct the name of the eventual output directory SET MESSAGE TO s_copying + " " + PROPER(TRIM(cprsname)) + " " + s_to + " " + DISKS->dname m.outdir = addbs(m.destination)+addbs(m.child)+ "DISK" + m.leaf DO CASE CASE setupfile * These come from the runtime directory--usually \FOXPROW\DKSETUP COPY FILE (addbs(m.g_runtimedir) + TRIM(cprsname)) TO (addbs(m.outdir)+TRIM(cprsname)) CASE extrafile IF !COMPRESS COPY FILE (TRIM(fname)) TO (addbs(m.outdir)+TRIM(cprsname)) ELSE COPY FILE (addbs(m.g_cprsdir) + TRIM(cprsname)) TO (addbs(m.outdir)+TRIM(cprsname)) ENDIF OTHERWISE COPY FILE (addbs(m.g_cprsdir) + TRIM(cprsname)) TO (addbs(m.outdir)+TRIM(cprsname)) ENDCASE ENDSCAN *!***************************************************************************** *! *! Procedure: MAKEINF *! *!***************************************************************************** PROCEDURE makeinf PARAMETER m.disktype, m.setupname * Create the SETUP.INF file for each disk type PRIVATE m.fldname, m.i, m.numdisks, m.in_safe SET MESSAGE TO s_makeinf SELECT DISKS SEEK m.disktype m.fldname = DISKS->diskfld SELECT (m.g_dbalias) CALCULATE MAX(&fldname) TO m.numdisks SET ORDER TO TAG fname m.in_safe = SET("SAFETY") SET SAFETY OFF SET CONSOLE OFF SET TEXTMERGE TO (m.setupname) SET TEXTMERGE ON \\[Source Media Descriptions] \ FOR m.i = 1 TO m.numdisks \\ "<<ALLTRIM(STR(m.i,4))>>", \\"Disk <<ALLTRIM(STR(m.i,4))>>", GOTO TOP LOCATE FOR &fldname = m.i IF FOUND() \\"<<TRIM(cprsname)>>", ENDIF \\"..\DISK<<ALLTRIM(STR(m.i,4))>>" \ ENDFOR * Emit the [Default File Settings] section \[Default File Settings] \"STF_BACKUP" = "" \"STF_COPY" = "YES" \"STF_DECOMPRESS" = "YES" \"STF_OVERWRITE" = "ALWAYS" \"STF_READONLY" = "" \"STF_ROOT" = "" \"STF_SETTIME" = "" \"STF_TIME" = "0" \"STF_VITAL" = "YES" * Emit the setup specific information \ \[FP SETUP] \ TITLE=<<m.g_title>> IF EMPTY(justdrive(m.g_targetdir)) \ PATH=C:\<<IIF(LEFT(m.g_targetdir,1)=='\',SUBSTR(m.g_targetdir,2),m.g_targetdir)>> ELSE \ PATH=<<m.g_targetdir>> ENDIF \ GROUP=<<IIF(EMPTY(m.g_pmgroup),juststem(m.g_sourcedir),m.g_pmgroup)>> DO CASE CASE m.g_modoptions = c_modall \ FORCELOC="NO" CASE m.g_modoptions = c_modgroup \ FORCELOC="GROUP ONLY" CASE m.g_modoptions = c_modnone \ FORCELOC="YES" ENDCASE \ COPYRIGHT=<<m.g_copyright>> \ ESL=<<justpath(m.g_esl)>> \ PROGRAM=<<SYS(2014,m.g_appname,addbs(m.g_sourcedir))>> IF m.g_nologo = 1 \\ -T ENDIF IF m.g_usealtcfg = 1 AND !EMPTY(m.g_altcfgfile) \\ -C<<m.g_altcfgfile>> ENDIF IF !EMPTY(m.g_parameters) \\ <<m.g_parameters>> ENDIF m.spath = addbs(m.g_sourcedir) DO CASE CASE EMPTY(m.g_executable) \ RUN= CASE words(m.g_executable) = 1 \ RUN=<<SYS(2014,m.g_executable,m.spath)>> OTHERWISE \ RUN=<<SYS(2014,wordnum(m.g_executable,1),m.spath)>> FOR m.i = 2 TO words(m.g_executable) \\ <<wordnum(m.g_executable,m.i)>> ENDFOR ENDCASE \ DESCRIPT=<<m.g_pmdescript>> * Emit the section for the setup files \ \[Sysfiles] \ SELECT required SCAN FOR CLASS = 1 && files that setup needs to install in the Windows system directory. * Find the file in the DKCONTRL database SELECT (m.g_dbalias) SET ORDER TO TAG fname SEEK TRIM(required->reqname) IF FOUND() m.disknum = &fldname \\ <<m.disknum>>, \\ <<TRIM(required->expndname)>>, \\,,, \\ <<TRIM(required->fdate)>>,, \\ 1033, \\ OLDER, \\ !READONLY,, \\ <<TRIM(required->expndname)>>,,,, \\ <<required->expndsize>>, \\ SYSTEM, \\,, \\ <<TRIM(required->version)>>, \\ VITAL \ ELSE DO errormsg WITH error_array[en_missreq]+TRIM(fname), c_fatal && shouldn't ever happen ENDIF SELECT required ENDSCAN SELECT (m.g_dbalias) * Emit the entries for FOXPRINT if it is being installed IF m.g_foxprint SELECT 0 USE foxprint SCAN m.filname = justfname(UPPER(TRIM(foxprint->fname))) m.filname = IIF(foxprint->COMPRESS,gencprsname(m.filname),m.filname) SELECT (m.g_dbalias) SET ORDER TO TAG cprsname SEEK (m.filname) IF FOUND() m.disknum = &fldname \\ <<m.disknum>>, \\ <<TRIM(cprsname)>>, \\,,,,,, OLDER, !READONLY,, \\ <<TRIM(justfname(foxprint->expndname))>>,,,, \\ <<foxprint->expndsize>>,,,,, \\ !VITAL \ ENDIF ENDSCAN SELECT foxprint USE SELECT (m.g_dbalias) SET ORDER TO TAG fname ENDIF * Emit the section for Graph files, if that option was selected IF m.g_instgraph \ \[MSGraph] \ SELECT 0 USE msgraph m.grphname = justfname(UPPER(TRIM(msgraph->fname))) m.grphname = IIF(msgraph->COMPRESS,gencprsname(m.grphname),m.grphname) SELECT (m.g_dbalias) SET ORDER TO TAG cprsname SEEK (m.grphname) IF FOUND() m.disknum = &fldname \\ <<m.disknum>>, \\ <<TRIM(cprsname)>>, \\,,,,,, OLDER, !READONLY,, \\ <<TRIM(justfname(msgraph->expndname))>>,,,, \\ <<msgraph->expndsize>>,,,,, \\ !VITAL ENDIF SELECT msgraph USE SELECT (m.g_dbalias) SET ORDER TO TAG fname ENDIF * Emit the [Application] section, containing application files plus the program to run at the * conclusion of setup, if any. * 6, appabout.prg,,,, 1993-01-18,,,, !READONLY,, foxapp\screens\appabout.prg,,,, 4084,,,,, !VITAL \ \[Application] \ SCAN FOR (!setupfile AND !extrafile) ; OR (extrafile AND (TRIM(UPPER(fname)) == UPPER(wordnum(m.g_executable,1)))) ; OR (extrafile AND m.g_eslextra ; AND (TRIM(UPPER(justfname(fname))) == UPPER(justfname(m.g_esl)))) m.disknum = &fldname \\ <<m.disknum>>, \\ <<TRIM(cprsname)>>, DO CASE CASE (extrafile AND (TRIM(UPPER(fname)) == UPPER(wordnum(m.g_executable,1)))) \\, \\,,,,,, !READONLY,, \\ <<TRIM(justfname(fname))>>, CASE EMPTY(parent) AND extrafile && FOXW2500.ESL main piece \\, \\,,,,,, !READONLY,, \\ <<TRIM(justfname(fname))>>, CASE extrafile && FOXW2500.ESL split piece \\ <<TRIM(justfname(fname))>>, \\,,,,,, !READONLY,, \\, CASE EMPTY(parent) \\, \\,,,,,, !READONLY,, \\ <<TRIM(fname)>>, OTHERWISE && show that file should be appended to fname \\ <<TRIM(fname)>>, \\,,,,,, !READONLY,, \\, ENDCASE \\,,, IF splitfile && show expanded size of split file piece. \\ <<expndsize>>, ELSE \\ <<filsize>>, ENDIF \\,,,, \\ !VITAL \ ENDSCAN SET TEXTMERGE OFF SET TEXTMERGE TO SET CONSOLE ON SET SAFETY &in_safe RETURN *!***************************************************************************** *! *! Procedure: MAKELST *! *!***************************************************************************** PROCEDURE makelst PARAMETER m.thefile SET TEXTMERGE TO (m.thefile) SET TEXTMERGE ON SET CONSOLE OFF \[Params] \ WndTitle = <<IIF(EMPTY(m.g_title),s_setuptitle,m.g_title)>> \ WndMess = <<s_setupinit>> \ TmpDirSize = 500 \ TmpDirName = ~msstfqf.t \ CmdLine = _mstest setup.mst /C "/S %s %s" \ DrvModName = DSHELL \ \[Files] \ setup.ms_ = setup.mst \ setup.in_ = setup.inc \ setup.inf = setup.inf \ mscomstf.dl_ = mscomstf.dll \ msinsstf.dl_ = msinsstf.dll \ msuilstf.dl_ = msuilstf.dll \ msshlstf.dl_ = msshlstf.dll \ mscuistf.dl_ = mscuistf.dll \ msdetstf.dl_ = msdetstf.dll \ commdlg.dl_ = commdlg.dll \ shell.dl_ = shell.dll \ ver.dl_ = ver.dll \ _mssetup.su_ = _mssetup.exe \ _mstest.ex_ = _mstest.exe \ SET CONSOLE ON SET TEXTMERGE OFF SET TEXTMERGE TO *!***************************************************************************** *! *! Procedure: SHOWSUMRY *! *!***************************************************************************** PROCEDURE showsumry * Report on the disks we just made SET MESSAGE TO "" SELECT (m.g_dbalias) SET ORDER TO 0 IF m.g_dsk144 DO psm WITH c_dsk144 ENDIF IF m.g_dsk12 DO psm WITH c_dsk12 ENDIF IF m.g_dsk720 DO psm WITH c_dsk720 ENDIF SELECT (m.g_dbalias) *!***************************************************************************** *! *! Procedure: PSM *! *!***************************************************************************** PROCEDURE psm PARAMETER m.disktype SELECT DISKS SEEK m.disktype IF FOUND() m.fldname = TRIM(DISKS->diskfld) m.clsize = DISKS->clustsize * Note to translators: the strings like "Disk" do not need to be translated. They * are field names and are not presented to the user. SELECT &fldname AS "Disk",; COUNT(dkcontrl.fname) AS "Files", ; SUM(allocsize(dkcontrl.cprssize,m.clsize)) AS "Bytes" ; FROM dkcontrl; GROUP BY &fldname ; INTO CURSOR dkset DO putsumry.spr WITH TRIM(DISKS->dname),DISKS->disksize, TRIM(disks->diskfld), m.clsize * Free the cursor we just created IF USED("dkset") SELECT dkset USE ENDIF ENDIF RETURN *!***************************************************************************** *! *! Function: PGETNAME *! *!***************************************************************************** FUNCTION pgetname PARAMETER m.pathname PRIVATE ALL m.pname = justfname(pathname) IF splitfile m.num = getfnum(cprsname) DO CASE CASE m.num = 0 AND RIGHT(TRIM(juststem(cprsname)),1) = "0" RETURN m.pname + " (0)" CASE m.num = 0 AND RIGHT(TRIM(juststem(cprsname)),1) <> "0" RETURN m.pname + " (1)" OTHERWISE RETURN m.pname + " (" + ALLTRIM(STR(m.num,4)) + ")" ENDCASE ELSE RETURN m.pname ENDIF *!***************************************************************************** *! *! Function: ZAPFRAG *! *!***************************************************************************** PROCEDURE zapfrag PARAMETER m.thefile, m.cprsext, m.putprompt PRIVATE m.i, m.cleanup, m.jfname, m.thefile, m.cprscount, m.therec SELECT (m.g_dbalias) m.therec = RECNO() m.jfname = justfname(m.thefile) m.jstem = juststem(m.thefile) m.stemlen = LEN(m.jstem) m.cleanup = 1 IF m.putprompt DO badsplit.spr WITH m.thefile, m.cleanup ENDIF IF m.cleanup = 1 * Delete the split file fragments for this file from the compressed directory. m.cprscount =ADIR(cprsfiles,addbs(m.g_cprsdir)+"*.*") FOR m.i = 1 TO m.cprscount DO CASE CASE m.jfname == justfname(cprsfiles[m.i,1]) DELETE FILE (addbs(m.g_cprsdir)+cprsfiles[m.i,1]) CASE m.jstem == juststem(cprsfiles[m.i,1]) ; AND justext(cprsfiles[m.i,1]) == m.cprsext DELETE FILE (addbs(m.g_cprsdir)+cprsfiles[m.i,1]) CASE m.stemlen = 8 ; AND LEN(juststem(cprsfiles[m.i,1])) = 8 ; AND LEFT(m.jstem,7) == LEFT(juststem(cprsfiles[m.i,1]),7) ; AND isdigit(RIGHT(juststem(cprsfiles[m.i,1]),1)) ; AND justext(cprsfiles[m.i,1]) == m.cprsext DELETE FILE (addbs(m.g_cprsdir)+cprsfiles[m.i,1]) CASE m.stemlen <= 7 AND isdigit(RIGHT(juststem(cprsfiles[m.i,1]),1)) ; AND justext(cprsfiles[m.i,1]) == m.cprsext * A possible split child file ... IF isdigit(RIGHT(m.jstem,1)) * See if this is FAR25.EXE matching FAR26.EX$ IF LEFT(m.jstem, m.stemlen - 1) ; == LEFT(juststem(cprsfiles[m.i,1]),LEN(juststem(cprsfiles[m.i,1]))-1) DELETE FILE (addbs(m.g_cprsdir)+cprsfiles[m.i,1]) ENDIF ELSE IF m.jstem ; == LEFT(juststem(cprsfiles[m.i,1]),LEN(juststem(cprsfiles[m.i,1]))-1) * A file like FAR.EXE matches FAR2.EX$ DELETE FILE (addbs(m.g_cprsdir)+cprsfiles[m.i,1]) ENDIF ENDIF ENDCASE ENDFOR * Delete the DKCONTRL entries for the split pieces of this file SELECT (m.g_dbalias) SCAN FOR justfname(fname) == m.thefile AND splitfile AND EMPTY(parent) REPLACE splitfile WITH .F. ENDSCAN SCAN FOR justfname(fname) == m.thefile AND splitfile AND !EMPTY(parent) DELETE ENDSCAN PACK ENDIF GOTO m.therec RETURN *!***************************************************************************** *! *! Function: ALLOCSIZE *! *!***************************************************************************** FUNCTION allocsize * Compute the allocated size required for a file of size m.nominal on a disk with * a cluster size of m.cluster. PARAMETERS m.nominal, m.cluster DO CASE CASE m.cluster = 0 RETURN -1 && invalid cluster size. Test here to prevent division by zero. CASE m.nominal = 0 RETURN nominal CASE m.nominal % m.cluster = 0 RETURN m.nominal OTHERWISE RETURN ((INT(m.nominal / m.cluster) + 1) * m.cluster) ENDCASE *!***************************************************************************** *! *! Function: GENCPRSNAME *! *!***************************************************************************** FUNCTION gencprsname * Assign the compressed filename that COMPRESS.EXE will create PARAMETER m.cname m.cname = ALLTRIM(m.cname) DO CASE CASE RIGHT(m.cname,1) = "$" RETURN m.cname CASE LEN(justext(m.cname)) = 3 RETURN forceext(m.cname,LEFT(justext(m.cname),2)+"$") OTHERWISE RETURN forceext(m.cname,justext(m.cname)+"$") ENDCASE *!***************************************************************************** *! *! Function: PUTONDISK *! *!***************************************************************************** FUNCTION putondisk PARAMETER m.fpath, m.diskno, m.extra, m.setup, m.cprs, m.prnt * Assign file fpath to disk number m.diskno * First find the file m.numfiles = ADIR(rtdir,IIF(m.setup,addbs(m.g_runtimedir)+m.fpath,m.fpath)) IF m.numfiles > 0 SELECT (m.g_dbalias) SET ORDER TO TAG fname SEEK m.fpath IF !FOUND() APPEND BLANK ENDIF REPLACE fname WITH m.fpath, ; filsize WITH rtdir[1,2], ; fdate WITH rtdir[1,3], ; ftime WITH rtdir[1,4], ; fattrib WITH rtdir[1,5] REPLACE cprsname WITH IIF(m.cprs,gencprsname(rtdir[1,1]),justfname(fname)), ; filfound WITH .T., ; extrafile WITH m.extra, ; setupfile WITH m.setup, ; COMPRESS WITH m.cprs, ; parent WITH m.prnt REPLACE splitfile WITH IIF(EMPTY(parent), .F., .T.) REPLACE cprssize WITH filsize REPLACE expndsize WITH filsize RETURN RECNO() ENDIF RETURN 0 *!***************************************************************************** *! *! Function: MAPNAME *! *!***************************************************************************** FUNCTION mapname PARAMETER m.filname * Compressed filenames have to be unique for Setup. The compress utility replaces * the last letter in the extension with an underscore. This creates a problem with * FoxPro since so many file extensions have the same first two letters (e.g., SCX, SCT). * This routine tries to do something reasonable with the file name to make it unique. m.theext = UPPER(justext(m.filname)) DO CASE CASE m.theext == "SCT" RETURN forceext(m.filname,"STC") CASE m.theext == "MNT" RETURN forceext(m.filname,"MTN") CASE m.theext == "PJT" RETURN forceext(m.filname,"PTJ") CASE m.theext == "FRT" RETURN forceext(m.filname,"FTR") CASE m.theext == "LBT" RETURN forceext(m.filname,"LTB") CASE m.theext == "SPX" RETURN forceext(m.filname,"SXP") CASE m.theext == "MNX" RETURN forceext(m.filname,"MXN") OTHERWISE RETURN m.filname ENDCASE *!***************************************************************************** *! *! Function: ISRANDOM *! *!***************************************************************************** FUNCTION israndom * Returns .T. if m.filname appears to be a generated random name PARAMETER m.filname m.filname = UPPER(ALLTRIM(m.filname)) IF !EMPTY(m.filname) AND ISDIGIT(LEFT(m.filname,1)) ; AND ( ; (justext(m.filname) == c_randext) ; OR ( ; LEFT(justext(m.filname),2) == LEFT(c_randext,2) ; AND RIGHT(justext(m.filname),1) $ "$_" ; ) ; ) RETURN .T. ELSE RETURN .F. ENDIF *!***************************************************************************** *! *! Function: CHECKFILES *! *!***************************************************************************** FUNCTION checkfiles PARAMETERS showerrormsg * Returns TRUE if all files in the REQUIRED.DBF file are found in the g_runtimedir * directory. Used to validate the path entered in the g_runtimedir screen. PRIVATE m.in_area, m.filemissing m.in_area = SELECT() m.filemissing = .F. SELECT required SCAN IF !FILE(forcepath(TRIM(required->reqname),g_runtimedir)) m.filemissing = .T. IF !showerrormsg OR errormsg(ALLTRIM(required->reqname) ; + " " + error_array[en_notfound], c_entry1) = idcancel SELECT (m.in_area) RETURN .F. ENDIF ENDIF ENDSCAN SELECT (m.in_area) RETURN !m.filemissing *!***************************************************************************** *! *! Function: CPRSMATCH *! *!***************************************************************************** FUNCTION cprsmatch * Do two filenames match after the compression program has changed the names? PARAMETER fname1, fname2 DO CASE CASE fname1 == fname2 RETURN .T. CASE LEN(fname1) = 12 AND LEN(fname2) = 12 AND LEFT(fname1,11) == LEFT(fname2,11) RETURN .T. OTHERWISE RETURN .F. ENDCASE *!***************************************************************************** *! *! Procedure: ZAPDIR *! *!***************************************************************************** PROCEDURE zapdir PARAMETER m.diskroot, m.error_array PRIVATE ALL * Delete any existing files in the destination tree * Delete all the files in any of my children m.numfiles = ADIR(rtdir,addbs(m.diskroot)+"*.*","D") FOR m.i = 1 TO m.numfiles IF "D" $ rtdir[m.i,5] AND !INLIST(rtdir[m.i,1],"..",".") DO zapdir WITH addbs(m.diskroot)+rtdir[m.i,1], m.error_array ENDIF ENDFOR * Delete all the regular files in this directory m.numfiles = ADIR(rtdir,addbs(m.diskroot)+"*.*") FOR m.i = 1 TO m.numfiles DELETE FILE (addbs(m.diskroot)+rtdir[m.i,1]) ENDFOR * Display an error message if there are any hidden or system files m.numfiles = ADIR(rtdir,addbs(m.diskroot)+"*.*","SH") FOR m.i = 1 TO m.numfiles * Hidden or system file found in C:\FOXPROW\FOO--QUUX.ABC DO errormsg WITH error_array[en_hidden]+m.diskroot+"--" +rtdir[m.i,1], c_warning ENDFOR IF m.numfiles = 0 && no hidden or system files. =rmdir(m.diskroot) ENDIF *!***************************************************************************** *! *! Function: GETUFSIZE *! *!***************************************************************************** FUNCTION getufsize * Get the uncompressed file size for compressed file m.fname PARAMETER m.fname PRIVATE m.thesize, m.fp, m.buffer, m.numwords, m.theword, m.in_sec m.thesize = "0" IF FILE(m.fname) COPY FILE size.pif TO ufsize.pif SET TEXTMERGE TO usize.bat SET TEXTMERGE ON SET CONSOLE OFF IF FILE("usize.txt") DELETE FILE usize.txt ENDIF \\DECOMP -Q <<m.fname>> > usize.txt SET TEXTMERGE OFF SET TEXTMERGE TO IF !FILE("usize.bat") WAIT WINDOW "Error creating batch file" && shouldn't happen ENDIF * Run minimized. RUN ufsize.pif SET CONSOLE ON IF FILE("usize.bat") DELETE FILE usize.bat ENDIF IF FILE("ufsize.pif") DELETE FILE ufsize.pif ENDIF * Read the usize.txt file and extract the uncompressed size. IF FILE("usize.txt") m.fp = FOPEN("usize.txt") IF m.fp > 0 DO WHILE !FEOF(m.fp) m.buffer = FGETS(m.fp) IF UPPER(LEFT(m.buffer,13)) == "DECOMPRESSION" * Start with word 8, which should be the file size m.thesize = wordnum(m.buffer,8) IF ISDIGIT(LEFT(m.thesize,1)) m.thesize = CHRTRAN(m.thesize," ,","") EXIT ELSE && find the size m.numwords = words(m.buffer) m.i = 1 DO WHILE m.i < m.numwords m.theword = wordnum(m.buffer,m.i) IF ISDIGIT(LEFT(m.theword,1)) m.thesize = m.theword EXIT ENDIF m.i = m.i + 1 ENDDO ENDIF ENDIF ENDDO =FCLOSE(m.fp) ELSE DO errormsg WITH error_array[en_ufopen]+": "+m.fname, c_fatal ENDIF DELETE FILE usize.txt ELSE DO errormsg WITH error_array[en_ufopen]+": "+m.fname, c_fatal ENDIF RETURN VAL(m.thesize) ELSE RETURN -1 ENDIF *!***************************************************************************** *! *! Function: ISDIR *! *!***************************************************************************** FUNCTION isdir * Returns TRUE if m.directory exists as a directory PARAMETER m.directory PRIVATE ALL m.directory = UPPER(ALLTRIM(m.directory)) IF RIGHT(m.directory,1) = '\' m.directory = LEFT(m.directory,LEN(m.directory)-1) ENDIF DO CASE CASE LEN(m.directory) = 2 AND RIGHT(m.directory,1) = ":" RETURN .T. CASE LEN(m.directory) = 3 AND SUBSTR(m.directory,2,1) = ":" AND RIGHT(m.directory,1) = "\" RETURN .T. OTHERWISE m.parent = justpath(m.directory) m.child = juststem(m.directory) m.numfiles = ADIR(subdir,addbs(m.parent)+"*.*","D") IF m.numfiles > 0 FOR m.i = 1 TO m.numfiles IF subdir[m.i,1] == m.child AND "D" $ subdir[m.i,5] RETURN .T. ENDIF ENDFOR ENDIF ENDCASE RETURN .F. *!***************************************************************************** *! *! Function: TRIMPATH *! *!***************************************************************************** FUNCTION trimpath * Trim trailing backslash off a directory name, unless it is C:\, D:\, etc. PARAMETER m.path PRIVATE ALL m.path = TRIM(m.path) DO CASE CASE LEN(m.path) = 1 OR LEN(m.path) = 2 && who knows? Just return it. RETURN m.path CASE LEN(m.path) = 3 AND SUBSTR(m.path,2,1) = ':' AND RIGHT(m.path,1) = '\' && like C:\ RETURN m.path CASE RIGHT(m.path,1) = '\' RETURN LEFT(m.path,LEN(m.path)-1) OTHERWISE RETURN m.path ENDCASE ** ** Code Associated With Displaying of the Thermometer ** * * ACTTHERM(<text>) - Activate thermometer. * * Activates thermometer. Update the thermometer with UPDTHERM(). * Thermometer window is named "thermometer." Be sure to RELEASE * this window when done with thermometer. Creates the global * m.g_thermwidth. * *!***************************************************************************** *! *! Procedure: ACTTHERM *! *!***************************************************************************** PROCEDURE acttherm PARAMETER m.text PRIVATE m.prompt #DEFINE c_dlgface "MS Sans Serif" #DEFINE c_dlgsize 8 #DEFINE c_dlgstyle "B" m.prompt = c_thermprompt IF TXTWIDTH(m.prompt, c_dlgface, c_dlgsize, c_dlgstyle) > 43 DO WHILE TXTWIDTH(m.prompt+"...", c_dlgface, c_dlgsize, c_dlgstyle) > 43 m.prompt = LEFT(m.prompt, LEN(m.prompt)-1) ENDDO m.prompt = m.prompt + "..." ENDIF DEFINE WINDOW thermomete ; AT INT((SROW() - (( 5.615 * ; FONTMETRIC(1, c_dlgface, c_dlgsize, c_dlgstyle )) / ; FONTMETRIC(1, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2), ; INT((SCOL() - (( 63.833 * ; FONTMETRIC(6, c_dlgface, c_dlgsize, c_dlgstyle )) / ; FONTMETRIC(6, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2) ; SIZE 5.615,63.833 ; FONT c_dlgface, c_dlgsize ; STYLE c_dlgstyle ; NOFLOAT ; NOCLOSE ; NONE ; COLOR RGB(0, 0, 0, 192, 192, 192) MOVE WINDOW thermomete CENTER ACTIVATE WINDOW thermomete NOSHOW @ 0.5,3 SAY m.text FONT c_dlgface, c_dlgsize STYLE c_dlgstyle @ 1.5,3 SAY m.prompt FONT c_dlgface, c_dlgsize STYLE c_dlgstyle @ 0.000,0.000 TO 0.000,63.833 ; COLOR RGB(255, 255, 255, 255, 255, 255) @ 0.000,0.000 TO 5.615,0.000 ; COLOR RGB(255, 255, 255, 255, 255, 255) @ 0.385,0.667 TO 5.231,0.667 ; COLOR RGB(128, 128, 128, 128, 128, 128) @ 0.308,0.667 TO 0.308,63.167 ; COLOR RGB(128, 128, 128, 128, 128, 128) @ 0.385,63.000 TO 5.308,63.000 ; COLOR RGB(255, 255, 255, 255, 255, 255) @ 5.231,0.667 TO 5.231,63.167 ; COLOR RGB(255, 255, 255, 255, 255, 255) @ 5.538,0.000 TO 5.538,63.833 ; COLOR RGB(128, 128, 128, 128, 128, 128) @ 0.000,63.667 TO 5.615,63.667 ; COLOR RGB(128, 128, 128, 128, 128, 128) @ 3.000,3.333 TO 4.231,3.333 ; COLOR RGB(128, 128, 128, 128, 128, 128) @ 3.000,60.333 TO 4.308,60.333 ; COLOR RGB(255, 255, 255, 255, 255, 255) @ 3.000,3.333 TO 3.000,60.333 ; COLOR RGB(128, 128, 128, 128, 128, 128) @ 4.231,3.333 TO 4.231,60.500 ; COLOR RGB(255, 255, 255, 255, 255, 255) m.g_thermwidth = 56.269 SHOW WINDOW thermomete TOP RETURN * * UPDTHERM(<percent>) - Update thermometer. * *!***************************************************************************** *! *! Procedure: UPDTHERM *! *!***************************************************************************** PROCEDURE updtherm PARAMETER m.percent PRIVATE m.nblocks, m.percent IF !WEXIST("thermomete") DO acttherm WITH c_setupname ENDIF IF m.g_thermwidth = 0 m.g_thermwidth = 56.269 ENDIF ACTIVATE WINDOW thermomete * Map to the number of platforms we are generating for m.percent = MIN(m.percent,100) m.nblocks = (m.percent/100) * (m.g_thermwidth) @ 3.000,3.333 TO 4.231,m.nblocks + 3.333 ; PATTERN 1 COLOR RGB(128, 128, 128, 128, 128, 128) RETURN * * DEACTTHERMO - Deactivate and Release thermometer window. * *!***************************************************************************** *! *! Procedure: DEACTTHERMO *! *!***************************************************************************** PROCEDURE deactthermo IF WEXIST("thermomete") RELEASE WINDOW thermomete ENDIF RETURN *!***************************************************************************** *! *! Procedure: GETPREFERENCES *! *!***************************************************************************** PROCEDURE getpreferences PARAMETER m.ini_name * Get user's responses from DKSETUP.INI file m.g_sourcedir = getprof(m.ini_name,c_pref,c_sourcedir) m.g_destdir = getprof(m.ini_name,c_pref,c_destdir) m.g_runtimedir = getprof(m.ini_name,c_pref,c_runtime) m.g_dsk144 = IIF(UPPER(getprof(m.ini_name,c_pref,c_make144))="Y",.T.,.F.) m.g_dsk12 = IIF(UPPER(getprof(m.ini_name,c_pref,c_make12))="Y",.T.,.F.) m.g_dsk720 = IIF(UPPER(getprof(m.ini_name,c_pref,c_make720))="Y",.T.,.F.) m.g_instgraph = IIF(UPPER(getprof(m.ini_name,c_pref,c_instgraph))="Y",.T.,.F.) m.g_targetdir = getprof(m.ini_name,c_pref,c_targetdir) m.g_appname = getprof(m.ini_name,c_pref,c_appname) m.g_pmdescript = getprof(m.ini_name,c_pref,c_pmdescript) m.g_pmgroup = getprof(m.ini_name,c_pref,c_pmgroup) m.temp = getprof(m.ini_name,c_pref,c_usermod) IF !EMPTY(m.temp) AND BETWEEN(VAL(m.temp),1,3) m.g_modoptions = VAL(m.temp) ENDIF m.temp = getprof(m.ini_name,c_pref,c_nologo) IF !EMPTY(m.temp) AND VAL(m.temp) > 0 m.g_nologo = VAL(m.temp) ENDIF m.g_altcfgfile = getprof(m.ini_name,c_pref,c_altcfgfile) m.g_usealtcfg = IIF(EMPTY(m.g_altcfgfile),0,1) m.g_parameters = getprof(m.ini_name,c_pref,c_parameters) m.g_executable = getprof(m.ini_name,c_pref,c_runanother) m.g_title = getprof(m.ini_name,c_pref,c_setuptitle) m.g_copyright = getprof(m.ini_name,c_pref,c_copyright) m.temp = getprof(m.ini_name,c_pref,c_splitsize) IF !EMPTY(m.temp) AND VAL(m.temp) > 0 m.g_splitsize = VAL(m.temp) ENDIF m.temp = getprof(m.ini_name,c_pref,c_algorithm) IF !EMPTY(m.temp) AND INLIST(m.temp,"2","3") && 2 and 3 are only valid values m.g_algorithm = m.temp ENDIF *!***************************************************************************** *! *! Procedure: PUTPREFERENCES *! *!***************************************************************************** PROCEDURE putpreferences PARAMETER m.ini_name * Store user's responses in DKSETUP.INI file = putprof(m.ini_name,c_pref,c_sourcedir,m.g_sourcedir) = putprof(m.ini_name,c_pref,c_destdir,m.g_destdir) = putprof(m.ini_name,c_pref,c_runtime,m.g_runtimedir) = putprof(m.ini_name,c_pref,c_make144,IIF(m.g_dsk144,"Y","N")) = putprof(m.ini_name,c_pref,c_make12,IIF(m.g_dsk12,"Y","N")) = putprof(m.ini_name,c_pref,c_make720,IIF(m.g_dsk720,"Y","N")) = putprof(m.ini_name,c_pref,c_instgraph,IIF(m.g_instgraph,"Y","N")) = putprof(m.ini_name,c_pref,c_targetdir,m.g_targetdir) = putprof(m.ini_name,c_pref,c_appname,m.g_appname) = putprof(m.ini_name,c_pref,c_pmdescript,m.g_pmdescript) = putprof(m.ini_name,c_pref,c_pmgroup,m.g_pmgroup) = putprof(m.ini_name,c_pref,c_usermod,ALLTRIM(STR(m.g_modoptions,1))) = putprof(m.ini_name,c_pref,c_nologo,ALLTRIM(STR(m.g_nologo,1))) = putprof(m.ini_name,c_pref,c_altcfgfile,IIF(m.g_usealtcfg=0,"",m.g_altcfgfile)) = putprof(m.ini_name,c_pref,c_parameters,m.g_parameters) = putprof(m.ini_name,c_pref,c_runanother,m.g_executable) = putprof(m.ini_name,c_pref,c_setuptitle,m.g_title) = putprof(m.ini_name,c_pref,c_copyright,m.g_copyright) = putprof(m.ini_name,c_pref,c_splitsize,ALLTRIM(STR(m.g_splitsize,20))) = putprof(m.ini_name,c_pref,c_algorithm,m.g_algorithm) *!***************************************************************************** *! *! Procedure: PUTPROF *! *!***************************************************************************** PROCEDURE putprof * Place a profile string into dksetup_ini PARAMETER m.ini_name, m.application, m.section, m.pstring * Create the INI file if it doesn't exist IF !FILE(m.ini_name) fp = FCREATE(m.ini_name) =FPUTS(fp," ") =FCLOSE(fp) ENDIF m.wfn = regfn("WritePrivateProfileString","CCCC","I") RETURN callfn(m.wfn,m.application,m.section,m.pstring,m.ini_name) *!***************************************************************************** *! *! Function: GETPROF *! *!***************************************************************************** FUNCTION getprof * Retrieve a profile string from dksetup_ini PARAMETER m.ini_name, m.application, m.section PRIVATE ALL m.e_buf = REPLICATE(CHR(0),255) m.gfn = regfn("GetPrivateProfileString","CCC@CIC","I") =callfn(m.gfn,m.application, m.section,CHR(0),@m.e_buf,255,m.ini_name) m.e_buf = ALLTRIM(CHRTRAN(m.e_buf,CHR(0)," ")) RETURN m.e_buf *!***************************************************************************** *! *! Procedure: ERRORHANDLER *! *!***************************************************************************** PROCEDURE errorhandler PARAMETER m.msg, m.code DO errormsg WITH m.msg, m.code RETURN TO dksetup