home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a013 / 1.ddi / SOURCE.EXE / F_DBNAME.PRG < prev    next >
Encoding:
Text File  |  1991-01-25  |  2.8 KB  |  104 lines
  1. *****************************************************************
  2. FUNCTION DBNAMES
  3. *****************************************************************
  4.  
  5. * Reads a data dictionary and tests for existance of databases
  6. * named in it. Extracts database names and text descriptions.
  7.  
  8. * Copyright(c) 1991 -- James Occhiogrosso
  9.  
  10. LOCAL dbf_type := handle := 0
  11. PARAMETERS app_def, dbf_texts, dbf_names
  12. PRIVATE dbf_name := ret_value := textline := ''
  13.  
  14. * Check passed parameters
  15.  
  16. * Return P if number of parameters is wrong
  17. IF PCOUNT() != 3
  18.     RETURN 'P'
  19.  
  20. * Return P if parameters are wrong type
  21. ELSEIF TYPE('app_def') != 'C' .OR. TYPE('dbf_names') != 'A' ;
  22.                               .OR. TYPE('dbf_texts') != 'A'
  23.     RETURN 'P'
  24.  
  25. ELSE
  26.     * Open data dictionary file
  27.     handle = FOPEN(app_def)
  28.     IF handle <= 0
  29.         * File cannot be opened - return D
  30.         RETURN 'D'
  31.     ENDIF
  32. ENDIF
  33.  
  34. * Get first database definition line from data dictionary
  35. dbf_name = GETDBFDEF()
  36.  
  37. DO WHILE .NOT. EMPTY(dbf_name)
  38.  
  39.     * Check database name. If database exists, test for
  40.     * associated memo file. If either is missing, exit
  41.     * the loop and return the missing file name.
  42.  
  43.     IF FILE(dbf_name + '.dbf')
  44.  
  45.         dbf_type = ISMEMO(dbf_name)
  46.         IF dbf_type = 1
  47.             * Memo file missing, return its name
  48.             IF .NOT. FILE(dbf_name + '.dbt')
  49.                 ret_value = dbf_name + '.dbt'
  50.                 EXIT
  51.             ENDIF
  52.         ELSEIF dbf_type = -1
  53.             * Memo file error, return its name
  54.             ret_value = dbf_name
  55.             EXIT
  56.         ENDIF
  57.  
  58.     ELSE
  59.         * Database missing, return its name
  60.         ret_value = dbf_name
  61.         EXIT
  62.     ENDIF
  63.  
  64.     * Add database name and associated text to arrays
  65.     IF EMPTY(ret_value)
  66.         AADD(dbf_names, dbf_name)
  67.         AADD(dbf_texts, SUBSTR(textline, 1, 60))
  68.     ENDIF
  69.  
  70.     * Get next database definition line from data dictionary.  
  71.     dbf_name = GETDBFDEF()
  72.  
  73. ENDDO WHILE .NOT. EMPTY(dbf_name)
  74.  
  75. RETURN ret_value
  76.  
  77.  
  78. *****************************************************************
  79. STATIC FUNCTION GETDBFDEF
  80. *****************************************************************
  81.  
  82. * Read data dictionary file line by line, looking for a database
  83. * definition line (DBFDEF), or end of file marker.
  84.  
  85. textline = '*'
  86. DO WHILE (UPPER(SUBSTR(textline, 1, 7)) != 'ENDFILE' .AND.     ;
  87.           UPPER(SUBSTR(textline, 1, 6)) != 'DBFDEF') .OR.      ;
  88.          (SUBSTR(textline, 1, 1) $ '*#' .OR. EMPTY(textline))
  89.     textline = LTRIM(FREADLINE(handle))
  90. ENDDO
  91.  
  92. IF UPPER(SUBSTR(textline, 1, 7)) = 'ENDFILE'
  93.     * Done, close data dictionary file and return
  94.     FCLOSE(handle)
  95.     RETURN ''
  96. ELSE
  97.     * Strip "DBFDEF" code identifier and return filename
  98.     textline = LTRIM(SUBSTR(textline, 7))
  99.     dbf_name = PARSE(@textline)
  100. ENDIF
  101.  
  102. RETURN dbf_name
  103.  
  104.