home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / foxupdat / upd_dk.exe / WIZARD / DKSETUP.PRG next >
Text File  |  1993-10-07  |  104KB  |  3,018 lines
  1. *!*****************************************************************************
  2. *!
  3. *:     Program: DKSETUP.PRG
  4. *!
  5. *!*****************************************************************************
  6. * Microsoft FoxPro SetupWizard -- FoxPro 2.5 for Windows
  7. * This program is designed to simplify the process of creating the installation
  8. *   disks for a FoxPro developer to install a FoxPro application on a user's machine.
  9. * Copyright, Microsoft Corp., 1993
  10. * Written by Walter J. Kennamer
  11.  
  12. PROCEDURE dksetup
  13. EXTERNAL SCREEN dkscrn1, dkscrn2, dkscrn3, dkscrn4, dkscrn5, dkscrn6, dkscrn7,;
  14.    dkscrn8, dkscrn9, dkscrn10
  15. EXTERNAL LIBRARY foxtools.fll
  16. PRIVATE ALL
  17.  
  18. * Carriage return/line feed
  19. #DEFINE c_crlf CHR(13)+CHR(10)
  20.  
  21. * View file name
  22. #DEFINE c_vuename      dksetup.vue
  23. #DEFINE c_vuename_str "DKSETUP.VUE"
  24.  
  25. * File names for standard files used by Wizard or by SETUP.EXE
  26. #DEFINE c_setupinf    "SETUP.INF"
  27. #DEFINE c_setuplst    "SETUP.LST"
  28. #DEFINE c_eslfile     "FOXW250B.ESL"
  29.  
  30. * File names for obsolete compressed files
  31. #DEFINE c_oldesl      "FOXW2500.ESL"
  32. #DEFINE c_oldesl1     "FOXW250A.ESL"
  33.  
  34. * Default max 512-byte units before file split.  May be changed in INI file 
  35. #DEFINE c_units        710    
  36.  
  37. * User push button actions
  38. #DEFINE c_cancel 0
  39. #DEFINE c_back   1
  40. #DEFINE c_next   2
  41. #DEFINE c_done   3
  42.  
  43. * Error message codes
  44. #DEFINE c_status  1
  45. #DEFINE c_warning 2
  46. #DEFINE c_fatal   3
  47. #DEFINE c_entry   4   && data entry validation error
  48. #DEFINE c_entry1  5   && data entry validation error, with option to cancel
  49. #DEFINE c_entry2  6   && data entry validation error, with Yes/No prompt
  50.  
  51. * Error numbers--indexes into error_array
  52. #DEFINE en_extension   1
  53. #DEFINE en_foxtools    2
  54. #DEFINE en_dir1        3
  55. #DEFINE en_dir2        4
  56. #DEFINE en_dir3        5
  57. #DEFINE en_noexe       6
  58. #DEFINE en_fxtver      7
  59. #DEFINE en_nortfiles   8 
  60. #DEFINE en_missing     9
  61. #DEFINE en_notfound   10
  62. #DEFINE en_getfile    11
  63. #DEFINE en_hidden     12
  64. #DEFINE en_blanksrc   13
  65. #DEFINE en_noreq      14
  66. #DEFINE en_ufopen     15
  67. #DEFINE en_cprserr    16
  68. #DEFINE en_toobig     17
  69. #DEFINE en_blankexe   18
  70. #DEFINE en_exemiss    19
  71. #DEFINE en_exem1      20
  72. #DEFINE en_toolong    21
  73. #DEFINE en_nocompress 22
  74. #DEFINE en_missreq    23
  75. #DEFINE en_nogroup    24
  76. #DEFINE en_oldver     25
  77. #DEFINE en_cprsdead   26
  78. #DEFINE en_badpath    27
  79. #DEFINE en_nocfg      28
  80. #DEFINE en_baddir     29
  81. #DEFINE en_dir4       30
  82.  
  83. * Displayed as message box title
  84. #DEFINE e_error_title "Microsoft FoxPro Setup-Assistent - Fehler"
  85.  
  86. * Disk types, corresponding to dtype entry in DISKS.DBF
  87. #DEFINE c_dsk144 1
  88. #DEFINE c_dsk12  2
  89. #DEFINE c_dsk720 3
  90.  
  91. * User Modification options
  92. #DEFINE c_modall   1  && User can modify both default directory and PM Group
  93. #DEFINE c_modgroup 2  && User can modify just the PM group
  94. #DEFINE c_modnone  3  && User can modify neither directory or PM Group
  95.  
  96. * The name of the compress directory, off the destination tree
  97. #DEFINE c_cprsdir "COMPRESS"
  98.  
  99. * Preferences constants--no translation needed
  100. #DEFINE c_setupini    SYS(2004)+"DKSETUP.INI"
  101. #DEFINE c_pref        "Preferences"
  102. #DEFINE c_sourcedir   "SourceDirectory"
  103. #DEFINE c_destdir     "DestinationDirectory"
  104. #DEFINE c_runtime     "RuntimeDirectory"
  105. #DEFINE c_make144     "Make1.44MegDisks"
  106. #DEFINE c_make12      "Make1.2MegDisks"
  107. #DEFINE c_make720     "Make720KDisks"
  108. #DEFINE c_instgraph   "InstallGraph"
  109. #DEFINE c_targetdir   "UserDefaultDirectory"
  110. #DEFINE c_appname     "ApplicationName"
  111. #DEFINE c_pmdescript  "ProgManDescript"
  112. #DEFINE c_runanother  "PostExecute"
  113. #DEFINE c_setuptitle  "SetupBanner"
  114. #DEFINE c_copyright   "Copyright"
  115. #DEFINE c_splitsize   "SplitSize"
  116. #DEFINE c_algorithm   "Algorithm"
  117. #DEFINE c_usermod     "UserCanModify"
  118. #DEFINE c_pmgroup     "ProgManGroup"
  119. #DEFINE c_nologo      "SuppressLogo"
  120. #DEFINE c_parameters  "EXEParameters"
  121. #DEFINE c_altcfgfile  "ConfigFile"
  122.  
  123. * Message box responses, from WIN16.H file.
  124. #DEFINE idok            1
  125. #DEFINE idcancel        2
  126. #DEFINE idabort         3
  127. #DEFINE idretry         4
  128. #DEFINE idignore        5
  129. #DEFINE idyes            6
  130. #DEFINE idno            7
  131.  
  132. * Number of columns in the disk statistics array
  133. #DEFINE c_diskcols 3
  134.  
  135. * Extension of files that are given random names
  136. #DEFINE c_randext  "SET"
  137.  
  138. * Strings used in the program
  139. #DEFINE c_product     "Microsoft FoxPro"
  140. #DEFINE c_setupname   "Setup-Assistent"
  141. #DEFINE c_thermprompt "Erstellen der Setup-Disketten..."
  142.  
  143. * SET MESSAGE TO strings -- these need to be translated
  144. #DEFINE s_winonly     "Der Setup-Assistent ben÷tigt FoxPro fⁿr Windows"
  145. #DEFINE s_to1          "zu"
  146. #DEFINE s_to2          "auf"
  147. #DEFINE s_filling     "Suche nach den Dateien der Anwendung"
  148. #DEFINE s_compressing "▄berprⁿfen auf Eindeutigkeit der Dateinamen"
  149. #DEFINE s_batch       "Vorbereiten der Dateikomprimierung"
  150. #DEFINE s_cprs        "Komprimieren der Dateien der Anwendung"
  151. #DEFINE s_canceling   "Setup wird abgebrochen"
  152. #DEFINE s_mkdir       "Ausgabe-Verzeichnisse werden erstellt"
  153. #DEFINE s_copying     "Kopieren von"
  154. #DEFINE s_required    "Installieren der Setup-Unterstⁿtzungsdateien"
  155. #DEFINE s_assign      "Zuweisen der Dateien"
  156. #DEFINE s_ufsize      "Ermitteln der Dateigr÷▀e der nicht komprimierten Dateien"
  157. #DEFINE s_cprssize    "Ermitteln der Dateigr÷▀e der komprimierten Dateien"
  158. #DEFINE s_makeinf     "Erstellen der Setup-Informationsdatei"
  159. #DEFINE s_splitting   "Erneutes Teilen von"
  160. #DEFINE s_again       ". Bitte nicht unterbrechen."
  161. #DEFINE s_setuptitle  "Setup"   && default title
  162. #DEFINE s_setupinit   "Initialisieren von Setup..."
  163. #DEFINE s_escape      "Beenden des Setup-Assistenten"
  164. #DEFINE s_cleanup     "L÷schen der EintrΣge fⁿr"
  165.  
  166. IF SET("TALK") = "ON"
  167.    SET TALK OFF
  168.    m.mtalk = "ON"
  169. ELSE
  170.    m.mtalk = "OFF"
  171. ENDIF
  172.  
  173. * SET state variables.  Declared here so as to be visible in both init and cleanup.
  174. STORE "" TO m.mtrbet,m.mecho,m.mdebug,m.mstep,m.mudfparms,m.mcompat,m.mexact,;
  175.    m.mnear,m.munique,m.mansi,m.mcarry, m.mstatus, m.mescape, m.merror, m.mlibrary, ;
  176.    m.mdefault, m.mpoint, m.mdecimals
  177.  
  178. IF _WINDOWS
  179.    DO init
  180.    DO main
  181.    DO cleanup
  182. ELSE
  183.    WAIT WINDOW s_winonly NOWAIT
  184. ENDIF
  185. RETURN
  186. *!*****************************************************************************
  187. *!
  188. *!     Procedure: MAIN
  189. *!
  190. *!*****************************************************************************
  191. PROCEDURE main
  192. DIMENSION error_array[30]
  193. error_array = ""
  194. error_array[en_extension] = "Die Dateinamenerweiterung mu▀ .EXE, .COM, .PIF oder .BAT lauten."
  195. error_array[en_foxtools]  = "Der Setup-Assistent ben÷tigt FOXTOOLS.FLL."
  196. error_array[en_fxtver]    = "Der Setup-Assistent ben÷tigt Version 1.01"+c_crlf+"oder h÷her von FOXTOOLS.FLL."
  197. error_array[en_dir1]      = "Die Verzeichnisse mit den Quell- und den komprimierten"+c_crlf+"Dateien dⁿrfen nicht identisch sein."
  198. error_array[en_dir2]      = "Die Quell- und Zielverzeichnisse"+c_crlf+"dⁿrfen nicht identisch sein."
  199. error_array[en_dir3]      = "Das Verzeichnis mit den komprimierten Dateien und"+c_crlf+"das Zielverzeichnis dⁿrfen nicht identisch sein."
  200. error_array[en_noexe]     = "Es sind keine APP-, PRG-, FXP- oder EXE-"+c_crlf+"Dateien in diesem Verzeichnis vorhanden."
  201. error_array[en_nortfiles] = "Es sind keine Dateien im Distribution Kit-Verzeichnis vorhanden."
  202. error_array[en_missing]   = "(fehlt)"
  203. error_array[en_notfound]  = "konnte nicht gefunden werden."
  204. error_array[en_getfile]   = "Suchen?"
  205. error_array[en_hidden]    = "Versteckte oder Systemdatei gefunden in"
  206. error_array[en_blanksrc]  = "Es mu▀ ein Verzeichnisname angegeben werden."
  207. error_array[en_blankexe]  = "Es mu▀ ein Anwendungsname angegeben werden."
  208. error_array[en_noreq]     = "Eine der ben÷tigten Dateien konnte unerwarteterweise nicht gefunden werden."
  209. error_array[en_ufopen]    = "Fehler beim Ermitteln der Dateigr÷▀e der nicht komprimierten Datei."
  210. error_array[en_cprserr]   = "Fehler beim Komprimieren von"
  211. error_array[en_toobig]    = "Datei ist zu gro▀; sie kann von COMPRESS"+c_crlf+"nicht in 9 oder weniger Teile geteilt werden."
  212. error_array[en_exemiss]   = "Die .EXE-Datei der Anwendung konnte nicht gefunden werden."
  213. error_array[en_exem1]     = "Die .EXE-Datei der Anwendung konnte nicht"+c_crlf+"in der Verzeichnisstruktur der Anwendung gefunden werden."
  214. error_array[en_toolong]   = "Der Kompressionsbefehl ⁿberschreitet die DOS-Grenze von 128 Bytes."+c_crlf;
  215.                             +"Versuchen Sie, Verzeichnisnamen zu kⁿrzen oder COMPRESS in ein Verzeichnis"+c_crlf;
  216.                             +"zu kopieren, das in der Umgebungsvariable PATH aufgefⁿhrt wird."
  217. error_array[en_nocompress]= "COMPRESS.EXE konnte nicht gefunden werden."
  218. error_array[en_missreq]   = "Ben÷tigte Datei fehlt: "+c_crlf
  219. error_array[en_nogroup]   = "Es mu▀ eine Programmgruppe angegeben werden."
  220. error_array[en_oldver]    = "Ihre Datei DKCONTRL.DBF ist nicht mehr aktuell. Bitte l÷schen Sie die Datei."
  221. error_array[en_cprsdead]  = "Fehler wΣhrend der Komprimierung. Der Komprimiervorgang wurde evtl. unterbrochen."
  222. error_array[en_badpath]   = "Dieser Pfad oder Dateiname ist ungⁿltig."
  223. error_array[en_nocfg]     = "Das Feld fⁿr die alternative CONFIG-Datei ist leer."
  224. error_array[en_baddir]    = "Erstellen nicht m÷glich von Verzeichnis"
  225. error_array[en_dir4]      = "Das Zielverzeichnis darf nicht Teil der Verzeichnisstruktur der Anwendung sein."
  226.  
  227. m.g_defdrive   = SET("DEFAULT")
  228.  
  229. * Default values for data items prompted for in the interface.  Once the user runs the 
  230. * Wizard the first time, his previous choices are stored in DKSETUP.INI and become the 
  231. * defaults for future sessions.
  232. m.g_sourcedir  = ""     && the "root" of the application
  233. m.g_cprsdir    = ""     && where the compressed files go
  234. m.g_destdir    = ""     && root of destination tree
  235. m.g_targetdir  = ""     && default directory on ultimate user's machine
  236. m.g_dsk144     = .T.    && make 1.44 meg disks?
  237. m.g_dsk12      = .F.    && make 1.2  meg disks?
  238. m.g_dsk720     = .F.    && make 720K disks?
  239. m.g_instgraph  = .F.    && Install MSGraph?
  240. m.g_pmdescript = ""     && ProgMan description
  241. m.g_pmgroup    = ""     && ProgMan group
  242. m.g_usealtcfg  = 0      && Use alternative CONFIG.FPW file?
  243. m.g_altcfgfile = ""     && name of alternative CONFIG.FPW file
  244. m.g_modoptions = 1      && allow user to modify PM Group and directory?
  245. m.g_nologo     = 1      && suppress FoxPro logo
  246. m.g_appname    = ""     && name of application
  247. m.g_executable = ""     && name of program to run after completion of setup
  248. m.g_title      = ""     && Banner to display during setup
  249. m.g_copyright  = ""     && Copyright notice to display during setup
  250. m.g_parameters = ""     && optional parameters passed to user EXE
  251.  
  252. * Find the runtime files
  253. m.g_runtimedir = SYS(2004)+"DKSETUP"     && where the runtime files are by default
  254.  
  255. * Items that are stored in the INI file but not prompted for.
  256. m.g_splitsize  = c_units * 512   && split files down to this size
  257. m.g_algorithm  = "2"    && compression algorithm.  Can be 2 or 3.  2 is faster.  3 is smaller.
  258.  
  259. * Where is FOXW2500.ESL?
  260. m.g_esl        = SYS(2004)+c_eslfile       && name and location of ESL file
  261. m.g_eslextra   = .F.                       && is the ESL file outside the app tree?
  262.  
  263. * Name of the control file that records the files involved in this setup, their locations
  264. * and sizes, and the disks they are assigned to.  This file is written to the application
  265. * root directory.  It is not installed onto user disks.  
  266. m.g_dkcname   = "DKCONTRL.DBF"
  267. m.g_dbalias   = "DKCONTRL"
  268.  
  269. m.g_firstset  = .T.    && first set of disks (e.g., 1.44 meg) not yet completed
  270. m.g_newctrl   = .T.    && assume we are making a new DKCONTRL database.
  271. m.g_foxprint  = .T.    && is FoxPrint being installed?
  272.  
  273. m.g_thermwidth = 0     && set in Acttherm()
  274.  
  275. * Dimension the array that contains disk statistics (one row per disk).
  276. * Column 1 contains the number of files on the disk.  Column 2 contains the
  277. * actual nominal file size total for the disk.  Column 3 contains the bytes
  278. * in allocated clusters for the disk.
  279. m.g_diskcount = 1
  280. DIMENSION g_disks[1,c_diskcols]
  281. g_disks = 0
  282.  
  283. * Install the FOXTOOLS library.  This library contains many functions used throughout
  284. * the Wizard, including the filename parsing functions, the MessageBox function and the
  285. * CALLDLLs functions that we use to manage the DKSETUP.INI file.
  286. IF FILE(SYS(2004)+"FOXTOOLS.FLL")
  287.    SET LIBRARY TO (SYS(2004)+"FOXTOOLS.FLL") ADDITIVE
  288.    IF foxtoolver() < "1.01"
  289.       DO errormsg WITH en_fxtver, c_fatal
  290.       RETURN
  291.    ENDIF
  292. ELSE
  293.    * Don't use message box here, since the function to display it is inside FoxTools.
  294.    WAIT WINDOW e_foxtools NOWAIT
  295.    RETURN
  296. ENDIF
  297.  
  298. * Retrieve last set of user's responses
  299. DO getpreferences WITH c_setupini
  300.  
  301. * Start the wizard and allow the user to run through the screens
  302. IF dispatch() = c_cancel
  303.    RETURN TO dksetup
  304. ENDIF
  305.  
  306. * Record this set of responses
  307. DO putpreferences WITH c_setupini
  308. DO putpreferences WITH addbs(m.g_sourcedir)+justfname(c_setupini)
  309.  
  310. * Determine the compress directory
  311. m.g_cprsdir = addbs(m.g_destdir) + c_cprsdir
  312.  
  313. * Start the thermometer
  314. DO acttherm WITH c_setupname
  315. =updtherm(5)
  316.  
  317. * Create or open the control database
  318. m.dkcname = getctrl(addbs(m.g_sourcedir)+m.g_dkcname, @m.g_dbalias)
  319.  
  320. =updtherm(10)
  321.  
  322. * Fill in the dkcontrl file with the names of all the files we want to install
  323. DO gatherdir
  324.  
  325. =updtherm(15)
  326.  
  327. * Generate unique compression names for the files in the application tree.
  328. DO genuniq WITH m.dkcname
  329.  
  330. =updtherm(25)
  331.  
  332. * Add the list of required files (e.g., those used by the Setup Toolkit, such as
  333. * SHELL.DLL and VER.DLL) to the dkcontrl database.
  334. DO reqfiles
  335.  
  336. * Install FoxPrint fonts if they are present in the DKSETUP directory
  337. DO fpinst
  338.  
  339. =updtherm(35)
  340.  
  341. * Add any optional components (e.g., Graph runtime) that user has selected
  342. DO optinst
  343.  
  344. * Add the file to be executed at conclusion of setup, if any
  345. DO executinst
  346.  
  347. =updtherm(40)
  348.  
  349. * Lay out the files into disks.  Start with a new array for each set.
  350. IF m.g_dsk144
  351.    m.g_diskcount = 1
  352.    g_disks = 0   && initialize the array to 0
  353.    DO makedisks WITH c_dsk144, m.g_destdir
  354.    m.g_firstset = .F.
  355. ENDIF
  356. IF m.g_dsk12
  357.    m.g_diskcount = 1
  358.    g_disks = 0
  359.    DO makedisks WITH c_dsk12, m.g_destdir
  360.    m.g_firstset = .F.
  361. ENDIF
  362. IF m.g_dsk720
  363.    m.g_diskcount = 1
  364.    g_disks = 0
  365.    DO makedisks WITH c_dsk720, m.g_destdir
  366.    m.g_firstset = .F.
  367. ENDIF
  368.  
  369. =updtherm(100)
  370.  
  371. DO deactthermo
  372.  
  373. DO showsumry
  374.  
  375. *!*****************************************************************************
  376. *!
  377. *!     Procedure: INIT
  378. *!
  379. *!*****************************************************************************
  380. PROCEDURE init
  381. CREATE VIEW c_vuename
  382. CLOSE DATABASES
  383.  
  384. m.mlibrary = SET("LIBRARY",1)
  385. m.mstatus = SET("STATUS BAR")
  386. SET MESSAGE TO c_product + " " + c_setupname    && suppress database names, etc.
  387.  
  388. * These will be restored to their original values when the VUE file is restored.
  389. m.mtrbet = SET("TRBETWEEN")
  390. SET TRBETWEEN OFF
  391. m.mecho = SET("ECHO")
  392. SET ECHO OFF
  393. m.mdebug = SET("DEBUG")
  394. SET DEBUG OFF
  395. m.mstep = SET("STEP")
  396. SET STEP OFF
  397. m.mudfparms = SET("UDFPARMS")
  398. SET UDFPARMS TO VALUE
  399. m.mcompat = SET("COMPATIBLE")
  400. SET COMPATIBLE FOXPLUS
  401. m.mexact = SET("EXACT")
  402. SET EXACT OFF
  403. m.mnear = SET("NEAR")
  404. SET NEAR OFF
  405. m.munique = SET("UNIQUE")
  406. SET UNIQUE OFF
  407. m.mansi = SET("ANSI")
  408. SET ANSI OFF
  409. m.mcarry = SET("CARRY")
  410. SET CARRY OFF
  411. m.mpoint = SET("POINT")
  412. SET POINT TO "."
  413. m.decimals = SET("DECIMALS")
  414. m.mdefault = SET("DEFAULT")+CURDIR()
  415.  
  416. m.mescape = ON("ESCAPE")
  417. ON ESCAPE DO esc_handler
  418. m.merror = ON("ERROR")
  419. ON ERROR DO errorhandler WITH MESSAGE(), c_fatal
  420.  
  421. SELECT 0
  422. USE DISKS EXCLUSIVE
  423. SET ORDER TO TAG dtype
  424.  
  425. SELECT 0
  426. USE required EXCLUSIVE
  427.  
  428. SELECT 0
  429. USE naughty EXCLUSIVE
  430. SET ORDER TO TAG filname
  431.  
  432. *!*****************************************************************************
  433. *!
  434. *!     Procedure: CLEANUP
  435. *!
  436. *!*****************************************************************************
  437. PROCEDURE cleanup
  438. IF WEXIST("thermomete")
  439.    DO deactthermo
  440. ENDIF
  441. IF WEXIST("dksetup")
  442.    RELEASE WINDOW dksetup
  443. ENDIF
  444.  
  445. IF USED("naughty")   
  446.    SELECT naughty
  447.    USE
  448. ENDIF
  449. IF USED("required")   
  450.    SELECT required
  451.    USE
  452. ENDIF
  453. IF USED("disks")   
  454.    SELECT disks
  455.    USE
  456. ENDIF
  457. IF USED("dkcontrl")
  458.    SELECT dkcontrl
  459.    USE
  460. ENDIF        
  461. IF FILE(c_vuename_str)
  462.    SET VIEW TO c_vuename
  463.    DELETE FILE c_vuename
  464. ENDIF
  465.  
  466. ON ESCAPE &mescape
  467. ON ERROR &merror
  468.  
  469. IF !("FOXTOOLS" $ UPPER(m.mlibrary))
  470.    RELEASE LIBRARY (SYS(2004)+"FOXTOOLS.FLL")
  471. ENDIF
  472.  
  473. SET DEFAULT TO &mdefault
  474. SET STATUS BAR &mstatus
  475. SET TRBETWEEN &mtrbet
  476. SET ECHO &mecho
  477. SET DEBUG &mdebug
  478. SET STEP &mstep
  479. SET UDFPARMS TO &mudfparms
  480. SET COMPATIBLE &mcompat
  481. SET EXACT &mexact
  482. SET NEAR &mnear
  483. SET UNIQUE &munique
  484. SET ANSI &mansi
  485. SET CARRY &mcarry
  486. SET TALK &mtalk
  487. SET DECIMALS TO &mdecimals
  488. SET POINT TO "&mpoint"
  489. *!*****************************************************************************
  490. *!
  491. *!     Function: ERRORMSG
  492. *!
  493. *!*****************************************************************************
  494. FUNCTION errormsg
  495. PARAMETER m.msg, m.howbad
  496. PRIVATE m.icons, m.choice
  497.  
  498. * If the first parameter is a number, it's the index into the error_array array
  499. IF TYPE("m.msg") = "N"
  500.    m.msg = error_array[m.msg]
  501. ENDIF
  502.  
  503. * Message box defines
  504. #DEFINE mb_ok                    0
  505. #DEFINE mb_okcancel             1
  506. #DEFINE mb_abortretryignore 2
  507. #DEFINE mb_yesnocancel        3
  508. #DEFINE mb_yesno                4
  509. #DEFINE mb_retrycancel        5
  510. #DEFINE mb_iconhand             16
  511. #DEFINE mb_iconquestion        32
  512. #DEFINE mb_iconexclamation  48
  513. #DEFINE mb_iconasterisk     64
  514.  
  515. #DEFINE mb_iconinformation  mb_iconasterisk
  516. #DEFINE mb_iconstop           mb_iconhand
  517.  
  518. DO CASE
  519. CASE m.howbad = c_entry
  520.    m.icons = mb_iconstop + mb_ok
  521. CASE m.howbad = c_entry1
  522.    m.icons = mb_iconstop + mb_okcancel
  523. CASE m.howbad = c_entry2
  524.    m.icons = mb_iconstop + mb_yesno
  525. CASE m.howbad = c_status
  526.    m.icons = mb_iconexclamation + mb_okcancel
  527. CASE m.howbad = c_warning
  528.    m.icons = mb_iconstop + mb_ok
  529. CASE m.howbad = c_fatal
  530.    m.icons = mb_iconstop + mb_ok
  531. OTHERWISE
  532.    m.icons = mb_iconstop + mb_ok
  533. ENDCASE
  534.  
  535. m.choice = msgbox(msg,e_error_title,m.icons)
  536. DO CASE
  537. CASE m.howbad = c_fatal
  538.    RETURN idcancel
  539. CASE m.howbad = c_entry2
  540.    RETURN m.choice   && Yes or No
  541. CASE (m.howbad = c_warning) ;
  542.       OR (INLIST(m.howbad,c_status,c_entry1) AND m.choice = idcancel)
  543.    RETURN idcancel
  544. OTHERWISE
  545.    RETURN idok
  546. ENDCASE
  547.  
  548. *!*****************************************************************************
  549. *!
  550. *!     Procedure: ESC_HANDLER
  551. *!
  552. *!*****************************************************************************
  553. PROCEDURE esc_handler
  554. WAIT WINDOW s_escape NOWAIT
  555. RETURN TO dksetup
  556.  
  557. *!*****************************************************************************
  558. *!
  559. *!     Procedure: GETHELP
  560. *!
  561. *!*****************************************************************************
  562. PROCEDURE gethelp
  563. PARAMETER seekstrg
  564. m.in_area = SELECT()
  565. IF USED("dkhelp")
  566.    SELECT dkhelp
  567.    SET ORDER TO TAG topics
  568. ELSE
  569.    SELECT 0
  570.    USE dkhelp AGAIN ORDER TAG topics
  571. ENDIF
  572. SEEK seekstrg
  573. IF FOUND()
  574.    DO disphelp.spr
  575. ENDIF
  576. USE
  577. SELECT (m.in_area)
  578.  
  579. *!*****************************************************************************
  580. *!
  581. *!     Procedure: DISPATCH
  582. *!
  583. *!*****************************************************************************
  584. PROCEDURE dispatch
  585. * Manage the navigation from screen to screen
  586.  
  587. m.nextscrn = 1
  588. m.action = c_next
  589. DO WHILE m.action <> c_cancel AND m.action <> c_done
  590.    m.thisscrn = m.nextscrn   && nextscrn was set in the DKSCRNx.SPR program.
  591.    * Form the name of the next screen to go to.  The screens have to be numbered
  592.    * consecutively for this scheme to work properly.
  593.    DO ("dkscrn"+ALLTRIM(STR(nextscrn,2))+".spr") WITH m.action, m.thisscrn, m.nextscrn
  594.    @ 0.213,15.600 CLEAR TO 18.616, 97.800
  595. ENDDO
  596.  
  597. * Free the window that the interface uses
  598. IF WEXIST("DKSETUP")
  599.    RELEASE WINDOW dksetup
  600. ENDIF
  601.  
  602. RETURN m.action
  603.  
  604. *!*****************************************************************************
  605. *!
  606. *!     Procedure: CREATECTRL
  607. *!
  608. *!*****************************************************************************
  609. PROCEDURE createctrl
  610. PARAMETER m.dbfname
  611. *  Create the DBCONTRL file, which lists each file being copied to the destination disks.
  612. *  It has one record per file in the application tree, one record for each piece of a split
  613. *  file, and also contains records for Graph (if chosen), the executable program to run at
  614. *  the conclusion of setup, plus any required setup files or DLLs.
  615. *
  616. *  Its fields are as follows:
  617. *
  618. *   Fname    -- Character type     File name
  619. *   Filsize  -- Numeric            File size (see expndsize for split files, however)
  620. *   Fdate    -- Date               File date last changed
  621. *   Ftime    -- Character          File time
  622. *   Fattrib  -- Character          Attribute string
  623. *   Cprsname -- Character          Name of file when compressed
  624. *   Cprssize -- Numeric            Size of file when compressed
  625. *   Cprsflag -- Logical            Does file need to be compressed this pass?
  626. *   Expndsize-- Numeric            Expanded size, if a split file.  Same as filsize otherwise.
  627. *   Compress -- Logical            Is file ever compressed?
  628. *   Filfound -- Logical            Can the file be found?
  629. *   dest144  -- Numeric            Which 1.44meg disk does it go on?
  630. *   dest12   -- Numeric            Which 1.2 meg disk does it go on?
  631. *   dest720  -- Numeric            Which 720K disk does it go on?
  632. *   Setupfile-- Logical            Required file for SETUP.EXE?
  633. *   Extrafile-- Logical            Optional component (e.g., graph runtime)?
  634. *   Splitfile-- Logical            Is this a part of a split file?
  635. *   Parent   -- Character          Ultimate parent file, if this is a split file
  636. *   UniqueID -- Character          Matches parents and children
  637. * 
  638. PRIVATE ALL
  639. CREATE TABLE (m.dbfname) ( ;
  640.    fname C(80), ;
  641.    filsize N(10,0), ;
  642.    fdate D, ;
  643.    ftime C(10), ;
  644.    fattrib C(5), ;
  645.    cprsname C(12), ;
  646.    cprssize N(10,0), ;
  647.    expndsize N(10,0), ;
  648.    filfound l, ;
  649.    dest144 N(10,0), ;
  650.    dest12 N(10,0), ;
  651.    dest720 N(10,0), ;
  652.    setupfile l, ;
  653.    extrafile l, ;
  654.    cprsflag l, ;
  655.    COMPRESS l, ;
  656.    parent C(12), ;
  657.    splitfile l, ;
  658.    uniqueid C(12) ;
  659.    )
  660.  
  661. * Now construct the indexes we need
  662. INDEX ON UPPER(fname) TAG fname
  663. INDEX ON UPPER(cprsname) TAG cprsname
  664. INDEX ON STR(100000000-cprssize,10)+parent+cprsname TAG cprssize
  665. INDEX ON STR(dest144,3)+cprsname TAG dest144
  666. INDEX ON STR(dest12,3)+cprsname TAG dest12
  667. INDEX ON STR(dest720,3)+cprsname TAG dest720
  668. *!*****************************************************************************
  669. *!
  670. *!     Function: GETCTRL
  671. *!
  672. *!*****************************************************************************
  673. FUNCTION getctrl
  674. PARAMETER m.dbfname, m.aliasname
  675. PRIVATE m.numfiles
  676.  
  677. * First check for a zero-byte DKCONTRL file, which can be left hanging around
  678. * if a previous run of COMPRESS failed.
  679. m.numfiles = ADIR(rtdir,m.dbfname)
  680. IF m.numfiles = 1 AND rtdir[1,2] = 0
  681.    DELETE FILE (m.dbfname)
  682.    IF FILE(forceext(m.dbfname,"CDX"))
  683.       DELETE FILE (forceext(m.dbfname,"CDX"))
  684.    ENDIF
  685. ENDIF
  686.  
  687. * Create the control database if it doesn't already exist.  Open it.  Return the 
  688. * name of the database and the alias, which was passed in by reference.
  689. IF !FILE(m.dbfname) OR !FILE(forceext(m.dbfname,"CDX"))
  690.    DO createctrl WITH m.dbfname
  691.    m.g_newctrl = .T.
  692. ELSE 
  693.    m.g_newctrl = .F.   
  694. ENDIF
  695.  
  696. m.dbfstem = juststem(m.dbfname)
  697. IF USED(m.dbfstem)
  698.    SELECT (m.dbfstem)
  699. ELSE
  700.    SELECT 0
  701.    USE (m.dbfname) AGAIN EXCLUSIVE
  702. ENDIF
  703. IF TYPE("uniqueid") = "U"
  704.    DO errormsg WITH error_array[en_oldver],c_fatal
  705.    RETURN TO dksetup
  706. ENDIF
  707.  
  708. IF EMPTY(TAG(1)) AND FILE(forceext(m.dbfname,"CDX"))
  709.    SET INDEX TO (forceext(m.dbfname,"CDX"))
  710.    REINDEX
  711. ENDIF
  712.    
  713. SET ORDER TO TAG fname
  714. m.aliasname = ALIAS()
  715. RETURN m.dbfname
  716.  
  717. *!*****************************************************************************
  718. *!
  719. *!     Procedure: GATHERDIR
  720. *!
  721. *!*****************************************************************************
  722. PROCEDURE gatherdir
  723. * Read the application tree and record all the files in it.
  724. PRIVATE m.numeslfiles, m.eslaction
  725.  
  726. SET MESSAGE TO s_filling
  727.  
  728. SELECT (m.g_dbalias)
  729. REPLACE ALL filfound WITH .F.    && nothing found yet
  730.  
  731. * These get installed later
  732. DELETE ALL FOR extrafile AND !(UPPER(justfname(fname)) == UPPER(justfname(m.g_esl)))
  733.  
  734. PACK
  735.  
  736. * Filldir is a recursive function that puts the files in g_sourcedir and all
  737. * its subdirectories into the dkcontrl database.
  738. DO filldir WITH addbs(m.g_sourcedir)+"*.*",m.dkcname,"",m.g_dbalias
  739.  
  740. SELECT (m.g_dbalias)
  741. GOTO TOP
  742.  
  743. * Verify that the application EXE file was in there somewhere
  744. LOCATE FOR UPPER(ALLTRIM(justfname(fname))) == UPPER(ALLTRIM(justfname(m.g_appname)))
  745. IF !FOUND()
  746.    DO errormsg WITH error_array[en_exem1],c_fatal
  747.    RETURN TO dksetup
  748. ENDIF
  749.  
  750. DO instesl
  751.  
  752. *!*****************************************************************************
  753. *!
  754. *!     Procedure: FILLDIR
  755. *!
  756. *!*****************************************************************************
  757. PROCEDURE filldir
  758. *
  759. * Note: Recursive procedure!
  760. *
  761. * Find file names in the specified directory and all subdirectories beneath it.  Put
  762. * the filenames in dbfname.  Preface is the path to get to the files in the
  763. * directory we are searching.
  764. *
  765. * Dbalias is the alias of the DBCONTRL file.
  766. *
  767.  
  768. PARAMETER m.dirmask, m.dbfname, m.preface, m.dbalias, m.prevthere
  769. PRIVATE ALL
  770.  
  771. m.in_defa = SET("DEFAULT")+CURDIR()    && both drive and directory name
  772.  
  773. * Get actual filenames (no directories) in this directory
  774. m.numfiles = ADIR(dirlist,m.dirmask)
  775.  
  776. FOR m.i = 1 TO m.numfiles
  777.    * First make sure that this file isn't on the list of files we won't install.  Such
  778.    * files include portions of the FoxPro system that are not licensed to be distributed,
  779.    * miscellaneous files that the SetupWizard puts into the application tree (e.g.,
  780.    * the DKCONTRL files, etc.
  781.    SELECT naughty
  782.    SET ORDER TO TAG filname
  783.    SEEK ALLTRIM(UPPER(justfname(dirlist[m.i,1])))
  784.    IF !FOUND()   && not a prohibited file
  785.       SELECT (m.dbalias)
  786.       SET ORDER TO TAG fname
  787.       m.srchterm = addbs(m.preface) + dirlist[m.i,1]
  788.  
  789.       LOCATE FOR ALLTRIM(UPPER(fname)) == ALLTRIM(UPPER(m.srchterm)) AND EMPTY(parent) ;
  790.          AND !DELETED()
  791.       IF !FOUND()
  792.          APPEND BLANK
  793.          m.prevthere = .F.
  794.       ELSE
  795.          m.prevthere = .T.
  796.       ENDIF
  797.  
  798.       REPLACE fname WITH addbs(m.preface) + dirlist[m.i,1], ;
  799.          filsize WITH dirlist[m.i,2],;
  800.          fdate WITH dirlist[m.i,3],;
  801.          ftime WITH dirlist[m.i,4],;
  802.          fattrib WITH dirlist[m.i,5]
  803.  
  804.       IF !m.prevthere
  805.          REPLACE expndsize WITH filsize
  806.          REPLACE parent WITH ""
  807.          REPLACE splitfile WITH .F.        && assume no split for new file
  808.          REPLACE uniqueid WITH SYS(3)
  809.       ENDIF
  810.  
  811.       REPLACE COMPRESS WITH .T.    && all application files are candidates for compression
  812.       REPLACE filfound WITH .T.
  813.       REPLACE extrafile WITH .F.
  814.       REPLACE setupfile WITH .F.   && not a required file
  815.    ENDIF
  816.    SELECT (m.dbalias)
  817. ENDFOR
  818.  
  819. * Next, get all my child subdirectories. This program structure keeps us from
  820. * having too many big arrays hanging around on the stack as we recurse.
  821. SET DEFAULT TO (justpath(m.dirmask))
  822. m.numfiles = ADIR(dirlist,"","D")
  823. FOR m.i = 1 TO m.numfiles
  824.    IF !INLIST(dirlist[m.i,1], ".","..")
  825.       * recursive call!
  826.       DO filldir WITH addbs(justpath(m.dirmask))+ dirlist[m.i,1]+"\*.*", ;
  827.          m.dbfname, addbs(m.preface) + dirlist[m.i,1], m.dbalias
  828.    ENDIF
  829. ENDFOR
  830.  
  831. SET DEFAULT TO &in_defa
  832.  
  833. *!*****************************************************************************
  834. *!
  835. *!     Procedure: INSTESL
  836. *!
  837. *!*****************************************************************************
  838. PROCEDURE instesl
  839. PRIVATE m.numfiles, m.eslaction, m.cprscount, m.esldir, m.cprsdir, m.origsize
  840.  
  841. * Find the ESL file
  842. SELECT (m.g_dbalias)
  843.  
  844. GOTO TOP
  845. LOCATE FOR UPPER(ALLTRIM(justfname(fname))) == UPPER(ALLTRIM(justfname(m.g_esl)));
  846.    AND !DELETED() AND EMPTY(parent)
  847. IF FOUND()
  848.    m.g_esl = TRIM(fname)
  849.    
  850.    m.numfiles = ADIR(esldir,IIF(extrafile,TRIM(fname),addbs(m.g_sourcedir)+TRIM(fname)))
  851.    
  852.    m.g_eslextra = extrafile
  853.    
  854.    IF m.numfiles > 0
  855.       REPLACE filfound WITH .T.
  856.       * ESL file was in the DKCONTRL file and the original file exists.  Are we updating it?
  857.       m.origsize = filsize
  858.       REPLACE filsize WITH esldir[1,2], ;
  859.               fdate   WITH esldir[1,3], ;
  860.               ftime   WITH esldir[1,4], ;
  861.               fattrib WITH esldir[1,5]
  862.       m.cprscount = ADIR(cprsdir, addbs(m.g_cprsdir)+TRIM(cprsname))
  863.       IF m.cprscount > 0
  864.          IF (fdate > cprsdir[1,3]) OR (fdate = cprsdir[1,3] AND ftime > cprsdir[1,4]) ;
  865.                OR (filsize <> m.origsize)
  866.             * Delete earlier split pieces if we are updating the esl file
  867.             DO zapfrag WITH justfname(fname), justext(cprsname), .F.
  868.          ENDIF
  869.       ENDIF
  870.    ELSE
  871.       REPLACE filfound WITH .F.
  872.    ENDIF
  873. ELSE
  874.    m.eslaction = 1
  875.    DO noesl.spr WITH m.eslaction, c_eslfile
  876.    DO CASE
  877.    CASE m.eslaction = 1
  878.       * Find it.
  879.       m.g_esl = GETFILE("ESL","ESL-Datei","OK")
  880.       IF !EMPTY(m.g_esl)
  881.          m.numeslfiles = ADIR(esldir,m.g_esl)
  882.          IF m.numeslfiles > 0
  883.             APPEND BLANK
  884.             REPLACE fname WITH m.g_esl
  885.             REPLACE filsize WITH esldir[1,2]
  886.             REPLACE fdate WITH esldir[1,3]
  887.             REPLACE ftime WITH esldir[1,4]
  888.             REPLACE fattrib WITH esldir[1,5]
  889.  
  890.             REPLACE expndsize WITH filsize
  891.             REPLACE parent WITH ""
  892.             REPLACE splitfile WITH .F.   
  893.             REPLACE COMPRESS WITH .T.    && all application files are candidates for compression
  894.             REPLACE cprsflag WITH .T.
  895.             REPLACE filfound WITH .T.
  896.             REPLACE extrafile WITH .T.   && not in application tree
  897.             REPLACE setupfile WITH .F.   && not a required file
  898.             REPLACE uniqueID WITH SYS(3)
  899.             m.g_eslextra = .T.
  900.             
  901.             * Delete any occurrences of prior versions of ESL file from DKCONTRL.DBF file
  902.             SET EXACT ON
  903.             SCAN FOR INLIST(ALLTRIM(UPPER(justfname(fname))),UPPER(c_oldesl),UPPER(c_oldesl1))
  904.                IF FILE(addbs(m.g_cprsdir)+ALLTRIM(cprsname))
  905.                   DELETE FILE (addbs(m.g_cprsdir)+ALLTRIM(cprsname))
  906.                ENDIF
  907.                DELETE
  908.             ENDSCAN
  909.             PACK
  910.             SET EXACT OFF
  911.               
  912.          ENDIF
  913.       ELSE
  914.          RETURN TO dksetup
  915.       ENDIF
  916.    CASE m.eslaction = 2
  917.       * Continue
  918.       m.g_esl = SYS(3)  && to avoid any matches
  919.    CASE m.eslaction = 3
  920.       RETURN TO dksetup
  921.    ENDCASE
  922. ENDIF   
  923. GOTO TOP
  924.  
  925. *!*****************************************************************************
  926. *!
  927. *!     Procedure: GENUNIQ
  928. *!
  929. *!*****************************************************************************
  930. PROCEDURE genuniq
  931. PARAMETER m.dbfname
  932. PRIVATE m.startplace, m.thename
  933. * Generate unique names for the file names in "dbfname"
  934.  
  935. SET MESSAGE TO s_compressing
  936.  
  937. SELECT (m.g_dbalias)
  938. SET ORDER TO 0
  939. * Start by assuming that all files compress to their original names, except for
  940. * SCT, FRT, etc. files that have the last two letters of their extensions reversed
  941. * so as not to collide with their SCX and FRX counterparts.  Don't overwrite the
  942. * random names just yet so that we have a fighting chance of detecting whether their
  943. * source file needs to be compressed again.  Don't overwrite split filenames either
  944. * since their cprsnames are already set.
  945.  
  946. * Also account for the $ naming substitution that COMPRESS does.  It puts a $ in the
  947. * last available position of the extension to indicate that this is a compressed file.
  948. SCAN
  949.    DO CASE
  950.    CASE setupfile
  951.       REPLACE cprsname WITH justfname(fname)
  952.    CASE splitfile
  953.       * Leave the compress name alone.  This was a split file.
  954.    CASE !COMPRESS        && file isn't compressed, so use its regular name
  955.       REPLACE cprsname WITH justfname(fname)
  956.    CASE EMPTY(cprsname)
  957.       REPLACE cprsname WITH gencprsname(mapname(justfname(fname)))
  958.    OTHERWISE
  959.       REPLACE cprsname WITH gencprsname(cprsname)
  960.    ENDCASE
  961. ENDSCAN
  962.  
  963. * Ensure that there aren't any filename collisions among files in the application tree.
  964. SET ORDER TO TAG cprsname
  965. SCAN
  966.    m.thename = ALLTRIM(cprsname)
  967.    m.startplace = RECNO()
  968.    SKIP
  969.  
  970.    * Replace any further occurrences of this compressed file name with a random name
  971.    DO WHILE !EOF() AND cprsmatch(m.thename,ALLTRIM(cprsname))
  972.       REPLACE cprsname WITH gencprsname(SYS(3)+"."+c_randext)
  973.  
  974.       * Back to original record, since the last REPLACE moved the index position.  We
  975.       * are in cprsname order and substituting the SYS(3) name moved us someplace else in
  976.       * the index.
  977.       GOTO m.startplace
  978.  
  979.       SKIP
  980.    ENDDO
  981.  
  982.    GOTO m.startplace
  983. ENDSCAN
  984.  
  985. SET ORDER TO TAG fname
  986.  
  987. *!*****************************************************************************
  988. *!
  989. *!     Procedure: MAKEDISKS
  990. *!
  991. *!*****************************************************************************
  992. PROCEDURE makedisks
  993. PARAMETERS m.disktype, m.destination
  994. PRIVATE m.retval
  995.  
  996. * Figure out what needs to be compressed and does the compression.  Allocates
  997. * files to disks.  Copies files to the destination directory tree.
  998.  
  999. IF m.g_firstset
  1000.    m.destination = trimpath(m.destination)
  1001.    m.g_cprsdir = trimpath(m.g_cprsdir)
  1002.    
  1003.    * Simple check to handle \FOO\BAR\ when neither FOO nor BAR exists now.  Only
  1004.    * go to two levels, however.
  1005.    IF !EMPTY(justpath(m.destination)) AND justpath(m.destination) <> "\"
  1006.       m.retval = mkdir(justpath(m.destination))
  1007.       IF m.retval <> 0 AND m.retval <> 6
  1008.          DO errormsg WITH error_array[en_baddir] + " " + justpath(m.destination), c_fatal 
  1009.          RETURN TO dksetup
  1010.       ENDIF
  1011.    ENDIF
  1012.    
  1013.    m.retval = mkdir(m.destination)         && silently create the destination/compress directories.
  1014.    IF m.retval <> 0 AND m.retval <> 6
  1015.       DO errormsg WITH error_array[en_baddir] + " " + m.destination, c_fatal 
  1016.       RETURN TO dksetup
  1017.    ENDIF
  1018.    
  1019.    m.retval = mkdir(m.g_cprsdir)
  1020.    IF m.retval <> 0 AND m.retval <> 6
  1021.       DO errormsg WITH error_array[en_baddir] + " " + m.g_cprsdir, c_fatal 
  1022.       RETURN TO dksetup
  1023.    ENDIF
  1024.  
  1025.    * Delete files from DKCONTRL.DBF that couldn't be found.  Don't delete records
  1026.    * for split files, however, unless their parent file was deleted from the application
  1027.    * tree.  Split files aren't in the app directory, but they are in the compressed directory.
  1028.    DO killctrl
  1029.  
  1030.    * Make and execute the batch file to compress files.
  1031.    DO makecprsbatch WITH m.disktype
  1032.  
  1033.    =updtherm(75)
  1034.  
  1035.    * Determine compressed file sizes and update the dkcontrl database.  This procedure
  1036.    * also detects which files were split (if any) and records them in the dkcontrl database.
  1037.    DO getcprssize
  1038. ENDIF
  1039.  
  1040. * Assign compressed files to specific disks in dkcontrl
  1041. DO shuffle WITH m.disktype, m.destination
  1042. DO makeinf WITH m.disktype, addbs(m.g_runtimedir)+c_setupinf
  1043.  
  1044. * Put the INF file onto disk 1 in DBCONTRL.DBF
  1045. =putondisk(c_setupinf, 1,.T.,.T.,.F.,"")
  1046.  
  1047. * Create the SETUP.LST file and put it on disk 1
  1048. DO makelst WITH addbs(m.g_runtimedir)+c_setuplst
  1049. =putondisk(c_setuplst, 1,.T.,.T.,.F.,"")
  1050.  
  1051. g_disks = 0
  1052. g_diskcount = 0
  1053.  
  1054. * Do it again to make sure that the INF file can fit on disk 1
  1055. DO shuffle WITH m.disktype, m.destination
  1056. DO makeinf WITH m.disktype, addbs(m.g_runtimedir)+c_setupinf
  1057.  
  1058. * Copy the files to the destination tree
  1059. DO copyfiles WITH m.disktype, m.destination
  1060.  
  1061. *!*****************************************************************************
  1062. *!
  1063. *!     Procedure: KILLCTRL
  1064. *!
  1065. *!*****************************************************************************
  1066. PROCEDURE killctrl
  1067. PRIVATE m.numfiles, m.thisrec, m.thisid, m.therec, m.therec1, m.killfname
  1068. SELECT (m.g_dbalias)
  1069. SET ORDER TO 0
  1070.  
  1071. * Get rid of any records in the control file that don't have corresponding
  1072. * files in the source tree.  This would occur if the user was updating a previous
  1073. * run of the SetupWizard and had deleted some of his files in the meantime.
  1074. DELETE ALL FOR !filfound AND !splitfile
  1075.  
  1076. * Delete all splitfiles that don't have a record in the compress directory already
  1077. SCAN FOR splitfile
  1078.    m.killfname = ""
  1079.    DO CASE
  1080.    CASE EMPTY(parent) AND !filfound  && this is a parent file that isn't in the app tree
  1081.       m.killfname = ALLTRIM(justfname(fname))
  1082.    CASE !FILE(addbs(m.g_cprsdir) + TRIM(cprsname))   && child 
  1083.       m.killfname = ALLTRIM(justfname(fname))
  1084.    ENDCASE
  1085.    
  1086.    * If any of the pieces are deleted from the compress directory, delete the rest of them
  1087.    * now and also clean out the DKCONTRL file of all references to this file.
  1088.    IF !EMPTY(m.killfname)
  1089.       WAIT WINDOW s_cleanup + " " + m.killfname NOWAIT
  1090.       m.therec = RECNO()
  1091.       GOTO TOP
  1092.       * Scan through all the children
  1093.       SCAN FOR !EMPTY(parent) ;
  1094.              AND UPPER(ALLTRIM(justfname(fname))) == UPPER(ALLTRIM(m.killfname))
  1095.          DELETE
  1096.          * Delete the compressed file, if it exists
  1097.          IF FILE(addbs(m.g_cprsdir) + TRIM(cprsname))
  1098.             DELETE FILE (addbs(m.g_cprsdir) + TRIM(cprsname))
  1099.          ENDIF
  1100.       ENDSCAN
  1101.       * Now get the parent
  1102.       SCAN FOR EMPTY(parent) ;
  1103.               AND UPPER(ALLTRIM(justfname(fname))) == UPPER(ALLTRIM(m.killfname))
  1104.          * Delete the first compressed file if it exists
  1105.          IF FILE(addbs(m.g_cprsdir) + TRIM(cprsname))
  1106.             DELETE FILE  (addbs(m.g_cprsdir) + TRIM(cprsname))
  1107.          ENDIF
  1108.          REPLACE splitfile WITH .F.
  1109.          
  1110.          IF !filfound   && not in application tree either
  1111.             DELETE
  1112.          ENDIF
  1113.          
  1114.       ENDSCAN      
  1115.       GOTO m.therec
  1116.    ENDIF
  1117. ENDSCAN
  1118. PACK
  1119. =inkey(1)
  1120. WAIT CLEAR
  1121. *!*****************************************************************************
  1122. *!
  1123. *!     Procedure: MAKECPRSBATCH
  1124. *!
  1125. *!*****************************************************************************
  1126. PROCEDURE makecprsbatch
  1127. PARAMETER m.dsktype
  1128. PRIVATE m.in_safe, m.i, m.numcprs, m.batname, m.got_one, m.in_area, m.in_defa, m.j, ;
  1129.    m.nextfile, m.pos
  1130.  
  1131. * Use MAKE logic to decide what needs to be compressed.  Create a batch file
  1132. * to call the compression program.
  1133.  
  1134. SET MESSAGE TO s_batch
  1135.  
  1136. * Assume everything needs to be compressed that can be compressed.
  1137. REPLACE ALL cprsflag WITH COMPRESS
  1138.  
  1139. * Now get a list of files that are already in the compress directory from an
  1140. * earlier run of the SetupWizard.
  1141. SET ORDER TO cprsname
  1142. m.numcprs = ADIR(rtdir,addbs(m.g_cprsdir)+"*.*")
  1143. IF m.numcprs > 0
  1144.    =ASORT(rtdir)   && to make sure that children always follow parents
  1145. ENDIF   
  1146. m.i = 1
  1147. DO WHILE m.i <= m.numcprs
  1148.    * If the file exists already, match it with the date of the file in the application
  1149.    * directory.  If it has the same or a later date, don't compress it again.  If it
  1150.    * is earlier, compress it again.
  1151.    *
  1152.    * If there is a file in the compress directory that doesn't correspond to one in the
  1153.    * application directory, it's probably a file that the user deleted.  Delete it from the
  1154.    * compress directory also.
  1155.  
  1156.    SEEK UPPER(ALLTRIM(rtdir[m.i,1]))
  1157.    DO CASE
  1158.    CASE FOUND()  && it's one we want to include and it's already there.
  1159.       DO CASE
  1160.       CASE (rtdir[m.i,3] > fdate OR (rtdir[m.i,3] = fdate AND rtdir[m.i,4] >= TRIM(ftime))) ;
  1161.              AND rtdir[m.i,2] > 0
  1162.          * The compressed file is current.  No need to compress it again.  Also, it isn't a
  1163.          * zero byte file, possibly left over from a previous failed COMPRESS.
  1164.          REPLACE cprsflag WITH .F.
  1165.          REPLACE cprssize WITH rtdir[m.i,2]
  1166.       CASE splitfile
  1167.          * The file exists in the compress directory and in DKCONTRL.  The compress directory
  1168.          * one is older.  Delete it and its relations now so that the user doesn't get a 
  1169.          * confusing question from COMRPESS.EXE about overwriting the file.
  1170.          DO zapfrag WITH justfname(fname), justext(cprsname), .F.
  1171.          REPLACE cprsflag WITH .T., compress WITH .T.
  1172.  
  1173.          * Refresh the directory list now that some files have been deleted
  1174.          * Find the next file to be scanned.  Skip deleted files, which are probably
  1175.          * children of the one we started with that have recently been zapped.
  1176.          m.pos = m.i + 1
  1177.          DO WHILE m.pos <= m.numcprs AND !FILE(addbs(m.g_cprsdir)+rtdir[m.pos,1])
  1178.             m.pos = m.pos + 1
  1179.          ENDDO
  1180.          IF m.pos > m.numcprs
  1181.             m.nextfile = ""
  1182.          ELSE
  1183.             m.nextfile = rtdir[m.pos,1]
  1184.          ENDIF
  1185.          
  1186.          * Get the revised directory
  1187.          m.numcprs = ADIR(rtdir,addbs(m.g_cprsdir)+"*.*")
  1188.          IF m.numcprs > 0
  1189.             =ASORT(rtdir)   && to make sure that children always follow parents
  1190.          ENDIF
  1191.                
  1192.          m.i = m.i - 1   && default position of next file to scan
  1193.          IF !EMPTY(m.nextfile)
  1194.             * Find the next file in the new, revised array
  1195.             FOR m.j = 1 TO m.numcprs
  1196.                IF rtdir[m.j,1] == m.nextfile
  1197.                   m.i = m.j - 1
  1198.                   EXIT
  1199.                ENDIF
  1200.             ENDFOR
  1201.          ENDIF
  1202.          
  1203.       OTHERWISE
  1204.          * The file exists in the compress directory and in DKCONTRL.  The compress directory
  1205.          * one is older.  Delete it now so that the user doesn't get a confusing question from
  1206.          * COMRPESS.EXE about overwriting the file.
  1207.          DELETE FILE (addbs(m.g_cprsdir)+TRIM(cprsname))
  1208.          REPLACE cprsflag WITH .T., compress WITH .T.
  1209.       ENDCASE
  1210.    CASE !m.g_newctrl
  1211.       * The file is there, but not in the DKCONTRL database (which we didn't just create).
  1212.       * Is it a split file?
  1213.       m.stem = juststem(rtdir[m.i,1])
  1214.       IF ISDIGIT(RIGHT(m.stem,1))
  1215.          * Can we find a plausable parent?
  1216.          SEEK CHRTRAN(m.stem,"0123456789","")
  1217.          IF FOUND() AND justext(cprsname) == justext(rtdir[m.i,1])
  1218.             * It appears to be a split file.  Leave it here.
  1219.             REPLACE cprsflag WITH .F.   && don't compress a split file again
  1220.          ELSE
  1221.             DELETE FILE (addbs(m.g_cprsdir) + rtdir[m.i,1])
  1222.          ENDIF
  1223.       ELSE
  1224.          DELETE FILE (addbs(m.g_cprsdir) + rtdir[m.i,1])
  1225.       ENDIF
  1226.    OTHERWISE
  1227.       DELETE FILE (addbs(m.g_cprsdir) + rtdir[m.i,1])
  1228.    ENDCASE
  1229.    
  1230.    m.i = m.i + 1 
  1231. ENDDO
  1232.  
  1233. m.in_defa = SET("DEFAULT") + CURDIR()
  1234. SET DEFAULT TO (m.g_runtimedir)
  1235.  
  1236. * Find the COMPRESS.EXE file.  
  1237. DO CASE
  1238. CASE FILE("COMPRESS.EXE")
  1239.    m.cprsexe = "COMPRESS"               && no need for path information.
  1240. CASE FILE(addbs(m.g_runtimedir)+"COMPRESS.EXE")
  1241.    m.cprsexe = addbs(m.g_runtimedir)+"COMPRESS.EXE"
  1242. CASE FILE(FULLPATH("COMPRESS.EXE",1))   && search DOS path
  1243.    m.cprsexe = "COMPRESS"               && no need for path information.
  1244. CASE FILE(SYS(2004)+"DKSETUP\COMPRESS.EXE")
  1245.    m.cprsexe = SYS(2004)+"DKSETUP\COMPRESS"
  1246. OTHERWISE
  1247.    m.cprsexe = GETFILE("EXE","COMPRESS.EXE")
  1248.    IF EMPTY(m.cprsexe)
  1249.       DO errormsg WITH error_array[en_nocompress], c_fatal
  1250.       RETURN TO dksetup
  1251.    ENDIF
  1252. ENDCASE
  1253.  
  1254. * Create a compression batch file in the current directory.  The file name must match the
  1255. * one that the PIF file is expecting.
  1256. m.batname = "SETUPWIZ.BAT"
  1257. m.in_safe = SET("SAFETY")
  1258. SET SAFETY OFF
  1259. COPY FILE setup.pif TO setupbat.pif
  1260.  
  1261. SET TEXTMERGE TO (m.batname)
  1262. SET TEXTMERGE ON
  1263. SET CONSOLE OFF
  1264. SET DECIMALS TO 0   && don't add extra 0's to file size, etc.
  1265. m.got_one = .F.     && nothing to compress yet
  1266. SCAN FOR cprsflag AND COMPRESS
  1267.    m.got_one = .T.
  1268.    * Make sure line will fit in 128-byte DOS command line
  1269.    IF LEN(m.cprsexe+addbs(m.g_sourcedir)+TRIM(fname)+addbs(m.g_cprsdir)+TRIM(cprsname))+17 > 128
  1270.       SET TEXTMERGE OFF
  1271.       SET TEXTMERGE TO
  1272.       SET CONSOLE ON
  1273.       IF FILE(m.batname)
  1274.          DELETE FILE (m.batname)
  1275.       ENDIF
  1276.       
  1277.       DELETE FILE setupbat.pif
  1278.       DO errormsg WITH error_array[en_toolong],c_fatal
  1279.       RETURN TO dksetup
  1280.    ENDIF
  1281.    IF extrafile
  1282.       * These are files such as the Graph runtime that aren't stored in the application
  1283.       * tree.  Fname contains a complete path specification.
  1284.       \\<<m.cprsexe>> -a<<m.g_algorithm>> -befl -z<<INT(m.g_splitsize/512)>>
  1285.       \\ <<TRIM(fname)>>
  1286.       \\ <<addbs(m.g_cprsdir)+TRIM(cprsname)>>
  1287.       \
  1288.    ELSE
  1289.       * Regular application file.  Fname contains a path relative to the g_sourcedir
  1290.       * directory.  The "710" here determines the size of the chunks that COMPRESS will
  1291.       * split a file into and is not directly related to the cluster size of any specific
  1292.       * disk we are creating.  It's the max number of 512-byte blocks that the output file
  1293.       * will contain before being split.  (710 x 512 = 363,520: two chunks will fit on a
  1294.       * 720K disk, 3 on a 1.2 meg and 4 on a 1.44meg floppy.)
  1295.       \\<<m.cprsexe>> -a<<m.g_algorithm>> -befl -z<<INT(m.g_splitsize/512)>>
  1296.       \\ <<addbs(m.g_sourcedir)+TRIM(fname)>>
  1297.       \\ <<addbs(m.g_cprsdir)+TRIM(cprsname)>>
  1298.       \
  1299.    ENDIF
  1300. ENDSCAN
  1301. SET DECIMALS TO &mdecimals
  1302. SET CONSOLE ON
  1303. SET TEXTMERGE OFF
  1304. SET TEXTMERGE TO
  1305.  
  1306. IF m.got_one
  1307.    m.choice = idyes
  1308.    * Remove the following comment to prompt before beginning compress operation
  1309.    * m.choice = msgbox("Bereit zur Dateikomprimierung. Jetzt beginnen?","Setup-Assistent",35)
  1310.    DO CASE
  1311.    CASE m.choice = idyes
  1312.       SET MESSAGE TO s_cprs
  1313.       RUN setupbat.pif
  1314.    CASE m.choice = idcancel
  1315.       RETURN TO dksetup
  1316.    ENDCASE
  1317. ENDIF
  1318.  
  1319. * See if any files were split.  If so, continue splitting them until they fit.
  1320. DO filsplit
  1321.  
  1322. DELETE FILE (m.batname)
  1323. DELETE FILE setupbat.pif
  1324. SET SAFETY &in_safe
  1325.  
  1326. SET DEFAULT TO &in_defa
  1327. RETURN
  1328.  
  1329.  
  1330. *!*****************************************************************************
  1331. *!
  1332. *!     Procedure: FILSPLIT
  1333. *!
  1334. *!*****************************************************************************
  1335. PROCEDURE filsplit
  1336. PRIVATE m.done, m.i, m.j, m.fnum, m.stem, m.ext, m.nextnum, m.parentrec, ;
  1337.    m.prevrec, m.prevname, m.nextname, m.batname, m.srch, m.prevnum, m.done
  1338.  
  1339. * See if any files were split.  If so, add the new split file to the DKCONTRL database,
  1340. * and compress it.  Keep going until no new split files appear, which means that we've
  1341. * compressed everything down as far as it will go.
  1342.  
  1343. m.batname = "SETUPWIZ.BAT"
  1344. m.in_safe = SET("SAFETY")
  1345. SET SAFETY OFF
  1346. COPY FILE setup.pif TO setupbat.pif
  1347.  
  1348. * Do while more split files turn up in the compressed directory
  1349. m.done = .F.
  1350. DO WHILE !m.done
  1351.    m.done = .T.   && assume no more files to split/compress
  1352.    m.numfiles = ADIR(rtdir,addbs(m.g_cprsdir)+"*.*")
  1353.    IF m.numfiles > 0
  1354.       =ASORT(rtdir,1)
  1355.    ENDIF
  1356.    FOR m.i = 1 TO m.numfiles
  1357.       SELECT (m.g_dbalias)
  1358.       SET ORDER TO TAG cprsname
  1359.       SEEK rtdir[m.i,1]
  1360.       IF !FOUND()
  1361.          * see if it looks like a newly-created split file
  1362.          m.stem = juststem(rtdir[m.i,1])
  1363.          IF ISDIGIT(RIGHT(m.stem,1))
  1364.             m.fnum = getfnum(m.stem)
  1365.             
  1366.             * Can we find a plausable parent?
  1367.             DO CASE
  1368.             CASE m.fnum = 1
  1369.                * Look for stemname ending in 0
  1370.                LOCATE FOR LEFT(juststem(cprsname),LEN(m.stem)-1) == LEFT(m.stem,LEN(m.stem)-1) ;
  1371.                   AND RIGHT(juststem(cprsname),1) = "0" ;
  1372.                   AND justext(cprsname) == justext(rtdir[m.i,1])
  1373.             CASE m.fnum = 2
  1374.                * Look for stemname ending in 1
  1375.                LOCATE FOR LEFT(juststem(cprsname),LEN(m.stem)-1) == LEFT(m.stem,LEN(m.stem)-1) ;
  1376.                   AND (RIGHT(juststem(cprsname),1) == "1") ;
  1377.                   AND justext(cprsname) == justext(rtdir[m.i,1])
  1378.                IF !FOUND()
  1379.                   DO CASE
  1380.                   CASE LEN(juststem(m.stem)) = 8
  1381.                      * Look for stemname ending in non-digit
  1382.                      LOCATE FOR LEN(juststem(cprsname)) >= 7 ;
  1383.                         AND LEFT(juststem(cprsname),7) == LEFT(m.stem,7) ;
  1384.                         AND !ISDIGIT(RIGHT(juststem(cprsname),1)) ;
  1385.                         AND justext(cprsname) == justext(rtdir[m.i,1])
  1386.                   OTHERWISE
  1387.                      * Look for stemname ending in blank
  1388.                      LOCATE FOR LEFT(juststem(cprsname),LEN(m.stem)-1);
  1389.                              == LEFT(m.stem,LEN(m.stem)-1) ;
  1390.                         AND justext(cprsname) == justext(rtdir[m.i,1])
  1391.                   ENDCASE
  1392.                ENDIF   
  1393.             OTHERWISE
  1394.                m.prevnum = ALLTRIM(STR(fnum - 1,4))
  1395.                m.srch    = LEFT(m.stem,LEN(m.stem)-LEN(m.prevnum))+m.prevnum
  1396.                LOCATE FOR LEFT(juststem(cprsname),LEN(m.srch)) == m.srch ; 
  1397.                   AND justext(cprsname) == justext(rtdir[m.i,1])
  1398.             ENDCASE
  1399.             
  1400.             IF FOUND()
  1401.                * Found the previous file
  1402.                m.done = .F.
  1403.  
  1404.                m.parentrec = IIF(EMPTY(parent),uniqueid,parent)
  1405.                m.prevrec   = RECNO()
  1406.                m.prevname  = fname
  1407.  
  1408.                * Make a new record for this new file
  1409.                APPEND BLANK
  1410.                m.childrec = RECNO()
  1411.                REPLACE fname WITH m.prevname, ;
  1412.                   filsize WITH rtdir[m.i,2],;
  1413.                   fdate WITH rtdir[m.i,3],;
  1414.                   ftime WITH rtdir[m.i,4],;
  1415.                   fattrib WITH rtdir[m.i,5]
  1416.                REPLACE cprsname WITH rtdir[m.i,1]
  1417.                REPLACE cprssize WITH rtdir[m.i,2]
  1418.                REPLACE expndsize WITH filsize  && subject to revision
  1419.                REPLACE COMPRESS WITH .T.    && all application files are candidates for compression
  1420.                REPLACE filfound WITH .T.
  1421.                REPLACE extrafile WITH IIF(justfname(fname)==justfname(m.g_esl);
  1422.                    AND m.g_eslextra,.T.,.F.)
  1423.                REPLACE setupfile WITH .F.   && not a required file
  1424.                REPLACE parent WITH m.parentrec
  1425.                REPLACE uniqueID WITH SYS(3)
  1426.                REPLACE splitfile WITH .T.
  1427.  
  1428.                * If we just created file 9 and it is exactly the same size as the maximum
  1429.                * file, then report that we couldn't split this file into enough pieces.
  1430.                IF getfnum(cprsname) = 9 AND cprssize = m.g_splitsize
  1431.                   DO errormsg WITH error_array[en_cprserr]+justfname(fname);
  1432.                      +c_crlf+error_array[en_toobig], e_fatal
  1433.                   RETURN TO dksetup
  1434.                ENDIF
  1435.  
  1436.                * Record the uncompressed size of the last chunk
  1437.                GOTO m.prevrec
  1438.                
  1439.                IF rtdir[m.i,2] >= filsize    && detect previous unsuccessful splits
  1440.                   DO zapfrag WITH justfname(fname), justext(cprsname), .T.
  1441.                   RETURN TO dksetup
  1442.                ENDIF
  1443.                
  1444.                REPLACE expndsize WITH filsize - rtdir[m.i,2]
  1445.                REPLACE splitfile WITH .T.
  1446.  
  1447.                GOTO m.childrec
  1448.  
  1449.                IF rtdir[m.i,2] > m.g_splitsize
  1450.                   * Compress the new one.
  1451.                   m.batname = "SETUPWIZ.BAT"
  1452.                   COPY FILE setup.pif TO setupbat.pif
  1453.                   SET TEXTMERGE TO (m.batname)
  1454.                   SET TEXTMERGE ON
  1455.                   SET CONSOLE OFF
  1456.                   
  1457.                   IF LEN(s_splitting+" "+TRIM(fname)+" "+s_again) <= 60
  1458.                      WAIT WINDOW s_splitting+" "+TRIM(fname)+" "+s_again NOWAIT
  1459.                   ELSE
  1460.                      WAIT WINDOW s_splitting+" "+TRIM(justfname(fname))+" "+s_again NOWAIT
  1461.                   ENDIF
  1462.  
  1463.                   * Rename the fragment to be the original file name, but in the
  1464.                   * compressed directory.
  1465.                   IF FILE(addbs(m.g_cprsdir)+justfname(fname))
  1466.                      DELETE FILE (addbs(m.g_cprsdir)+justfname(fname))
  1467.                   ENDIF
  1468.  
  1469.                   * Rename the excess file back to the original name
  1470.                   RENAME (addbs(m.g_cprsdir))+rtdir[m.i,1] TO (addbs(m.g_cprsdir)+justfname(fname))
  1471.  
  1472.                   m.stem = juststem(rtdir[m.i,1])
  1473.                   m.ext = justext(rtdir[m.i,1])
  1474.                   m.fnum = getfnum(m.stem)
  1475.                   m.nextnum = ALLTRIM(STR(m.fnum+1,4))
  1476.                   m.nextname = LEFT(m.stem,LEN(m.stem) - LEN(m.nextnum)) + m.nextnum + "." + m.ext
  1477.  
  1478.                   \\<<m.cprsexe>> -a<<m.g_algorithm>> -befl -z<<INT(m.g_splitsize / 512)>>
  1479.                   \\ <<addbs(m.g_cprsdir)+justfname(fname)>>
  1480.                   \\ <<addbs(m.g_cprsdir)+rtdir[m.i,1]>>
  1481.                   \
  1482.                   SET TEXTMERGE OFF
  1483.                   SET TEXTMERGE TO
  1484.                   SET CONSOLE ON
  1485.  
  1486.                   RUN setupbat.pif
  1487.  
  1488.                   DELETE FILE (m.batname)
  1489.                   DELETE FILE setupbat.pif
  1490.  
  1491.                   * Delete the previous excess file
  1492.                   IF FILE(addbs(m.g_cprsdir)+justfname(fname))
  1493.                      DELETE FILE (addbs(m.g_cprsdir)+justfname(fname))
  1494.                   ENDIF
  1495.                   
  1496.                   IF !FILE(addbs(m.g_cprsdir)+rtdir[m.i,1])
  1497.                      * Compression was interrupted.  Clean up as best we can.
  1498.                      DO errormsg WITH error_array[en_cprsdead], c_fatal
  1499.                      
  1500.                      * Get rid of the DKCONTRL entries and the compressed files
  1501.                      m.thename = justfname(fname)
  1502.                      SCAN FOR justfname(fname) == m.thename
  1503.                         IF FILE(addbs(m.g_cprsdir) + cprsname)
  1504.                            DELETE FILE (addbs(m.g_cprsdir) + cprsname)
  1505.                         ENDIF
  1506.                         DELETE
  1507.                      ENDSCAN
  1508.                      PACK
  1509.                      
  1510.                      RETURN TO dksetup
  1511.                   ENDIF
  1512.  
  1513.                   SET SAFETY &in_safe
  1514.                ENDIF
  1515.             ENDIF
  1516.          ENDIF
  1517.       ENDIF
  1518.    ENDFOR
  1519. ENDDO
  1520. WAIT CLEAR
  1521.  
  1522. * Detect previous unsuccessful runs.  This is a second level check.  Theoretically,
  1523. * all errors like this should have been caught in killctrl where we match the compress
  1524. * directory files up against the DKCONTRL entries.
  1525. SCAN FOR expndsize <= 0 AND splitfile
  1526.    DO zapfrag WITH justfname(fname), justext(cprsname), .T.
  1527.    RETURN TO dksetup
  1528. ENDSCAN
  1529.  
  1530. *!*****************************************************************************
  1531. *!
  1532. *!     Function: GETFNUM
  1533. *!
  1534. *!*****************************************************************************
  1535. FUNCTION getfnum
  1536. PARAMETER m.filname
  1537. PRIVATE ALL
  1538. RETURN VAL(RIGHT(juststem(m.filname),1))
  1539.  
  1540. *!*****************************************************************************
  1541. *!
  1542. *!     Procedure: GETCPRSSIZE
  1543. *!
  1544. *!*****************************************************************************
  1545. PROCEDURE getcprssize
  1546. * This routine figures out the compressed file sizes of all the files in DKCONTRL.DBF.
  1547.  
  1548. PRIVATE m.i, m.numcprs, m.thestem, m.parentname, m.parentrec, m.thisrec, m.in_msg, ;
  1549.    m.parentstem
  1550.  
  1551. SET MESSAGE TO s_cprssize
  1552.  
  1553. SELECT (m.g_dbalias)
  1554. SET ORDER TO TAG cprsname
  1555. * Get the size of compressed files in the g_cprsdir directory
  1556. m.numcprs = ADIR(rtdir,addbs(m.g_cprsdir)+"*.*")
  1557. FOR m.i = 1 TO m.numcprs
  1558.    SEEK UPPER(ALLTRIM(rtdir[m.i,1]))
  1559.    IF FOUND()  && it's one we want to include and it's already there.
  1560.       REPLACE cprssize WITH rtdir[m.i,2]
  1561.    ENDIF
  1562. ENDFOR
  1563.  
  1564. * Show that files that aren't compressed have the same "compressed" size as the
  1565. * uncompressed size.
  1566. SET ORDER TO 0
  1567. REPLACE ALL cprssize WITH filsize FOR !COMPRESS AND !splitfile
  1568.  
  1569. *!*****************************************************************************
  1570. *!
  1571. *!     Procedure: SHUFFLE
  1572. *!
  1573. *!*****************************************************************************
  1574. PROCEDURE shuffle
  1575. PARAMETER m.disktype, m.rootdir
  1576.  
  1577. * Assign the files to specific disks.  This routine uses the following
  1578. * algorithm to decide which disks to put the files on.  It starts by
  1579. * allocating the setup files to the first disk.  SETUP.EXE requires most of 
  1580. * its files to be on disk1.  Next, it allocates the largest file to the 
  1581. * first disk.  Then it takes the second largest file and puts it on the first
  1582. * disk it will fit on, and so forth. There are other restrictions also.  
  1583. * The number of files that can fit in the root directory is limited '
  1584. * (224 for 1.44 meg disks, for example).  Also, if  a file has been split,
  1585. * all the pieces must appear successively.  SPLIT2 can't be on a disk before 
  1586. * split1.  They don't have to be consecutive (i.e., SPLIT1 could be
  1587. * on disk2 and SPLIT2 could be on disk4).This alorithm will sometimes not 
  1588. * result in the tightest packing, but it will usually produce good results.
  1589.  
  1590. PRIVATE m.cluster, m.totsize, m.dirname, m.maxfilenum
  1591.  
  1592. SELECT DISKS
  1593. SEEK m.disktype
  1594. IF FOUND()
  1595.    m.cluster    = DISKS->clustsize  && cluster size for this type of disk
  1596.    m.totsize    = DISKS->disksize   && max bytes on this disk
  1597.    m.dirname    = DISKS->dname      && name of disk type (e.g., 1.44 megabyte disks)
  1598.    m.maxfilenum = DISKS->maxfiles   && max files in root directory of this type disk
  1599.    SELECT (m.g_dbalias)
  1600.    REPLACE ALL (DISKS->diskfld) WITH 0
  1601. ELSE
  1602.    WAIT WINDOW "Ungⁿltiger Diskettentyp angegeben." NOWAIT   && shouldn't be possible
  1603.    RETURN TO dksetup
  1604. ENDIF
  1605.  
  1606. SELECT (m.g_dbalias)
  1607.  
  1608. * Put the setup files on first
  1609. SCAN FOR setupfile
  1610.    DO diskassgn WITH m.disktype, m.cluster, m.totsize, m.maxfilenum, m.dirname, splitfile
  1611. ENDSCAN
  1612.  
  1613. * Now allocate the remaining ordinary files to disks, making new disks as necessary
  1614. SELECT (m.g_dbalias)
  1615. SET ORDER TO TAG cprssize    && descending order by cprssize
  1616. SCAN FOR !setupfile AND !splitfile
  1617.    DO diskassgn WITH m.disktype, m.cluster, m.totsize, m.maxfilenum, m.dirname, splitfile
  1618. ENDSCAN
  1619.  
  1620. * Finally, allocate the split files to disk in the split order (i.e., split2 comes before
  1621. * split3)
  1622. SCAN FOR splitfile
  1623.    DO diskassgn WITH m.disktype, m.cluster, m.totsize, m.maxfilenum, m.dirname, splitfile
  1624. ENDSCAN
  1625.  
  1626. *!*****************************************************************************
  1627. *!
  1628. *!     Procedure: DISKASSGN
  1629. *!
  1630. *!*****************************************************************************
  1631. PROCEDURE diskassgn
  1632. PARAMETERS m.disktype, m.cluster, m.totsize, m.maxfilenum, m.dirname, m.split
  1633. * Take the current record in the dkcontrl file and assign it to a disk
  1634.  
  1635. PRIVATE m.numdisks, m.asize, m.dnum
  1636.  
  1637. SET MESSAGE TO s_assign + " " + s_to1 + " " +DISKS->dname
  1638.  
  1639. m.asize = allocsize(cprssize, m.cluster)
  1640. IF !m.split
  1641.    m.dnum = 1
  1642.    * Check for available space on each disk, but don't put more files onto the disk than
  1643.    * can fit in the root directory for this disk type (e.g., 224 for 1.44/1.2 meg, 112 for 720K)
  1644.    DO WHILE m.dnum <= m.g_diskcount ;
  1645.          AND ( (m.totsize - g_disks[m.dnum,3] < m.asize) ;
  1646.             OR (g_disks[m.dnum,1] >= m.maxfilenum) )
  1647.       m.dnum = m.dnum + 1
  1648.    ENDDO
  1649.    * If there isn't any room on any of the existing disks, make a new disk
  1650.    IF m.dnum > m.g_diskcount
  1651.       m.g_diskcount = m.g_diskcount + 1
  1652.       DIMENSION g_disks[m.g_diskcount,c_diskcols]
  1653.       g_disks[m.g_diskcount,1] = 1
  1654.       g_disks[m.g_diskcount,2] = cprssize
  1655.       g_disks[m.g_diskcount,3] = m.asize
  1656.    ELSE
  1657.       g_disks[m.dnum,1] = g_disks[m.dnum,1] + 1
  1658.       g_disks[m.dnum,2] = g_disks[m.dnum,2] + cprssize
  1659.       g_disks[m.dnum,3] = g_disks[m.dnum,3] + m.asize
  1660.    ENDIF
  1661. ELSE
  1662.    * Split files have to appear in successive order (SPLIT2 can't show up before SPLIT1).
  1663.    * If there is room, put on the last disk.  Otherwise make a new one.
  1664.    IF g_disks[m.g_diskcount,1] < m.maxfilenum ;
  1665.          AND m.totsize - g_disks[m.g_diskcount,3] >= m.asize
  1666.       * There is room for this file on the last disk
  1667.       g_disks[m.g_diskcount,1] = g_disks[m.g_diskcount,1] + 1
  1668.       g_disks[m.g_diskcount,2] = g_disks[m.g_diskcount,2] + cprssize
  1669.       g_disks[m.g_diskcount,3] = g_disks[m.g_diskcount,3] + m.asize
  1670.    ELSE
  1671.       m.g_diskcount = m.g_diskcount + 1
  1672.       DIMENSION g_disks[m.g_diskcount,c_diskcols]
  1673.       g_disks[m.g_diskcount,1] = 1
  1674.       g_disks[m.g_diskcount,2] = cprssize
  1675.       g_disks[m.g_diskcount,3] = m.asize
  1676.    ENDIF
  1677.    m.dnum = m.g_diskcount
  1678. ENDIF
  1679.  
  1680. SELECT DISKS
  1681. SEEK m.disktype
  1682.  
  1683. IF FOUND()
  1684.    SELECT (m.g_dbalias)
  1685.    REPLACE (DISKS->diskfld) WITH m.dnum
  1686. ENDIF
  1687. SELECT (m.g_dbalias)
  1688.  
  1689. *!*****************************************************************************
  1690. *!
  1691. *!     Procedure: REQFILES
  1692. *!
  1693. *!*****************************************************************************
  1694. PROCEDURE reqfiles
  1695. * Put the files in the REQUIRED.DBF list onto the disks, starting with disk1.
  1696. * These files may be compressed, but if so, then the ones in the g_runtimedir
  1697. * have already been compressed, so I don't have to worry about the ultimate file
  1698. * size on the install disks differing from their size in the g_runtimedir
  1699. * directory.
  1700.  
  1701. PRIVATE m.in_dir, m.thefile, m.gotit, m.i
  1702.  
  1703. SET MESSAGE TO s_required
  1704.  
  1705. * Find the files in the runtime directory.  It's possible that there could
  1706. * be files here that we don't want to install, so we can't just copy the filename
  1707. * information into the dkcontrl file without further checking against the REQUIRED.DBF
  1708. * file, stored inside the app.
  1709. m.numfiles = ADIR(rtdir,addbs(m.g_runtimedir)+"*.*")
  1710. IF m.numfiles = 0
  1711.    DO errormsg WITH error_array[en_nortfiles], c_fatal
  1712.    RETURN TO dksetup
  1713. ENDIF
  1714.  
  1715. SELECT (m.g_dbalias)
  1716. SET ORDER TO TAG fname
  1717.  
  1718. SELECT required
  1719. SCAN
  1720.    m.gotit = .F.
  1721.    * Find the directory information for this file
  1722.    FOR m.i = 1 TO m.numfiles
  1723.       IF ALLTRIM(UPPER(rtdir[m.i,1])) == ALLTRIM(UPPER(required->reqname))
  1724.          * At this point, we have a match between a file we need and a file we found
  1725.          * in the g_runtimedir directory.  Add a record for this file to the dkcontrl
  1726.          * file.
  1727.          SELECT (m.g_dbalias)
  1728.  
  1729.          SEEK UPPER(rtdir[m.i,1])   && seek the file name
  1730.          DO CASE
  1731.          CASE !FOUND()
  1732.             APPEND BLANK
  1733.          CASE DELETED()
  1734.             RECALL
  1735.          ENDCASE
  1736.          REPLACE fname WITH rtdir[m.i,1], ;
  1737.             filsize WITH rtdir[m.i,2], ;
  1738.             fdate WITH rtdir[m.i,3], ;
  1739.             ftime WITH rtdir[m.i,4], ;
  1740.             fattrib WITH rtdir[m.i,5]
  1741.          REPLACE expndsize WITH filsize
  1742.          REPLACE cprsname  WITH fname  && not compressed, so no different name
  1743.          REPLACE COMPRESS  WITH .F.    && required files are never compressed
  1744.          REPLACE filfound  WITH .T.    && we did find it
  1745.          REPLACE extrafile WITH .T.    && not relative to application tree
  1746.          REPLACE setupfile WITH .T.    && this is a required file
  1747.          REPLACE parent    WITH ""     && assume no split
  1748.          REPLACE splitfile WITH .F.
  1749.          REPLACE uniqueid  WITH SYS(3)
  1750.          m.gotit = .T.
  1751.          EXIT   && from the FOR loop
  1752.       ENDIF
  1753.    ENDFOR
  1754.  
  1755.    IF !m.gotit
  1756.       * This shouldn't be possible since any missing files should have been detected
  1757.       * when the runtime directory was specified.
  1758.       DO errormsg WITH TRIM(required->reqname) + " " + error_array[en_notfound], c_fatal
  1759.    ENDIF
  1760.  
  1761.    SELECT required
  1762. ENDSCAN
  1763.  
  1764. SELECT (m.g_dbalias)
  1765. RETURN
  1766.  
  1767. *!*****************************************************************************
  1768. *!
  1769. *!     Procedure: FPINST
  1770. *!
  1771. *!*****************************************************************************
  1772. PROCEDURE fpinst
  1773. PRIVATE m.targ, m.in_area
  1774. * Install FOXPRINT font if all associated files are in the runtime directory
  1775.  
  1776. m.in_area = SELECT()
  1777.  
  1778. SELECT 0
  1779. USE foxprint
  1780. SCAN
  1781.    DO CASE
  1782.    CASE foxprint->reldir = 0   && full path specified
  1783.       m.targ = foxprint->fname
  1784.    CASE foxprint->reldir = 1   && relative to FoxPro dir
  1785.       m.targ = SYS(2004) + foxprint->fname
  1786.    CASE foxprint->reldir = 2   && relative to runtime dir
  1787.       m.targ = addbs(m.g_runtimedir) + foxprint->fname
  1788.    ENDCASE
  1789.    IF !FILE(m.targ)
  1790.       m.g_foxprint = .F.
  1791.    ENDIF
  1792. ENDSCAN
  1793. USE
  1794. SELECT (m.in_area)
  1795. IF m.g_foxprint
  1796.    DO instfromdbf WITH "foxprint.dbf"
  1797. ENDIF
  1798.  
  1799. *!*****************************************************************************
  1800. *!
  1801. *!     Procedure: OPTINST
  1802. *!
  1803. *!*****************************************************************************
  1804. PROCEDURE optinst
  1805. * Install any optional components the user choses.  Each optional component needs
  1806. * to have its own DBF in the SETUP.APP file to list which files are associated with
  1807. * it.
  1808. IF m.g_instgraph
  1809.    DO instfromdbf WITH "msgraph.dbf"
  1810. ENDIF
  1811.  
  1812. *!*****************************************************************************
  1813. *!
  1814. *!     Procedure: INSTFROMDBF
  1815. *!
  1816. *!*****************************************************************************
  1817. PROCEDURE instfromdbf
  1818. PARAMETER m.optfname
  1819. * Put the files in the optfname list onto the disks.
  1820. PRIVATE m.in_area, m.thefile, m.gotit, m.i, m.grphpath, m.numfiles, m.srchname, m.in_dir
  1821.  
  1822. m.in_area = SELECT()
  1823. SELECT 0
  1824. USE (m.optfname) ALIAS optfname EXCLUSIVE AGAIN
  1825. SCAN
  1826.    DO CASE
  1827.    CASE reldir = 0   && file path is full path
  1828.       m.srchname = UPPER(TRIM(optfname->fname))
  1829.       IF !FILE(m.srchname)
  1830.          DO CASE
  1831.          CASE FILE(FULLPATH(m.srchname,1))   && search the DOS PATH for this file
  1832.             m.srchname = FULLPATH(m.srchname,1)
  1833.          CASE FILE(FULLPATH(m.srchname))     && search the FoxPro PATH for this file
  1834.             m.srchname = FULLPATH(m.srchname)
  1835.          OTHERWISE
  1836.             * Just leave it alone and display a GETFILE dialog below
  1837.          ENDCASE
  1838.       ENDIF
  1839.    CASE reldir = 1   && relative to FoxPro directory
  1840.       m.srchname = UPPER(SYS(2004) + TRIM(optfname->fname))
  1841.    CASE reldir = 2   && Relative to runtime files directory
  1842.       m.srchname = addbs(m.g_runtimedir) + TRIM(optfname->fname)
  1843.    ENDCASE
  1844.  
  1845.    m.optpath = justpath(m.srchname)
  1846.  
  1847.    * Find the files.
  1848.    m.numfiles = ADIR(rtdir,m.srchname)
  1849.  
  1850.    IF m.numfiles = 0     && one of the files couldn't be found.  Give option to locate it.
  1851.       DIMENSION rtdir[1,1]
  1852.       IF errormsg(justfname(TRIM(optfname->fname))+" "+error_array[en_notfound]+c_crlf;
  1853.             +error_array[en_getfile], c_entry2) == idyes
  1854.          rtdir[1,1] = GETFILE("","Wo ist "+TRIM(optfname->fname)+"?")
  1855.          IF EMPTY(rtdir[1,1])  && user pressed cancel in GETFILE()
  1856.             WAIT WINDOW s_canceling NOWAIT
  1857.             RETURN TO dksetup
  1858.          ELSE
  1859.             * Get the rest of the file specifications (e.g., size)
  1860.             m.optpath = justpath(rtdir[1,1])
  1861.             m.numfiles = ADIR(rtdir,rtdir[1,1])
  1862.          ENDIF
  1863.       ELSE
  1864.          WAIT WINDOW s_canceling NOWAIT
  1865.          RETURN TO dksetup
  1866.       ENDIF
  1867.    ENDIF
  1868.  
  1869.    SELECT (m.g_dbalias)
  1870.    SET ORDER TO TAG fname
  1871.    SEEK UPPER(rtdir[1,1])
  1872.    DO CASE
  1873.    CASE !FOUND()
  1874.       APPEND BLANK
  1875.    CASE DELETED()
  1876.       RECALL
  1877.    ENDCASE
  1878.    REPLACE fname WITH addbs(m.optpath)+rtdir[1,1], ;
  1879.       filsize WITH rtdir[1,2], ;
  1880.       fdate WITH rtdir[1,3], ;
  1881.       ftime WITH rtdir[1,4], ;
  1882.       fattrib WITH rtdir[1,5], ;
  1883.       cprsname WITH justfname(rtdir[1,1])
  1884.    REPLACE expndsize WITH optfname->expndsize
  1885.    REPLACE cprssize  WITH optfname->cprssize
  1886.    
  1887.    REPLACE filfound WITH .T.       && here it is
  1888.    REPLACE extrafile WITH .T.      && not relative to application tree
  1889.    REPLACE setupfile WITH .F.      && not a file required by setup
  1890.    REPLACE COMPRESS WITH optfname->COMPRESS   && may or may not be compressable
  1891.    REPLACE parent WITH ""          && assume no split
  1892.    REPLACE splitfile WITH .F.
  1893.    REPLACE uniqueid WITH SYS(3)
  1894. ENDSCAN
  1895.  
  1896. SELECT optfname
  1897. USE
  1898.  
  1899. SELECT (m.in_area)
  1900. RETURN
  1901.  
  1902. *!*****************************************************************************
  1903. *!
  1904. *!     Procedure: EXECUTINST
  1905. *!
  1906. *!*****************************************************************************
  1907. PROCEDURE executinst
  1908. PRIVATE m.numfiles, m.cpname, m.therec, m.spath
  1909. * Install file to be executed upon completion of setup.
  1910. IF !EMPTY(m.g_executable) AND FILE(wordnum(m.g_executable,1))
  1911.    * Look up file size, etc.
  1912.    m.numfiles = ADIR(rtdir,wordnum(m.g_executable,1))
  1913.    IF m.numfiles > 0    && it should be
  1914.       SELECT (m.g_dbalias)
  1915.       
  1916.       * See if the file is in the application tree already
  1917.       m.spath = addbs(m.g_sourcedir)
  1918.       LOCATE FOR m.spath == addbs(LEFT(justpath(wordnum(m.g_executable,1)),LEN(m.spath))) ;
  1919.          AND justfname(fname) == justfname(wordnum(m.g_executable,1))
  1920.          
  1921.       IF !FOUND()
  1922.          APPEND BLANK
  1923.          REPLACE fname WITH wordnum(m.g_executable,1) ;
  1924.             filsize WITH rtdir[1,2], ;
  1925.             fdate WITH rtdir[1,3], ;
  1926.             ftime WITH rtdir[1,4], ;
  1927.             fattrib WITH rtdir[1,5]
  1928.          REPLACE expndsize WITH filsize
  1929.          REPLACE filfound WITH .T.       && here it is
  1930.          REPLACE extrafile WITH .T.      && not relative to application tree
  1931.          REPLACE setupfile WITH .F.      && not a file required by setup
  1932.          REPLACE COMPRESS WITH .T.       && is compressable
  1933.          REPLACE parent WITH ""          && not split yet.
  1934.          REPLACE splitfile WITH .F.
  1935.          REPLACE uniqueID WITH SYS(3)
  1936.             
  1937.          * Ensure there isn't a compressed name collision
  1938.          m.therec = RECNO()
  1939.          m.cpname = gencprsname(rtdir[1,1])
  1940.          IF !israndom(cprsname)
  1941.             GOTO TOP
  1942.             LOCATE FOR UPPER(TRIM(cprsname)) == UPPER(m.cpname) ;
  1943.                 AND UPPER(ALLTRIM(fname)) <> UPPER(ALLTRIM(wordnum(m.g_executable,1)))
  1944.             IF FOUND()   && collision
  1945.                GOTO m.therec
  1946.                REPLACE cprsname WITH gencprsname(SYS(3)+"."+c_randext)
  1947.             ELSE
  1948.                GOTO m.therec
  1949.                REPLACE cprsname WITH m.cpname
  1950.             ENDIF
  1951.          ENDIF
  1952.       ENDIF
  1953.    ENDIF
  1954. ENDIF
  1955.  
  1956. *!*****************************************************************************
  1957. *!
  1958. *!     Procedure: COPYFILES
  1959. *!
  1960. *!*****************************************************************************
  1961. PROCEDURE copyfiles
  1962. * Copy files from the compress directory to the correct branch on the destination
  1963. * tree for the disk type selected.
  1964.  
  1965. PARAMETER m.disktype, m.destination
  1966. PRIVATE m.child, m.leafnum, m.leaf, m.outdir, m.batname, m.i, m.fldname
  1967.  
  1968. SELECT DISKS
  1969. SEEK m.disktype
  1970. IF FOUND()
  1971.    m.child = DISKS->diskdir
  1972.    m.fldname = TRIM(DISKS->diskfld)
  1973.    SELECT (m.g_dbalias)
  1974.    CALCULATE MAX(&fldname) TO m.lastdisk
  1975. ELSE
  1976.    WAIT WINDOW "Ungⁿltiger Diskettentyp angegeben." NOWAIT   && shouldn't happen
  1977.    RETURN TO dksetup
  1978. ENDIF
  1979.  
  1980. SELECT (m.g_dbalias)
  1981. SET ORDER TO TAG fname
  1982.  
  1983. SET MESSAGE TO s_mkdir
  1984.  
  1985. * Remove any existing DISK144/DISK12/DISK720 directory
  1986. DO zapdir WITH addbs(m.destination)+m.child, m.error_array
  1987.  
  1988. * Recreate the DISK144/DISK12/DISK720 directory
  1989. =mkdir(addbs(m.destination)+m.child)
  1990.  
  1991. * Make the disk1...diskn directories
  1992. FOR m.i = 1 TO INT(m.lastdisk)
  1993.    =mkdir(addbs(m.destination)+addbs(m.child)+"DISK"+ALLTRIM(STR(m.i,4)))
  1994. ENDFOR
  1995.  
  1996. SET ORDER TO TAG &fldname
  1997. SCAN FOR !EMPTY(cprsname)
  1998.    m.leafnum = &fldname
  1999.    m.leaf    = ALLTRIM(STR(m.leafnum,4))
  2000.  
  2001.    * Construct the name of the eventual output directory
  2002.    SET MESSAGE TO s_copying + " " + PROPER(TRIM(cprsname)) + " " + s_to2 + " " + DISKS->dname
  2003.    m.outdir = addbs(m.destination)+addbs(m.child)+ "DISK" + m.leaf
  2004.    DO CASE
  2005.    CASE setupfile
  2006.       * These come from the runtime directory--usually \FOXPROW\DKSETUP
  2007.       COPY FILE (addbs(m.g_runtimedir) + TRIM(cprsname)) TO (addbs(m.outdir)+TRIM(cprsname))
  2008.    CASE extrafile
  2009.       IF !COMPRESS
  2010.          COPY FILE (TRIM(fname)) TO (addbs(m.outdir)+TRIM(cprsname))
  2011.       ELSE
  2012.          COPY FILE (addbs(m.g_cprsdir) + TRIM(cprsname)) TO (addbs(m.outdir)+TRIM(cprsname))
  2013.       ENDIF
  2014.    OTHERWISE
  2015.       COPY FILE (addbs(m.g_cprsdir) + TRIM(cprsname)) TO (addbs(m.outdir)+TRIM(cprsname))
  2016.    ENDCASE
  2017. ENDSCAN
  2018.  
  2019. *!*****************************************************************************
  2020. *!
  2021. *!     Procedure: MAKEINF
  2022. *!
  2023. *!*****************************************************************************
  2024. PROCEDURE makeinf
  2025. PARAMETER m.disktype, m.setupname
  2026. * Create the SETUP.INF file for each disk type
  2027. PRIVATE m.fldname, m.i, m.numdisks, m.in_safe
  2028.  
  2029. SET MESSAGE TO s_makeinf
  2030.  
  2031. SELECT DISKS
  2032. SEEK m.disktype
  2033. m.fldname = DISKS->diskfld
  2034.  
  2035. SELECT (m.g_dbalias)
  2036. CALCULATE MAX(&fldname) TO m.numdisks
  2037. SET ORDER TO TAG fname
  2038.  
  2039. m.in_safe = SET("SAFETY")
  2040. SET SAFETY OFF
  2041.  
  2042. SET CONSOLE OFF
  2043. SET TEXTMERGE TO (m.setupname)
  2044. SET TEXTMERGE ON
  2045. \\[Source Media Descriptions]
  2046. \
  2047. FOR m.i = 1 TO m.numdisks
  2048.    \\    "<<ALLTRIM(STR(m.i,4))>>",
  2049.    \\"Disk <<ALLTRIM(STR(m.i,4))>>",
  2050.    GOTO TOP
  2051.    LOCATE FOR &fldname = m.i
  2052.    IF FOUND()
  2053.       \\"<<TRIM(cprsname)>>",
  2054.    ENDIF
  2055.    \\"..\DISK<<ALLTRIM(STR(m.i,4))>>"
  2056.    \
  2057. ENDFOR
  2058.  
  2059. * Emit the [Default File Settings] section
  2060. \[Default File Settings]
  2061. \"STF_BACKUP"     = ""
  2062. \"STF_COPY"       = "YES"
  2063. \"STF_DECOMPRESS" = "YES"
  2064. \"STF_OVERWRITE"  = "ALWAYS"
  2065. \"STF_READONLY"   = ""
  2066. \"STF_ROOT"       = ""
  2067. \"STF_SETTIME"    = ""
  2068. \"STF_TIME"       = "0"
  2069. \"STF_VITAL"      = "YES"
  2070.  
  2071. * Emit the setup specific information
  2072. \
  2073. \[FP SETUP]
  2074. \    TITLE=<<m.g_title>>
  2075. IF EMPTY(justdrive(m.g_targetdir))
  2076.    \    PATH=C:\<<IIF(LEFT(m.g_targetdir,1)=='\',SUBSTR(m.g_targetdir,2),m.g_targetdir)>>
  2077. ELSE
  2078.    \    PATH=<<m.g_targetdir>>
  2079. ENDIF   
  2080. \    GROUP=<<IIF(EMPTY(m.g_pmgroup),juststem(m.g_sourcedir),m.g_pmgroup)>>
  2081. DO CASE
  2082. CASE m.g_modoptions = c_modall
  2083.    \    FORCELOC="NO"
  2084. CASE m.g_modoptions = c_modgroup
  2085.    \    FORCELOC="GROUP ONLY"
  2086. CASE m.g_modoptions = c_modnone
  2087.    \    FORCELOC="YES"
  2088. ENDCASE   
  2089. \    COPYRIGHT=<<m.g_copyright>>
  2090. \    ESL=<<justpath(m.g_esl)>>
  2091. \    PROGRAM=<<SYS(2014,m.g_appname,addbs(m.g_sourcedir))>>
  2092.  
  2093. IF m.g_nologo = 1
  2094.    \\ -T
  2095. ENDIF
  2096. IF m.g_usealtcfg = 1 AND !EMPTY(m.g_altcfgfile)
  2097.    \\ -C<<m.g_altcfgfile>>
  2098. ENDIF
  2099. IF !EMPTY(m.g_parameters)
  2100.    \\ <<m.g_parameters>>
  2101. ENDIF
  2102.  
  2103. m.spath = addbs(m.g_sourcedir)
  2104. DO CASE
  2105. CASE EMPTY(m.g_executable)
  2106.    \    RUN=
  2107. CASE words(m.g_executable) = 1
  2108.    \    RUN=<<SYS(2014,m.g_executable,m.spath)>>
  2109. OTHERWISE
  2110.    \    RUN=<<SYS(2014,wordnum(m.g_executable,1),m.spath)>>
  2111.    FOR m.i = 2 TO words(m.g_executable)
  2112.       \\ <<wordnum(m.g_executable,m.i)>>
  2113.    ENDFOR   
  2114. ENDCASE
  2115. \    DESCRIPT=<<m.g_pmdescript>>
  2116.  
  2117. * Emit the section for the setup files
  2118. \
  2119. \[Sysfiles]
  2120. \
  2121. SELECT required
  2122. SCAN FOR CLASS = 1   && files that setup needs to install in the Windows system directory.
  2123.    * Find the file in the DKCONTRL database
  2124.    SELECT (m.g_dbalias)
  2125.    SET ORDER TO TAG fname
  2126.    SEEK TRIM(required->reqname)
  2127.    IF FOUND()
  2128.       m.disknum = &fldname
  2129.       \\    <<m.disknum>>,
  2130.       \\ <<TRIM(required->expndname)>>,
  2131.       \\,,,
  2132.       \\ <<TRIM(required->fdate)>>,,
  2133.       \\ 1033,
  2134.       \\ OLDER,
  2135.       \\ !READONLY,,
  2136.       \\ <<TRIM(required->expndname)>>,,,,
  2137.       \\ <<required->expndsize>>,
  2138.       \\ SYSTEM,
  2139.       \\,,
  2140.       \\ <<TRIM(required->version)>>,
  2141.       \\ VITAL
  2142.       \
  2143.    ELSE
  2144.       DO errormsg WITH error_array[en_missreq]+TRIM(fname), c_fatal   && shouldn't ever happen
  2145.    ENDIF
  2146.    SELECT required
  2147. ENDSCAN
  2148. SELECT (m.g_dbalias)
  2149.  
  2150. * Emit the entries for FOXPRINT if it is being installed
  2151. IF m.g_foxprint
  2152.    SELECT 0
  2153.    USE foxprint
  2154.    SCAN
  2155.       m.filname = justfname(UPPER(TRIM(foxprint->fname)))
  2156.       m.filname = IIF(foxprint->COMPRESS,gencprsname(m.filname),m.filname)
  2157.       SELECT (m.g_dbalias)
  2158.       SET ORDER TO TAG cprsname
  2159.       SEEK (m.filname)
  2160.       IF FOUND()
  2161.          m.disknum = &fldname
  2162.          \\    <<m.disknum>>,
  2163.          \\ <<TRIM(cprsname)>>,
  2164.          \\,,,,,, OLDER, !READONLY,,
  2165.          \\ <<TRIM(justfname(foxprint->expndname))>>,,,,
  2166.          \\ <<foxprint->expndsize>>,,,,,
  2167.          \\ !VITAL
  2168.          \
  2169.       ENDIF
  2170.    ENDSCAN
  2171.    SELECT foxprint
  2172.    USE
  2173.    SELECT (m.g_dbalias)
  2174.    SET ORDER TO TAG fname
  2175. ENDIF
  2176.  
  2177. * Emit the section for Graph files, if that option was selected
  2178. IF m.g_instgraph
  2179.    \
  2180.    \[MSGraph]
  2181.    \
  2182.    SELECT 0
  2183.    USE msgraph
  2184.    m.grphname = justfname(UPPER(TRIM(msgraph->fname)))
  2185.    m.grphname = IIF(msgraph->COMPRESS,gencprsname(m.grphname),m.grphname)
  2186.    SELECT (m.g_dbalias)
  2187.    SET ORDER TO TAG cprsname
  2188.    SEEK (m.grphname)
  2189.    IF FOUND()
  2190.       m.disknum = &fldname
  2191.       \\    <<m.disknum>>,
  2192.       \\ <<TRIM(cprsname)>>,
  2193.       \\,,,,,, OLDER, !READONLY,,
  2194.       \\ <<TRIM(justfname(msgraph->expndname))>>,,,,
  2195.       \\ <<msgraph->expndsize>>,,,,,
  2196.       \\ !VITAL
  2197.    ENDIF
  2198.    SELECT msgraph
  2199.    USE
  2200.    SELECT (m.g_dbalias)
  2201.    SET ORDER TO TAG fname
  2202. ENDIF
  2203.  
  2204. * Emit the [Application] section, containing application files plus the program to run at the
  2205. * conclusion of setup, if any.
  2206. *     6, appabout.prg,,,, 1993-01-18,,,, !READONLY,, foxapp\screens\appabout.prg,,,, 4084,,,,, !VITAL
  2207. \
  2208. \[Application]
  2209. \
  2210. SCAN FOR (!setupfile AND !extrafile) ;
  2211.       OR (extrafile AND (TRIM(UPPER(fname)) == UPPER(wordnum(m.g_executable,1)))) ;
  2212.       OR (extrafile AND m.g_eslextra ;
  2213.          AND (TRIM(UPPER(justfname(fname))) == UPPER(justfname(m.g_esl))))
  2214.    m.disknum = &fldname
  2215.    \\    <<m.disknum>>,
  2216.    \\ <<TRIM(cprsname)>>,
  2217.    DO CASE
  2218.    CASE (extrafile AND (TRIM(UPPER(fname)) == UPPER(wordnum(m.g_executable,1))))
  2219.       \\,
  2220.       \\,,,,,, !READONLY,,
  2221.       \\ <<TRIM(justfname(fname))>>,
  2222.    CASE EMPTY(parent) AND extrafile    && FOXW2500.ESL main piece
  2223.       \\,
  2224.       \\,,,,,, !READONLY,,
  2225.       \\ <<TRIM(justfname(fname))>>,
  2226.    CASE extrafile     && FOXW2500.ESL split piece
  2227.       \\ <<TRIM(justfname(fname))>>,
  2228.       \\,,,,,, !READONLY,,
  2229.       \\,
  2230.    CASE EMPTY(parent)
  2231.       \\,
  2232.       \\,,,,,, !READONLY,,
  2233.       \\ <<TRIM(fname)>>,
  2234.    OTHERWISE  && show that file should be appended to fname
  2235.       \\ <<TRIM(fname)>>,
  2236.       \\,,,,,, !READONLY,,
  2237.       \\,
  2238.    ENDCASE
  2239.    \\,,,
  2240.    IF splitfile     && show expanded size of split file piece.
  2241.       \\ <<expndsize>>,
  2242.    ELSE
  2243.       \\ <<filsize>>,
  2244.    ENDIF
  2245.    \\,,,,
  2246.    \\ !VITAL
  2247.    \
  2248. ENDSCAN
  2249.  
  2250. SET TEXTMERGE OFF
  2251. SET TEXTMERGE TO
  2252. SET CONSOLE ON
  2253. SET SAFETY &in_safe
  2254.  
  2255. RETURN
  2256.  
  2257. *!*****************************************************************************
  2258. *!
  2259. *!     Procedure: MAKELST
  2260. *!
  2261. *!*****************************************************************************
  2262. PROCEDURE makelst
  2263. PARAMETER m.thefile
  2264.  
  2265. SET TEXTMERGE TO (m.thefile)
  2266. SET TEXTMERGE ON
  2267. SET CONSOLE OFF
  2268.  
  2269. \[Params]
  2270. \    WndTitle   = <<IIF(EMPTY(m.g_title),s_setuptitle,m.g_title)>>
  2271. \    WndMess    = <<s_setupinit>>
  2272. \    TmpDirSize = 500
  2273. \    TmpDirName = ~msstfqf.t
  2274. \    CmdLine    = _mstest setup.mst /C "/S %s %s"
  2275. \    DrvModName = DSHELL
  2276. \
  2277. \[Files]
  2278. \    setup.ms_    = setup.mst
  2279. \    setup.in_    = setup.inc
  2280. \    setup.inf    = setup.inf
  2281. \    mscomstf.dl_ = mscomstf.dll
  2282. \    msinsstf.dl_ = msinsstf.dll
  2283. \    msuilstf.dl_ = msuilstf.dll
  2284. \    msshlstf.dl_ = msshlstf.dll
  2285. \    mscuistf.dl_ = mscuistf.dll
  2286. \    msdetstf.dl_ = msdetstf.dll
  2287. \    commdlg.dl_  = commdlg.dll
  2288. \    shell.dl_    = shell.dll
  2289. \    ver.dl_      = ver.dll
  2290. \    _mssetup.su_ = _mssetup.exe
  2291. \    _mstest.ex_  = _mstest.exe
  2292. \
  2293. SET CONSOLE ON
  2294. SET TEXTMERGE OFF
  2295. SET TEXTMERGE TO
  2296.  
  2297. *!*****************************************************************************
  2298. *!
  2299. *!     Procedure: SHOWSUMRY
  2300. *!
  2301. *!*****************************************************************************
  2302. PROCEDURE showsumry
  2303. * Report on the disks we just made
  2304. SET MESSAGE TO ""
  2305. SELECT (m.g_dbalias)
  2306. SET ORDER TO 0
  2307. IF m.g_dsk144
  2308.    DO psm WITH c_dsk144
  2309. ENDIF
  2310. IF m.g_dsk12
  2311.    DO psm WITH c_dsk12
  2312. ENDIF
  2313. IF m.g_dsk720
  2314.    DO psm WITH c_dsk720
  2315. ENDIF
  2316.  
  2317. SELECT (m.g_dbalias)
  2318.  
  2319. *!*****************************************************************************
  2320. *!
  2321. *!     Procedure: PSM
  2322. *!
  2323. *!*****************************************************************************
  2324. PROCEDURE psm
  2325. PARAMETER m.disktype
  2326. SELECT DISKS
  2327. SEEK m.disktype
  2328. IF FOUND()
  2329.    m.fldname = TRIM(DISKS->diskfld)
  2330.    m.clsize  = DISKS->clustsize
  2331.    * Note to translators: the strings like "Disk" do not need to be translated.  They
  2332.    * are field names and are not presented to the user.
  2333.    SELECT &fldname AS "Disk",;
  2334.       COUNT(dkcontrl.fname) AS "Files", ;
  2335.       SUM(allocsize(dkcontrl.cprssize,m.clsize)) AS "Bytes" ;
  2336.       FROM dkcontrl;
  2337.       GROUP BY &fldname ;
  2338.       INTO CURSOR dkset
  2339.    DO putsumry.spr WITH TRIM(DISKS->dname),DISKS->disksize, TRIM(disks->diskfld), m.clsize
  2340.    * Free the cursor we just created
  2341.    IF USED("dkset")
  2342.       SELECT dkset
  2343.       USE
  2344.    ENDIF
  2345. ENDIF
  2346. RETURN
  2347.  
  2348. *!*****************************************************************************
  2349. *!
  2350. *!     Function: PGETNAME
  2351. *!
  2352. *!*****************************************************************************
  2353. FUNCTION pgetname
  2354. PARAMETER m.pathname
  2355. PRIVATE ALL
  2356. m.pname = justfname(pathname)
  2357. IF splitfile
  2358.    m.num = getfnum(cprsname)
  2359.    DO CASE
  2360.    CASE m.num = 0 AND RIGHT(TRIM(juststem(cprsname)),1) = "0"
  2361.       RETURN m.pname + " (0)"
  2362.    CASE m.num = 0 AND RIGHT(TRIM(juststem(cprsname)),1) <> "0"
  2363.       RETURN m.pname + " (1)"
  2364.    OTHERWISE
  2365.       RETURN m.pname + " (" + ALLTRIM(STR(m.num,4)) + ")"
  2366.    ENDCASE
  2367. ELSE
  2368.    RETURN m.pname   
  2369. ENDIF
  2370.  
  2371. *!*****************************************************************************
  2372. *!
  2373. *!     Function: ZAPFRAG
  2374. *!
  2375. *!*****************************************************************************
  2376. PROCEDURE zapfrag
  2377. PARAMETER m.thefile, m.cprsext, m.putprompt
  2378.  
  2379. PRIVATE m.i, m.cleanup, m.jfname, m.thefile, m.cprscount, m.therec
  2380.  
  2381. SELECT (m.g_dbalias)
  2382. m.therec = RECNO()
  2383.  
  2384. m.jfname = justfname(m.thefile)
  2385. m.jstem  = juststem(m.thefile)
  2386. m.stemlen = LEN(m.jstem)
  2387.  
  2388. m.cleanup = 1
  2389. IF m.putprompt 
  2390.    DO badsplit.spr WITH m.thefile, m.cleanup
  2391. ENDIF
  2392.  
  2393. IF m.cleanup = 1
  2394.    * Delete the split file fragments for this file from the compressed directory.
  2395.    m.cprscount =ADIR(cprsfiles,addbs(m.g_cprsdir)+"*.*")
  2396.    FOR m.i = 1 TO m.cprscount
  2397.       DO CASE
  2398.       CASE m.jfname == justfname(cprsfiles[m.i,1])
  2399.          DELETE FILE (addbs(m.g_cprsdir)+cprsfiles[m.i,1])
  2400.       CASE m.jstem == juststem(cprsfiles[m.i,1]) ;
  2401.             AND justext(cprsfiles[m.i,1]) == m.cprsext
  2402.          DELETE FILE (addbs(m.g_cprsdir)+cprsfiles[m.i,1])
  2403.          
  2404.       CASE m.stemlen = 8 ;
  2405.             AND LEN(juststem(cprsfiles[m.i,1])) = 8 ;
  2406.             AND LEFT(m.jstem,7) == LEFT(juststem(cprsfiles[m.i,1]),7) ;
  2407.             AND isdigit(RIGHT(juststem(cprsfiles[m.i,1]),1)) ;
  2408.             AND justext(cprsfiles[m.i,1]) == m.cprsext
  2409.          DELETE FILE (addbs(m.g_cprsdir)+cprsfiles[m.i,1])
  2410.       CASE m.stemlen <= 7 AND isdigit(RIGHT(juststem(cprsfiles[m.i,1]),1)) ;
  2411.             AND justext(cprsfiles[m.i,1]) == m.cprsext
  2412.          * A possible split child file ...
  2413.          IF isdigit(RIGHT(m.jstem,1))
  2414.             * See if this is FAR25.EXE matching FAR26.EX$
  2415.             IF LEFT(m.jstem, m.stemlen - 1) ;
  2416.                == LEFT(juststem(cprsfiles[m.i,1]),LEN(juststem(cprsfiles[m.i,1]))-1)
  2417.                DELETE FILE (addbs(m.g_cprsdir)+cprsfiles[m.i,1])
  2418.             ENDIF
  2419.          ELSE
  2420.             IF m.jstem ;
  2421.                == LEFT(juststem(cprsfiles[m.i,1]),LEN(juststem(cprsfiles[m.i,1]))-1)
  2422.                * A file like FAR.EXE matches FAR2.EX$
  2423.                DELETE FILE (addbs(m.g_cprsdir)+cprsfiles[m.i,1])
  2424.             ENDIF
  2425.          ENDIF
  2426.       ENDCASE
  2427.    ENDFOR
  2428.    
  2429.    * Delete the DKCONTRL entries for the split pieces of this file
  2430.    SELECT (m.g_dbalias)
  2431.    
  2432.    SCAN FOR justfname(fname) == m.thefile AND splitfile AND EMPTY(parent)
  2433.       REPLACE splitfile WITH .F.
  2434.    ENDSCAN
  2435.    
  2436.    SCAN FOR justfname(fname) == m.thefile AND splitfile AND !EMPTY(parent)
  2437.       DELETE   
  2438.    ENDSCAN
  2439.    PACK
  2440. ENDIF
  2441.  
  2442. GOTO m.therec
  2443.  
  2444. RETURN
  2445. *!*****************************************************************************
  2446. *!
  2447. *!     Function: ALLOCSIZE
  2448. *!
  2449. *!*****************************************************************************
  2450. FUNCTION allocsize
  2451. * Compute the allocated size required for a file of size m.nominal on a disk with
  2452. * a cluster size of m.cluster.
  2453. PARAMETERS m.nominal, m.cluster
  2454. DO CASE
  2455. CASE m.cluster = 0
  2456.    RETURN -1   && invalid cluster size.  Test here to prevent division by zero.
  2457. CASE m.nominal = 0
  2458.    RETURN nominal
  2459. CASE m.nominal % m.cluster = 0
  2460.    RETURN m.nominal
  2461. OTHERWISE
  2462.    RETURN ((INT(m.nominal / m.cluster) + 1) * m.cluster)
  2463. ENDCASE
  2464.  
  2465. *!*****************************************************************************
  2466. *!
  2467. *!     Function: GENCPRSNAME
  2468. *!
  2469. *!*****************************************************************************
  2470. FUNCTION gencprsname
  2471. * Assign the compressed filename that COMPRESS.EXE will create
  2472. PARAMETER m.cname
  2473. m.cname = ALLTRIM(m.cname)
  2474. DO CASE
  2475. CASE RIGHT(m.cname,1) = "$"
  2476.    RETURN m.cname   
  2477. CASE LEN(justext(m.cname)) = 3
  2478.    RETURN forceext(m.cname,LEFT(justext(m.cname),2)+"$")
  2479. OTHERWISE
  2480.    RETURN forceext(m.cname,justext(m.cname)+"$")
  2481. ENDCASE
  2482.  
  2483. *!*****************************************************************************
  2484. *!
  2485. *!     Function: PUTONDISK
  2486. *!
  2487. *!*****************************************************************************
  2488. FUNCTION putondisk
  2489. PARAMETER m.fpath, m.diskno, m.extra, m.setup, m.cprs, m.prnt
  2490. * Assign file fpath to disk number m.diskno
  2491. * First find the file
  2492.  
  2493. m.numfiles = ADIR(rtdir,IIF(m.setup,addbs(m.g_runtimedir)+m.fpath,m.fpath))
  2494. IF m.numfiles > 0
  2495.    SELECT (m.g_dbalias)
  2496.    SET ORDER TO TAG fname
  2497.    SEEK m.fpath
  2498.    IF !FOUND()
  2499.       APPEND BLANK
  2500.    ENDIF
  2501.    REPLACE fname WITH m.fpath, ;
  2502.       filsize WITH rtdir[1,2], ;
  2503.       fdate WITH rtdir[1,3], ;
  2504.       ftime WITH rtdir[1,4], ;
  2505.       fattrib WITH rtdir[1,5]
  2506.  
  2507.    REPLACE cprsname WITH IIF(m.cprs,gencprsname(rtdir[1,1]),justfname(fname)), ;
  2508.       filfound WITH .T., ;
  2509.       extrafile WITH m.extra, ;
  2510.       setupfile WITH m.setup, ;
  2511.       COMPRESS WITH m.cprs, ;
  2512.       parent WITH m.prnt
  2513.    REPLACE splitfile WITH IIF(EMPTY(parent), .F., .T.)
  2514.    REPLACE cprssize WITH filsize
  2515.    REPLACE expndsize WITH filsize
  2516.    RETURN RECNO()
  2517. ENDIF
  2518. RETURN 0
  2519. *!*****************************************************************************
  2520. *!
  2521. *!     Function: MAPNAME
  2522. *!
  2523. *!*****************************************************************************
  2524. FUNCTION mapname
  2525. PARAMETER m.filname
  2526. * Compressed filenames have to be unique for Setup.  The compress utility replaces
  2527. * the last letter in the extension with an underscore.  This creates a problem with
  2528. * FoxPro since so many file extensions have the same first two letters (e.g., SCX, SCT).
  2529. * This routine tries to do something reasonable with the file name to make it unique.
  2530.  
  2531. m.theext = UPPER(justext(m.filname))
  2532.  
  2533. DO CASE
  2534. CASE m.theext == "SCT"
  2535.    RETURN forceext(m.filname,"STC")
  2536. CASE m.theext == "MNT"
  2537.    RETURN forceext(m.filname,"MTN")
  2538. CASE m.theext == "PJT"
  2539.    RETURN forceext(m.filname,"PTJ")
  2540. CASE m.theext == "FRT"
  2541.    RETURN forceext(m.filname,"FTR")
  2542. CASE m.theext == "LBT"
  2543.    RETURN forceext(m.filname,"LTB")
  2544. CASE m.theext == "SPX"
  2545.    RETURN forceext(m.filname,"SXP")
  2546. CASE m.theext == "MNX"
  2547.    RETURN forceext(m.filname,"MXN")
  2548. OTHERWISE
  2549.    RETURN m.filname
  2550. ENDCASE
  2551. *!*****************************************************************************
  2552. *!
  2553. *!     Function: ISRANDOM
  2554. *!
  2555. *!*****************************************************************************
  2556. FUNCTION israndom
  2557. * Returns .T. if m.filname appears to be a generated random name
  2558. PARAMETER m.filname
  2559. m.filname = UPPER(ALLTRIM(m.filname))
  2560. IF !EMPTY(m.filname) AND ISDIGIT(LEFT(m.filname,1)) ;
  2561.        AND ( ;
  2562.               (justext(m.filname) == c_randext) ;
  2563.            OR ( ;
  2564.               LEFT(justext(m.filname),2) == LEFT(c_randext,2) ;
  2565.               AND RIGHT(justext(m.filname),1) $ "$_" ;
  2566.               ) ;
  2567.            )
  2568.    RETURN .T.
  2569. ELSE
  2570.    RETURN .F.
  2571. ENDIF
  2572. *!*****************************************************************************
  2573. *!
  2574. *!     Function: CHECKFILES
  2575. *!
  2576. *!*****************************************************************************
  2577. FUNCTION checkfiles
  2578. PARAMETERS showerrormsg
  2579.  
  2580. * Returns TRUE if all files in the REQUIRED.DBF file are found in the g_runtimedir
  2581. * directory.  Used to validate the path entered in the g_runtimedir screen.
  2582. PRIVATE m.in_area, m.filemissing
  2583. m.in_area = SELECT()
  2584. m.filemissing = .F.
  2585. SELECT required
  2586. SCAN
  2587.    IF !FILE(forcepath(TRIM(required->reqname),g_runtimedir))
  2588.       m.filemissing = .T.
  2589.       IF !showerrormsg OR errormsg(ALLTRIM(required->reqname) ;
  2590.             + " " + error_array[en_notfound], c_entry1) = idcancel
  2591.          SELECT (m.in_area)
  2592.          RETURN .F.
  2593.       ENDIF
  2594.    ENDIF
  2595. ENDSCAN
  2596. SELECT (m.in_area)
  2597. RETURN !m.filemissing
  2598.  
  2599. *!*****************************************************************************
  2600. *!
  2601. *!     Function: CPRSMATCH
  2602. *!
  2603. *!*****************************************************************************
  2604. FUNCTION cprsmatch
  2605. * Do two filenames match after the compression program has changed the names?
  2606. PARAMETER fname1, fname2
  2607. DO CASE
  2608. CASE fname1 == fname2
  2609.    RETURN .T.
  2610. CASE LEN(fname1) = 12 AND LEN(fname2) = 12 AND LEFT(fname1,11) == LEFT(fname2,11)
  2611.    RETURN .T.
  2612. OTHERWISE
  2613.    RETURN .F.
  2614. ENDCASE
  2615. *!*****************************************************************************
  2616. *!
  2617. *!     Procedure: ZAPDIR
  2618. *!
  2619. *!*****************************************************************************
  2620. PROCEDURE zapdir
  2621. PARAMETER m.diskroot, m.error_array
  2622. PRIVATE ALL
  2623. * Delete any existing files in the destination tree
  2624.  
  2625. * Delete all the files in any of my children
  2626. m.numfiles = ADIR(rtdir,addbs(m.diskroot)+"*.*","D")
  2627. FOR m.i = 1 TO m.numfiles
  2628.    IF "D" $ rtdir[m.i,5] AND !INLIST(rtdir[m.i,1],"..",".")
  2629.       DO zapdir WITH addbs(m.diskroot)+rtdir[m.i,1], m.error_array
  2630.    ENDIF
  2631. ENDFOR
  2632.  
  2633. * Delete all the regular files in this directory
  2634. m.numfiles = ADIR(rtdir,addbs(m.diskroot)+"*.*")
  2635. FOR m.i = 1 TO m.numfiles
  2636.    DELETE FILE (addbs(m.diskroot)+rtdir[m.i,1])
  2637. ENDFOR
  2638.  
  2639. * Display an error message if there are any hidden or system files
  2640. m.numfiles = ADIR(rtdir,addbs(m.diskroot)+"*.*","SH")
  2641. FOR m.i = 1 TO m.numfiles
  2642.    * Hidden or system file found in C:\FOXPROW\FOO--QUUX.ABC
  2643.    DO errormsg WITH error_array[en_hidden]+m.diskroot+"--" +rtdir[m.i,1], c_warning
  2644. ENDFOR
  2645.  
  2646. IF m.numfiles = 0   && no hidden or system files.
  2647.    =rmdir(m.diskroot)
  2648. ENDIF
  2649.  
  2650. *!*****************************************************************************
  2651. *!
  2652. *!     Function: GETUFSIZE
  2653. *!
  2654. *!*****************************************************************************
  2655. FUNCTION getufsize
  2656. * Get the uncompressed file size for compressed file m.fname
  2657. PARAMETER m.fname
  2658. PRIVATE m.thesize, m.fp, m.buffer, m.numwords, m.theword, m.in_sec
  2659. m.thesize = "0"
  2660. IF FILE(m.fname)
  2661.    COPY FILE size.pif TO ufsize.pif
  2662.    SET TEXTMERGE TO usize.bat
  2663.    SET TEXTMERGE ON
  2664.    SET CONSOLE OFF
  2665.    IF FILE("usize.txt")
  2666.       DELETE FILE usize.txt
  2667.    ENDIF
  2668.    \\DECOMP -Q <<m.fname>> > usize.txt
  2669.    SET TEXTMERGE OFF
  2670.    SET TEXTMERGE TO
  2671.  
  2672.    IF !FILE("usize.bat")
  2673.       WAIT WINDOW "Fehler beim Erstellen der Stapelverarbeitungsdatei."   && shouldn't happen
  2674.    ENDIF
  2675.  
  2676.    * Run minimized.
  2677.    RUN ufsize.pif
  2678.  
  2679.    SET CONSOLE ON
  2680.  
  2681.    IF FILE("usize.bat")
  2682.       DELETE FILE usize.bat
  2683.    ENDIF
  2684.    IF FILE("ufsize.pif")
  2685.       DELETE FILE ufsize.pif
  2686.    ENDIF
  2687.    * Read the usize.txt file and extract the uncompressed size.
  2688.    IF FILE("usize.txt")
  2689.       m.fp = FOPEN("usize.txt")
  2690.       IF m.fp > 0
  2691.          DO WHILE !FEOF(m.fp)
  2692.             m.buffer = FGETS(m.fp)
  2693.             IF UPPER(LEFT(m.buffer,13)) == "DECOMPRESSION"
  2694.                * Start with word 8, which should be the file size
  2695.                m.thesize = wordnum(m.buffer,8)
  2696.                IF ISDIGIT(LEFT(m.thesize,1))
  2697.                   m.thesize = CHRTRAN(m.thesize," ,","")
  2698.                   EXIT
  2699.                ELSE    && find the size
  2700.                   m.numwords = words(m.buffer)
  2701.                   m.i = 1
  2702.                   DO WHILE m.i < m.numwords
  2703.                      m.theword = wordnum(m.buffer,m.i)
  2704.                      IF ISDIGIT(LEFT(m.theword,1))
  2705.                         m.thesize = m.theword
  2706.                         EXIT
  2707.                      ENDIF
  2708.                      m.i = m.i + 1
  2709.                   ENDDO
  2710.                ENDIF
  2711.             ENDIF
  2712.          ENDDO
  2713.          =FCLOSE(m.fp)
  2714.       ELSE
  2715.          DO errormsg WITH error_array[en_ufopen]+": "+m.fname, c_fatal
  2716.       ENDIF
  2717.       DELETE FILE usize.txt
  2718.    ELSE
  2719.       DO errormsg WITH error_array[en_ufopen]+": "+m.fname, c_fatal
  2720.    ENDIF
  2721.    RETURN VAL(m.thesize)
  2722. ELSE
  2723.    RETURN -1
  2724. ENDIF
  2725.  
  2726. *!*****************************************************************************
  2727. *!
  2728. *!     Function:  ISDIR
  2729. *!
  2730. *!*****************************************************************************
  2731. FUNCTION isdir
  2732. * Returns TRUE if m.directory exists as a directory
  2733. PARAMETER m.directory
  2734. PRIVATE ALL
  2735. m.directory = UPPER(ALLTRIM(m.directory))
  2736. IF RIGHT(m.directory,1) = '\'
  2737.    m.directory = LEFT(m.directory,LEN(m.directory)-1)
  2738. ENDIF
  2739. DO CASE
  2740. CASE LEN(m.directory) = 2 AND RIGHT(m.directory,1) = ":"
  2741.    RETURN .T.
  2742. CASE LEN(m.directory) = 3 AND SUBSTR(m.directory,2,1) = ":" AND RIGHT(m.directory,1) = "\"    
  2743.    RETURN .T.
  2744. OTHERWISE 
  2745.    m.parent = justpath(m.directory)
  2746.    m.child  = juststem(m.directory)
  2747.    m.numfiles = ADIR(subdir,addbs(m.parent)+"*.*","D")
  2748.    IF m.numfiles > 0
  2749.       FOR m.i = 1 TO m.numfiles
  2750.          IF subdir[m.i,1] == m.child AND  "D" $ subdir[m.i,5] 
  2751.             RETURN .T.
  2752.          ENDIF
  2753.       ENDFOR
  2754.    ENDIF
  2755. ENDCASE   
  2756. RETURN .F.
  2757.  
  2758. *!*****************************************************************************
  2759. *!
  2760. *!     Function: TRIMPATH
  2761. *!
  2762. *!*****************************************************************************
  2763. FUNCTION trimpath
  2764. * Trim trailing backslash off a directory name, unless it is C:\, D:\, etc.
  2765. PARAMETER m.path
  2766. PRIVATE ALL
  2767. m.path = TRIM(m.path)
  2768. DO CASE
  2769. CASE LEN(m.path) = 1 OR LEN(m.path) = 2  && who knows?  Just return it.
  2770.    RETURN m.path
  2771. CASE LEN(m.path) = 3 AND SUBSTR(m.path,2,1) = ':' AND RIGHT(m.path,1) = '\'  && like C:\
  2772.    RETURN m.path
  2773. CASE RIGHT(m.path,1) = '\'
  2774.    RETURN LEFT(m.path,LEN(m.path)-1)
  2775. OTHERWISE
  2776.    RETURN m.path
  2777. ENDCASE 
  2778.  
  2779. **
  2780. ** Code Associated With Displaying of the Thermometer
  2781. **
  2782.  
  2783. *
  2784. * ACTTHERM(<text>) - Activate thermometer.
  2785. *
  2786. * Activates thermometer.  Update the thermometer with UPDTHERM().
  2787. * Thermometer window is named "thermometer."  Be sure to RELEASE
  2788. * this window when done with thermometer.  Creates the global
  2789. * m.g_thermwidth.
  2790. *
  2791. *!*****************************************************************************
  2792. *!
  2793. *!     Procedure: ACTTHERM
  2794. *!
  2795. *!*****************************************************************************
  2796. PROCEDURE acttherm
  2797. PARAMETER m.text
  2798. PRIVATE m.prompt
  2799. #DEFINE c_dlgface "MS Sans Serif"
  2800. #DEFINE c_dlgsize 8
  2801. #DEFINE c_dlgstyle "B"
  2802. m.prompt = c_thermprompt
  2803. IF TXTWIDTH(m.prompt, c_dlgface, c_dlgsize, c_dlgstyle) > 43
  2804.    DO WHILE TXTWIDTH(m.prompt+"...", c_dlgface, c_dlgsize, c_dlgstyle) > 43
  2805.       m.prompt = LEFT(m.prompt, LEN(m.prompt)-1)
  2806.    ENDDO
  2807.    m.prompt = m.prompt + "..."
  2808. ENDIF
  2809.  
  2810. DEFINE WINDOW thermomete ;
  2811.    AT  INT((SROW() - (( 5.615 * ;
  2812.    FONTMETRIC(1, c_dlgface, c_dlgsize, c_dlgstyle )) / ;
  2813.    FONTMETRIC(1, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2), ;
  2814.    INT((SCOL() - (( 63.833 * ;
  2815.    FONTMETRIC(6, c_dlgface, c_dlgsize, c_dlgstyle )) / ;
  2816.    FONTMETRIC(6, WFONT(1,""), WFONT( 2,""), WFONT(3,"")))) / 2) ;
  2817.    SIZE 5.615,63.833 ;
  2818.    FONT c_dlgface, c_dlgsize ;
  2819.    STYLE c_dlgstyle ;
  2820.    NOFLOAT ;
  2821.    NOCLOSE ;
  2822.    NONE ;
  2823.    COLOR RGB(0, 0, 0, 192, 192, 192)
  2824. MOVE WINDOW thermomete CENTER
  2825. ACTIVATE WINDOW thermomete NOSHOW
  2826.  
  2827. @ 0.5,3 SAY m.text FONT c_dlgface, c_dlgsize STYLE c_dlgstyle
  2828. @ 1.5,3 SAY m.prompt FONT c_dlgface, c_dlgsize STYLE c_dlgstyle
  2829. @ 0.000,0.000 TO 0.000,63.833 ;
  2830.    COLOR RGB(255, 255, 255, 255, 255, 255)
  2831. @ 0.000,0.000 TO 5.615,0.000 ;
  2832.    COLOR RGB(255, 255, 255, 255, 255, 255)
  2833. @ 0.385,0.667 TO 5.231,0.667 ;
  2834.    COLOR RGB(128, 128, 128, 128, 128, 128)
  2835. @ 0.308,0.667 TO 0.308,63.167 ;
  2836.    COLOR RGB(128, 128, 128, 128, 128, 128)
  2837. @ 0.385,63.000 TO 5.308,63.000 ;
  2838.    COLOR RGB(255, 255, 255, 255, 255, 255)
  2839. @ 5.231,0.667 TO 5.231,63.167 ;
  2840.    COLOR RGB(255, 255, 255, 255, 255, 255)
  2841. @ 5.538,0.000 TO 5.538,63.833 ;
  2842.    COLOR RGB(128, 128, 128, 128, 128, 128)
  2843. @ 0.000,63.667 TO 5.615,63.667 ;
  2844.    COLOR RGB(128, 128, 128, 128, 128, 128)
  2845. @ 3.000,3.333 TO 4.231,3.333 ;
  2846.    COLOR RGB(128, 128, 128, 128, 128, 128)
  2847. @ 3.000,60.333 TO 4.308,60.333 ;
  2848.    COLOR RGB(255, 255, 255, 255, 255, 255)
  2849. @ 3.000,3.333 TO 3.000,60.333 ;
  2850.    COLOR RGB(128, 128, 128, 128, 128, 128)
  2851. @ 4.231,3.333 TO 4.231,60.500 ;
  2852.    COLOR RGB(255, 255, 255, 255, 255, 255)
  2853. m.g_thermwidth = 56.269
  2854.  
  2855. SHOW WINDOW thermomete TOP
  2856. RETURN
  2857.  
  2858. *
  2859. * UPDTHERM(<percent>) - Update thermometer.
  2860. *
  2861. *!*****************************************************************************
  2862. *!
  2863. *!     Procedure: UPDTHERM
  2864. *!
  2865. *!*****************************************************************************
  2866. PROCEDURE updtherm
  2867. PARAMETER m.percent
  2868. PRIVATE m.nblocks, m.percent
  2869.  
  2870. IF !WEXIST("thermomete")
  2871.    DO acttherm WITH c_setupname
  2872. ENDIF
  2873. IF m.g_thermwidth = 0
  2874.    m.g_thermwidth = 56.269
  2875. ENDIF
  2876.  
  2877. ACTIVATE WINDOW thermomete
  2878.  
  2879. * Map to the number of platforms we are generating for
  2880. m.percent = MIN(m.percent,100)
  2881.  
  2882. m.nblocks = (m.percent/100) * (m.g_thermwidth)
  2883. @ 3.000,3.333 TO 4.231,m.nblocks + 3.333 ;
  2884.    PATTERN 1 COLOR RGB(128, 128, 128, 128, 128, 128)
  2885. RETURN
  2886.  
  2887. *
  2888. * DEACTTHERMO - Deactivate and Release thermometer window.
  2889. *
  2890. *!*****************************************************************************
  2891. *!
  2892. *!     Procedure: DEACTTHERMO
  2893. *!
  2894. *!*****************************************************************************
  2895. PROCEDURE deactthermo
  2896. IF WEXIST("thermomete")
  2897.    RELEASE WINDOW thermomete
  2898. ENDIF
  2899. RETURN
  2900.  
  2901. *!*****************************************************************************
  2902. *!
  2903. *!     Procedure: GETPREFERENCES
  2904. *!
  2905. *!*****************************************************************************
  2906. PROCEDURE getpreferences
  2907. PARAMETER m.ini_name
  2908. * Get user's responses from DKSETUP.INI file
  2909. m.g_sourcedir  = getprof(m.ini_name,c_pref,c_sourcedir)
  2910. m.g_destdir    = getprof(m.ini_name,c_pref,c_destdir)
  2911. m.g_runtimedir = getprof(m.ini_name,c_pref,c_runtime)
  2912. m.g_dsk144     = IIF(UPPER(getprof(m.ini_name,c_pref,c_make144))="Y",.T.,.F.)
  2913. m.g_dsk12      = IIF(UPPER(getprof(m.ini_name,c_pref,c_make12))="Y",.T.,.F.)
  2914. m.g_dsk720     = IIF(UPPER(getprof(m.ini_name,c_pref,c_make720))="Y",.T.,.F.)
  2915. m.g_instgraph  = IIF(UPPER(getprof(m.ini_name,c_pref,c_instgraph))="Y",.T.,.F.)
  2916. m.g_targetdir  = getprof(m.ini_name,c_pref,c_targetdir)
  2917. m.g_appname    = getprof(m.ini_name,c_pref,c_appname)
  2918. m.g_pmdescript = getprof(m.ini_name,c_pref,c_pmdescript)
  2919. m.g_pmgroup    = getprof(m.ini_name,c_pref,c_pmgroup)
  2920. m.temp         = getprof(m.ini_name,c_pref,c_usermod)
  2921. IF !EMPTY(m.temp) AND BETWEEN(VAL(m.temp),1,3)
  2922.    m.g_modoptions = VAL(m.temp)
  2923. ENDIF   
  2924. m.temp         = getprof(m.ini_name,c_pref,c_nologo)
  2925. IF !EMPTY(m.temp) AND VAL(m.temp) > 0
  2926.    m.g_nologo     = VAL(m.temp)
  2927. ENDIF
  2928. m.g_altcfgfile = getprof(m.ini_name,c_pref,c_altcfgfile)
  2929. m.g_usealtcfg  = IIF(EMPTY(m.g_altcfgfile),0,1)
  2930. m.g_parameters = getprof(m.ini_name,c_pref,c_parameters)
  2931.  
  2932. m.g_executable = getprof(m.ini_name,c_pref,c_runanother)
  2933. m.g_title      = getprof(m.ini_name,c_pref,c_setuptitle)
  2934. m.g_copyright  = getprof(m.ini_name,c_pref,c_copyright)
  2935.  
  2936. m.temp         = getprof(m.ini_name,c_pref,c_splitsize)
  2937. IF !EMPTY(m.temp) AND VAL(m.temp) > 0
  2938.    m.g_splitsize = VAL(m.temp)
  2939. ENDIF
  2940. m.temp         = getprof(m.ini_name,c_pref,c_algorithm)
  2941. IF !EMPTY(m.temp) AND INLIST(m.temp,"2","3")  && 2 and 3 are only valid values
  2942.    m.g_algorithm = m.temp
  2943. ENDIF
  2944. *!*****************************************************************************
  2945. *!
  2946. *!     Procedure: PUTPREFERENCES
  2947. *!
  2948. *!*****************************************************************************
  2949. PROCEDURE putpreferences
  2950. PARAMETER m.ini_name
  2951. * Store user's responses in DKSETUP.INI file
  2952. = putprof(m.ini_name,c_pref,c_sourcedir,m.g_sourcedir)
  2953. = putprof(m.ini_name,c_pref,c_destdir,m.g_destdir)
  2954. = putprof(m.ini_name,c_pref,c_runtime,m.g_runtimedir)
  2955. = putprof(m.ini_name,c_pref,c_make144,IIF(m.g_dsk144,"Y","N"))
  2956. = putprof(m.ini_name,c_pref,c_make12,IIF(m.g_dsk12,"Y","N"))
  2957. = putprof(m.ini_name,c_pref,c_make720,IIF(m.g_dsk720,"Y","N"))
  2958. = putprof(m.ini_name,c_pref,c_instgraph,IIF(m.g_instgraph,"Y","N"))
  2959. = putprof(m.ini_name,c_pref,c_targetdir,m.g_targetdir)
  2960. = putprof(m.ini_name,c_pref,c_appname,m.g_appname)
  2961. = putprof(m.ini_name,c_pref,c_pmdescript,m.g_pmdescript)
  2962. = putprof(m.ini_name,c_pref,c_pmgroup,m.g_pmgroup)
  2963.  
  2964. = putprof(m.ini_name,c_pref,c_usermod,ALLTRIM(STR(m.g_modoptions,1)))
  2965. = putprof(m.ini_name,c_pref,c_nologo,ALLTRIM(STR(m.g_nologo,1)))
  2966. = putprof(m.ini_name,c_pref,c_altcfgfile,IIF(m.g_usealtcfg=0,"",m.g_altcfgfile))
  2967. = putprof(m.ini_name,c_pref,c_parameters,m.g_parameters)
  2968.  
  2969. = putprof(m.ini_name,c_pref,c_runanother,m.g_executable)
  2970. = putprof(m.ini_name,c_pref,c_setuptitle,m.g_title)
  2971. = putprof(m.ini_name,c_pref,c_copyright,m.g_copyright)
  2972. = putprof(m.ini_name,c_pref,c_splitsize,ALLTRIM(STR(m.g_splitsize,20)))
  2973. = putprof(m.ini_name,c_pref,c_algorithm,m.g_algorithm)
  2974.  
  2975. *!*****************************************************************************
  2976. *!
  2977. *!     Procedure: PUTPROF
  2978. *!
  2979. *!*****************************************************************************
  2980. PROCEDURE putprof
  2981. * Place a profile string into dksetup_ini
  2982. PARAMETER m.ini_name, m.application, m.section, m.pstring
  2983.  
  2984. * Create the INI file if it doesn't exist
  2985. IF !FILE(m.ini_name)
  2986.    fp = FCREATE(m.ini_name)
  2987.    =FPUTS(fp," ")
  2988.    =FCLOSE(fp)
  2989. ENDIF
  2990.  
  2991. m.wfn = regfn("WritePrivateProfileString","CCCC","I")
  2992. RETURN callfn(m.wfn,m.application,m.section,m.pstring,m.ini_name)
  2993.  
  2994. *!*****************************************************************************
  2995. *!
  2996. *!     Function: GETPROF
  2997. *!
  2998. *!*****************************************************************************
  2999. FUNCTION getprof
  3000. * Retrieve a profile string from dksetup_ini
  3001. PARAMETER m.ini_name, m.application, m.section
  3002. PRIVATE ALL
  3003. m.e_buf = REPLICATE(CHR(0),255)
  3004. m.gfn = regfn("GetPrivateProfileString","CCC@CIC","I")
  3005. =callfn(m.gfn,m.application, m.section,CHR(0),@m.e_buf,255,m.ini_name)
  3006. m.e_buf = ALLTRIM(CHRTRAN(m.e_buf,CHR(0)," "))
  3007. RETURN m.e_buf
  3008.  
  3009. *!*****************************************************************************
  3010. *!
  3011. *!     Procedure: ERRORHANDLER
  3012. *!
  3013. *!*****************************************************************************
  3014. PROCEDURE errorhandler
  3015. PARAMETER m.msg, m.code
  3016. DO errormsg WITH m.msg, m.code
  3017. RETURN TO dksetup
  3018.