home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a013 / 1.ddi / SOURCE.EXE / F_MAKEDB.PRG < prev    next >
Encoding:
Text File  |  1991-01-25  |  11.2 KB  |  388 lines
  1. *****************************************************************
  2. FUNCTION MAKEDBF (App_def)
  3. *****************************************************************
  4.  
  5. * Creates or recreates an application's database files
  6.  
  7. * Copyright(c) 1991 -- James Occhiogrosso
  8.  
  9. * Note: Since successful operation of MAKEDBF is usually critical
  10. * to application integrity, it returns to DOS with an message if
  11. * any error occurs that prevents proper updating.
  12.  
  13. # include "box.ch"
  14. # define f_names  1
  15. # define f_types  2
  16. # define f_lens   3
  17. # define f_decs   4
  18. # define f_ok     5
  19.  
  20. LOCAL counter := num_fields := pointer := 0
  21. LOCAL create_dbf := dbf_exist := memoflds := old_cursor :=     ;
  22.       old_exact := .F.
  23. LOCAL temp_stru := ''
  24. LOCAL dbf_stru := {},  dbf_names := {}, memo_files[1]
  25.  
  26. PRIVATE dbf_name := dbf_text := textline := '', handle := 0,   ;
  27.         text_row := 7, new_stru := {}
  28.  
  29. IF PCOUNT() != 1
  30.     * Return to DOS if no argument passed
  31.     * Critical error - return to DOS
  32.     ?? CHR(7)
  33.     ? 'Must specify application definition file'
  34.     SET CURSOR ON
  35.     QUIT
  36. ELSE
  37.     * Return to DOS if data dictionary file cannot be opened
  38.     handle = FOPEN(app_def)
  39.     IF handle <= 0
  40.         * Critical error - return to DOS
  41.         ?? CHR(7)
  42.         ? 'Application definition file missing.'
  43.         SET CURSOR ON
  44.         QUIT
  45.     ENDIF
  46. ENDIF
  47.  
  48. * Save cursor status and turn cursor off
  49. old_cursor = SETCURSOR(.F.)
  50.  
  51. * Display MAKEDBF installation screen
  52.  
  53. CLEAR SCREEN
  54. @ 1, 7, 23, 70 BOX B_DOUBLE + SPACE(1)
  55. @ 1, 0 SAY ''
  56. TEXT
  57.        ║            S Y S T E M     I N S T A L L A T I O N           ║
  58.        ╟──────────────────────────────────────────────────────────────╢
  59.        ║  This is a new or updated system configuation. System files  ║
  60.        ║  will be checked and updated as required.  Data will not be  ║
  61.        ║  lost. The process takes a few minutes.  Please be patient.  ║
  62.        ╟──────────────────────────────────────────────────────────────╢
  63. ENDTEXT
  64.  
  65.  
  66. * Get first database definition from data dictionary
  67. GETDBFDEF()
  68.  
  69. * Loop until no more database definition (DBFDEF) lines
  70.  
  71. DO WHILE .NOT. EMPTY(dbf_name)
  72.  
  73.    * Reset loop control variables
  74.    create_dbf = .F.
  75.    dbf_exist = .F.
  76.  
  77.    * Check for existence of database
  78.    IF FILE(dbf_name + '.dbf')
  79.       * Database exists, set flag and open it for exclusive use
  80.       dbf_exist = .T.
  81.       USE &dbf_name EXCLUSIVE NEW
  82.       IF NETERR()
  83.           ?? CHR(7)
  84.           ? 'File ' + UPPER(dbf_name) + ' cannot be opened ' + ;
  85.             'exclusively. '
  86.           SET CURSOR ON
  87.           QUIT
  88.       ENDIF
  89.  
  90.       * Load field structures to dbf_stru array
  91.       dbf_stru = DBSTRUCT()
  92.       num_fields = LEN(dbf_stru)
  93.  
  94.  
  95.       * Add and initalize a logical dimension for field status
  96.       FOR counter = 1 TO num_fields
  97.          ASIZE(dbf_stru[counter], 5)
  98.          dbf_stru[counter][5] = .F.
  99.       NEXT
  100.  
  101.       * Open and load temporary file with field definitions
  102.       LOADSTRU()
  103.  
  104.  
  105.       * Set EXACT on and verify fields to data dictionary
  106.       old_exact = SET(_SET_EXACT, .T.)
  107.  
  108.       IF LEN(new_stru) != num_fields
  109.          * Database and dictionary have different number
  110.          * of fields. Set create flag
  111.          create_dbf = .T.
  112.       ELSE
  113.          * Test all fields to dictionary definitions
  114.          FOR counter = 1 TO num_fields
  115.  
  116.             IF dbf_stru[counter][f_names] == ;
  117.                   TRIM(new_stru[counter][f_names])
  118.                   * Field names match. Check type and length
  119.  
  120.                   IF  new_stru[counter][f_types] != ;
  121.                       dbf_stru[counter][f_types]
  122.                       ?? CHR(7)
  123.                       ? 'Field type ' + ;
  124.                         TRIM(new_stru[counter][f_names]) + ;
  125.                         ' in database ' + dbf_name +       ; 
  126.                         ' changed. Cannot continue. '
  127.                       SET CURSOR ON
  128.                       QUIT
  129.  
  130.                   ELSEIF new_stru[counter][f_lens]  !=     ;
  131.                          dbf_stru[counter][f_lens]  .OR.   ;
  132.                          new_stru[counter][f_decs]  !=     ;
  133.                          dbf_stru[counter][f_decs]
  134.  
  135.                          * Dictionary definition is not same
  136.                          * as database. Set create flag
  137.                          create_dbf = .T.
  138.  
  139.                   ELSE
  140.                       * Flag verified field in f_ok array
  141.                       dbf_stru[counter][f_ok] = .T.
  142.                   ENDIF
  143.  
  144.             ELSE
  145.                   * Field name changed. Set create flag
  146.                   create_dbf = .T.
  147.  
  148.             ENDIF
  149.          NEXT
  150.       ENDIF
  151.  
  152.       * Reset EXACT to entry condition
  153.       SET(_SET_EXACT, old_exact)
  154.  
  155.       * Check flags array. False indicates field exists in
  156.       * database but not in dictionary. (Field was deleted)
  157.  
  158.       IF ! create_dbf
  159.           * Test for deletions unless create flag allready set
  160.           FOR counter = 1 TO num_fields
  161.               IF ! dbf_stru[counter][f_ok]
  162.                   * A field was deleted. Set create flag
  163.                   create_dbf = .T.
  164.               ENDIF
  165.           NEXT
  166.       ENDIF
  167.  
  168.    ELSE
  169.        * Database does not exist, set flag to re-create it
  170.        LOADSTRU()
  171.        create_dbf = .T.
  172.    ENDIF
  173.  
  174.    * Close the file
  175.    USE
  176.  
  177.    * Test flags and recreate database if necessary
  178.    IF dbf_exist .AND. create_dbf
  179.  
  180.         * Old database exists. Create backup files
  181.         * Delete any old backups if they exist
  182.  
  183.         IF FILE(dbf_name + '.BAK')
  184.              ERASE &dbf_name..BAK
  185.         ENDIF
  186.         IF FILE(dbf_name + '.TBK')
  187.              ERASE &dbf_name..TBK
  188.         ENDIF
  189.  
  190.         * Test database for defined memo fields
  191.         memoflds = IF(ISMEMO(dbf_name) = 1, .T., .F.)
  192.  
  193.         * Rename old database file(s) to backups
  194.         IF memoflds .AND. .NOT. FILE(dbf_name + '.DBT')
  195.              ?? CHR(7)
  196.              ? 'Memo file ' + dbf_name + '.DBT missing.'
  197.              SET CURSOR ON
  198.              QUIT
  199.         ELSEIF memoflds .AND. FILE(dbf_name + '.DBT')
  200.              RENAME &dbf_name..DBT TO &dbf_name..TBK
  201.         ENDIF
  202.         RENAME &dbf_name..DBF TO &dbf_name..BAK
  203.  
  204.         * Make sure both backup files exist before creating
  205.         * new ones. CREATE will destroy existing DBT files!
  206.  
  207.         IF .NOT. FILE(dbf_name + '.BAK') .OR.  ;
  208.                       (memoflds .AND. !FILE(dbf_name + '.TBK'))
  209.              ?? CHR(7)
  210.              ? 'Backup files cannot be created for ' + dbf_name
  211.              SET CURSOR ON
  212.              QUIT
  213.         ENDIF
  214.  
  215.    ENDIF
  216.  
  217.    IF create_dbf
  218.  
  219.         * Scroll screen up if at bottom of window
  220.         IF text_row = 22
  221.              SCROLL(8, 9, 22, 68, 1)
  222.         ELSE
  223.             text_row = text_row + 1
  224.         ENDIF
  225.  
  226.         * Display associated text (balance of textline)
  227.         @ text_row, 7 SAY '║' + ' ' + SUBSTR(dbf_text, 1, 60)
  228.         @ text_row, 70 SAY '║'
  229.  
  230.         * Recreate database file from structure file
  231.         DBCREATE(dbf_name, new_stru)
  232.  
  233.         USE
  234.  
  235.         * Rename DBT file if memo fields exist
  236.         IF memoflds .AND. dbf_exist
  237.             ERASE &dbf_name..DBT
  238.             RENAME &dbf_name..TBK TO &dbf_name..DBT
  239.         ENDIF
  240.  
  241.         * If database exists, copy all records from backup
  242.         IF dbf_exist
  243.             USE &dbf_name EXCLUSIVE NEW
  244.             IF NETERR()
  245.                 ?? CHR(7)
  246.                 ? 'File ' + UPPER(dbf_name) + ' cannot be opened ' + ;
  247.                   'exclusively. '
  248.                 SET CURSOR ON
  249.                 QUIT
  250.             ENDIF
  251.  
  252.             APPEND FROM &dbf_name..BAK
  253.             IF memoflds
  254.                * Pack DBT file if memo fields exist
  255.                memo_files[1] := dbf_name
  256.                MEMOPACK(memo_files)
  257.             ENDIF
  258.             USE
  259.         ENDIF
  260.  
  261.         * Add current database filename to the array
  262.         AADD(dbf_names, dbf_name)
  263.  
  264.  
  265.    ENDIF
  266.  
  267.    * Get next database definition line from data dictionary  
  268.    GETDBFDEF()
  269.  
  270. ENDDO WHILE .NOT. EMPTY(dbf_name)
  271.  
  272. * Call MAKENDX to recreate indexes of updated databases
  273. SETCURSOR(old_cursor)
  274. RETURN MAKENDX(DBf_names, textline, text_row)
  275.  
  276.  
  277. *****************************************************************
  278. STATIC FUNCTION GETDBFDEF
  279. *****************************************************************
  280.  
  281. * Locate and read the next database definition (DBFDEF) line
  282.  
  283. * Get next defined line from data dictionary
  284. NEXTLINE()
  285.  
  286. * Check line for database definition code
  287.  
  288. IF UPPER(SUBSTR(textline, 1, 6)) = 'DBFDEF'
  289.     * Line is a valid database definition, strip
  290.     * DBFDEF code identifier and return.
  291.  
  292.     textline = LTRIM(SUBSTR(textline, 7))
  293.     dbf_name = PARSE(@textline)
  294.     dbf_text = textline
  295.  
  296. ELSE
  297.     * Otherwise, set dbf_name to an empty string 
  298.     * and return without altering textline
  299.     dbf_name = ''
  300. ENDIF
  301.  
  302. RETURN ''
  303.  
  304.  
  305.  
  306. *****************************************************************
  307. STATIC FUNCTION NEXTLINE     
  308. *****************************************************************
  309.  
  310. * Get next non-comment line in definitions file
  311.  
  312. * Test first character of line
  313. textline = '*'
  314. DO WHILE (SUBSTR(textline, 1, 1) $ '*#' .OR. EMPTY(textline))  ;
  315.         .AND. UPPER(SUBSTR(textline, 1, 7)) != 'ENDFILE'
  316.  
  317.      * If it is a comment or blank line, skip it.
  318.     textline = LTRIM(FREADLINE(handle))
  319.  
  320. ENDDO
  321. RETURN NIL
  322.  
  323.  
  324. *****************************************************************
  325. STATIC FUNCTION LOADSTRU
  326. *****************************************************************
  327.  
  328. * Load database definitions into structure array
  329.  
  330. LOCAL fld_dec := fld_len := fld_name := fld_type := message := ''
  331.  
  332. * Clear the new structure array
  333. new_stru := {}
  334.  
  335. * Get next non-comment line of definitions file
  336. NEXTLINE()
  337.  
  338. * Stay in loop until we read end of definitions code
  339. DO WHILE UPPER(SUBSTR(textline, 1, 6)) != 'ENDDEF'
  340.  
  341.     * Get and verify field definitions from data dictionary
  342.  
  343.     fld_name = UPPER(PARSE(@textline))     && Get field name
  344.     fld_type = UPPER(PARSE(@textline))     && Get field type
  345.     fld_len  = PARSE(@textline)            && Get field length
  346.     fld_dec  = PARSE(@textline)            && Get field decimals
  347.  
  348.     IF EMPTY(fld_name) .OR. LEN(fld_name) > 10
  349.          message = 'Field name'
  350.  
  351.     ELSEIF EMPTY(fld_type) .OR. LEN(fld_type) > 1  ;
  352.                            .OR. .NOT. (fld_type) $ 'CDNLM'
  353.          message = 'Field type'
  354.  
  355.     ELSEIF EMPTY(fld_len) .OR. .NOT. VAL(fld_len) >= 0 ;
  356.                           .OR. VAL(fld_len) > 999
  357.          message = 'Field length'
  358.  
  359.     ELSEIF EMPTY(fld_dec) .OR. .NOT. VAL(fld_dec) >= 0 ;
  360.                           .OR. VAL(fld_dec) > 999
  361.          message = 'Field decimals'
  362.  
  363.     ENDIF
  364.  
  365.     IF .NOT. EMPTY(message)
  366.         * If message is loaded, display it and return to DOS
  367.         ?? CHR(7)
  368.         ? message + ' error in data dictionary ..... ' + fld_name
  369.         ? 'Text line = ' + SUBSTR(textline,1,60)
  370.         SET CURSOR ON
  371.         QUIT
  372.     ELSE
  373.         * Load each field definition to structure array
  374.         AADD(new_stru, { fld_name, fld_type,  ;
  375.                          VAL(fld_len), VAL(fld_dec) } )
  376.     ENDIF
  377.  
  378.     * Get next non-comment line of definitions file
  379.     NEXTLINE()
  380.  
  381. ENDDO
  382.  
  383. * Reset pointer to top of file and return
  384. GO TOP
  385. RETURN NIL
  386.  
  387.  
  388.