home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / nfsrc21.zip / DIR2DBF.PRG < prev    next >
Text File  |  1991-08-16  |  4KB  |  134 lines
  1. /*
  2.  * File......: DIR2DBF.PRG
  3.  * Author....: Steve Kolterman
  4.  * CIS ID....: 76320,37
  5.  * Date......: $Date:   15 Aug 1991 23:03:26  $
  6.  * Revision..: $Revision:   1.3  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/dir2dbf.prv  $
  8.  * 
  9.  * This is an original work by Steve Kolterman and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/dir2dbf.prv  $
  16.  * 
  17.  *    Rev 1.3   15 Aug 1991 23:03:26   GLENN
  18.  * Forest Belt proofread/edited/cleaned up doc
  19.  * 
  20.  *    Rev 1.2   14 Jun 1991 19:51:34   GLENN
  21.  * Minor edit to file header
  22.  * 
  23.  *    Rev 1.1   31 May 1991 21:11:28   GLENN
  24.  * Steve Kolterman's second revision
  25.  * 
  26.  *    Rev 1.0   01 Apr 1991 01:01:10   GLENN
  27.  * Nanforum Toolkit
  28.  *
  29.  */
  30.  
  31.  
  32.  
  33. /*  $DOC$
  34.  *  $FUNCNAME$
  35.  *     FT_DIR2DB()
  36.  *  $CATEGORY$
  37.  *     Environment
  38.  *  $ONELINER$
  39.  *     Create .DBF of directory files, using DOS filespec
  40.  *  $SYNTAX$
  41.  *     FT_DIR2DB( <cSpec> [, <cDbf> ][, <cNtx> ][, <cDrvr> ] ) -> <nErrcode>
  42.  *  $ARGUMENTS$
  43.  *     <cSpec> can be any valid DOS file spec., including wildcards and
  44.  *      single file names.
  45.  *
  46.  *     <cDbf> is the name of the .DBF to create.  If not specified, the
  47.  *      name 'FILES' is used.
  48.  *
  49.  *     <cNtx> is the name of the .NTX to create.  If not specified, no
  50.  *      index is created.
  51.  *
  52.  *     <cDrvr> is the name of the Nantucket RDD (replaceable database
  53.  *      driver) to use.  If not specified, the default, 'DBFNTX', is
  54.  *      used.
  55.  *  $RETURNS$
  56.  *     <nErrcode>, which will be one of the following:
  57.  *
  58.  *        0 - no error
  59.  *        1 - no file spec. passed
  60.  *        2 - no files match spec. passed
  61.  *        3 - network error opening <cDbf>
  62.  *  $DESCRIPTION$
  63.  *     FT_DIR2DB() builds a .DBF from and fills it with the files/data
  64.  *     matching any valid DOS file spec.  Fields created are 'Name',
  65.  *     'Size', 'Date', 'Time', and 'Attr' (attribute).
  66.  *
  67.  *     An index on the 'name' field is also created by passing a name
  68.  *     for the .NTX as a third parameter.  An optional fourth parameter
  69.  *     accommodates the RDDs (replaceable database drivers) Nantucket
  70.  *     promises.
  71.  *  $EXAMPLES$
  72.  *     nVal:= FT_DIR2DB( "*.dbf","dbffiles","filename" )
  73.  *     Creates DBFFILES.DBF consisting of all .DBFs in the current dir-
  74.  *     ectory, and also creates FILENAME.NTX.
  75.  *
  76.  *     nVal:= FT_DIR2DB( "*.*","pdoxdbf","pdoxntx","paradox" )
  77.  *     would create a Paradox database and index consisting of all files
  78.  *     in the current directory.
  79.  *  $END$
  80.  */
  81.  
  82. #include "directry.ch"
  83.  
  84. #ifdef FT_TEST
  85.  
  86. FUNCTION Test( spec,dbf,ntx,drvr )
  87. LOCAL ret_val:= FT_Dir2db( spec,dbf,ntx,drvr ),msg
  88. IF ret_val > 0
  89.   msg:= IF( ret_val==1,"File Spec. Not Passed", ;
  90.         IF( ret_val==2,"No Files Match Passed Spec.", ;
  91.                        "Network Problem Creating "+upper(dbf)+".DBF" ))
  92.   Alert( "Error!"+";"+msg,{"Quit"} ); END
  93. QUIT
  94. RETURN NIL
  95.  
  96. #endif
  97.  
  98. FUNCTION FT_DIR2DB( spec,dfile,ntx,driver )
  99. LOCAL adbf,struc,orig_area,error_code:= 0
  100. FIELD name
  101.  
  102. IF spec==NIL; error_code:= 1
  103. ELSE
  104.    dfile := IF( dfile==NIL,"files",dfile )
  105.    adbf  := {  {"Name","C",12,0},;
  106.                {"Size","N",9,0}, ;
  107.                {"Date","D",8,0}, ;
  108.                {"Time","C",8,0}, ;
  109.                {"Attr","C",4,0}     }
  110.  
  111.    IF EMPTY( struc:= DIRECTORY(spec) ); error_code:= 2
  112.    ELSE
  113.       orig_area:= SELECT()
  114.       DBCREATE(dfile,adbf)
  115.       USE (dfile) EXCLUSIVE NEW VIA (driver)
  116.       IF NETERR(); error_code:= 3
  117.       ELSE
  118.          Aeval( struc, {|e,n| dbAppend(), ;
  119.                               Fieldput(F_NAME,struc[n][F_NAME]),;
  120.                               Fieldput(F_SIZE,struc[n][F_SIZE]),;
  121.                               Fieldput(F_DATE,struc[n][F_DATE]),;
  122.                               Fieldput(F_TIME,struc[n][F_TIME]),;
  123.                               Fieldput(F_ATTR,struc[n][F_ATTR])   } )
  124.          IF ntx <> NIL; INDEX ON name TO (ntx); END
  125.          CLOSE (dfile)
  126.          SELECT(orig_area)
  127.       ENDIF
  128.    ENDIF
  129. ENDIF
  130.  
  131. RETURN ( error_code )
  132.  
  133. // EOF: DIR2DB.PRG
  134.