home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / dbstru.prg < prev    next >
Text File  |  1993-10-14  |  4KB  |  116 lines
  1. /*
  2.  * File......: DBSTRU.PRG
  3.  * Author....: Dave Pearson
  4.  * BBS.......: The Dark Knight Returns
  5.  * Net/Node..: 050/069
  6.  * User Name.: Dave Pearson
  7.  * Date......: $Date$
  8.  * Revision..: $Revision$
  9.  * Log file..: $Logfile$
  10.  *
  11.  * This is an original work by Dave Pearson and is placed in the public
  12.  * domain.
  13.  *
  14.  * Modification history:
  15.  * ---------------------
  16.  *
  17.  * $Log$
  18.  *
  19.  */
  20.  
  21. #include "gt_lib.ch"
  22.  
  23. // Length of the database file header.
  24.  
  25. #define DBF_HEADER_LEN     32
  26.  
  27. // Length if a field definition record in the field array.
  28.  
  29. #define DBF_FIELD_LEN      32
  30.  
  31. /*  $DOC$
  32.  *  $FUNCNAME$
  33.  *      GT_DBSTRUCT()
  34.  *  $CATEGORY$
  35.  *      File I/O
  36.  *  $ONELINER$
  37.  *      Create an array containing the struct of a DBF file.
  38.  *  $SYNTAX$
  39.  *      GT_DBStruct(<cFileName>) --> aStructure
  40.  *  $ARGUMENTS$
  41.  *      <cFileName> is the name of the DBF file. If the name has no
  42.  *      extension it defaults to DBF.
  43.  *  $RETURNS$
  44.  *      An array holding the structure of the DBF file. For more information
  45.  *      on the structure of this array see the documention for the Clipper
  46.  *      function DBStruct().
  47.  *  $DESCRIPTION$
  48.  *      GT_DBStruct() is designed to be the same as the Clipper function
  49.  *      DBStruct(). The main change is that it works on un-opened database
  50.  *      files.
  51.  *  $EXAMPLES$
  52.  *      // Create a new database file using the structure of an existing
  53.  *      // file.
  54.  *
  55.  *      dbcreate("Universe",GT_DBStruct("Life"))
  56.  *  $END$
  57.  */
  58.  
  59. function GT_DBStruct(cFile)
  60. local aStructure := {}       ,;
  61.       nDbfFile   := 0        ,;
  62.       cHeader    := space(32),;
  63.       nFldArSize := 0        ,;
  64.       cFields    := NULL
  65. if valtype(cFile) == TYPE_CHAR
  66.    cFile := GT_DefExt(cFile,"Dbf")
  67.    if GT_IsDbf(cFile)
  68.       if (nDbfFile := fopen(cFile)) != F_ERROR
  69.          if fread(nDbfFile,@cHeader,DBF_HEADER_LEN) == DBF_HEADER_LEN
  70.             cFields := space(nFldArSize := DBF_FIELD_LEN * (((bin2i(substr(cHeader,9,2))-1)/32)-1))
  71.             if fread(nDbfFile,@cFields,nFldArSize) == nFldArSize
  72.                aStructure := BuildStructure(cFields)
  73.             endif
  74.          endif
  75.          fclose(nDbfFile)
  76.       endif
  77.    endif
  78. endif
  79. return(aStructure)
  80.  
  81. /*****************************************************************************
  82. * Function: BuildStructure()                                                 *
  83. * Syntax..: DuildStructure(<cFieldArray>) --> aStructure                     *
  84. * Usage...: Internal function to take the field array string and turn it into*
  85. * ........: a Clipper array.                                                 *
  86. * By......: David A Pearson                                                  *
  87. *****************************************************************************/
  88.  
  89. static function BuildStructure(cFieldArray)
  90. local aStructure := {}  ,;
  91.       nField     := 0   ,;
  92.       nMaxField  := len(cFieldArray)/DBF_FIELD_LEN
  93. for nField := 1 to nMaxField
  94.    aadd(aStructure,MakeField(substr(cFieldArray,((nField-1)*DBF_FIELD_LEN)+1,DBF_FIELD_LEN)))
  95. next
  96. return(aStructure)
  97.  
  98. /*****************************************************************************
  99. * Function: MakeField()                                                      *
  100. * Syntax..: MakeField(<cField>) --> aField                                   *
  101. * Usage...: Internal function to take field record from the string array and *
  102. * ........: turn it into a structure element.                                *
  103. * By......: David A Pearson                                                  *
  104. *****************************************************************************/
  105.  
  106. static function MakeField(cField)
  107. local cName     := NULL,;
  108.       cType     := NULL,;
  109.       nLength   := 0   ,;
  110.       nDecimals := 0
  111. cName     := left(cField,at(chr(0),cField)-1)
  112. cType     := substr(cField,12,1)
  113. nLength   := if(cType == TYPE_CHAR,bin2i(substr(cField,17,2)),asc(substr(cField,17,1)))
  114. nDecimals := if(cType == TYPE_CHAR,0,asc(substr(cField,18,1)))
  115. return({ cName , cType , nLength , nDecimals })
  116.