home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / DBI101 / DBINS101.PRG next >
Text File  |  1993-02-07  |  7KB  |  280 lines
  1. /*
  2.  * File......: DBINSERT.PRG
  3.  * Author....: Todd C. MacDonald
  4.  * CIS ID....: 73767,2242
  5.  * Date......: $Date$
  6.  * Revision..: $Revision$
  7.  * Log file..: $Logfile$
  8.  *
  9.  * This is an original work by Todd C. MacDonald and is hereby
  10.  * placed in the public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log$
  16.  *
  17.  */
  18.  
  19.  
  20. /*  $DOC$
  21.  *  $FUNCNAME$
  22.  *      ft_dbins()
  23.  *  $CATEGORY$
  24.  *      To be assigned
  25.  *  $ONELINER$
  26.  *      Insert a blank record after (or before) the current record.
  27.  *  $SYNTAX$
  28.  *      ft_dbins( [<lBefore>] ) -> NIL
  29.  *  $ARGUMENTS$
  30.  *      <lBefore> set to .t. will cause the blank record to be
  31.  *      inserted BEFORE the current record.  If <lBefore> is .f.,
  32.  *      or is not passed, the blank record is inserted AFTER the
  33.  *      current record.
  34.  *  $RETURNS$
  35.  *      NIL
  36.  *  $DESCRIPTION$
  37.  *      This function physically inserts a new blank record after
  38.  *      (or optionally before) the current record in the currently
  39.  *      selected work area.  It provides the functional equivalent
  40.  *      of dBASE's INSERT [BEFORE] BLANK command.
  41.  *
  42.  *      Caveats:
  43.  *
  44.  *      ■ This function is not network compatible.  The file on
  45.  *        which you perform the insert must be USEed EXCLUSIVEly.
  46.  *
  47.  *      Notes:
  48.  *
  49.  *      ■ If a filter is set in the current work area, the insert
  50.  *        will still be performed properly and the inserted record
  51.  *        will be the current record after the insert.  Whatever
  52.  *        actions you take subsequently (assigning values to fields
  53.  *        and moving the record pointer) may bring the record out
  54.  *        of the scope of the filter.
  55.  *
  56.  *      ■ If any indexes are active in the current work area, they
  57.  *        will be updated, but the record will be inserted
  58.  *        according to the current record's PHYSICAL location.
  59.  *        Presumably, you have a need to maintain the file in
  60.  *        physical order and it wouldn't HAVE any active
  61.  *        indexes...but who knows what goes on in your strange
  62.  *        little mind?  ;-)
  63.  *
  64.  *      ■ This function will work with any size DBF, but it's
  65.  *        intended use is with relatively small ones.
  66.  *  $EXAMPLES$
  67.  *      ft_dbins()       // inserts blank record AFTER current one
  68.  *      ft_dbins( .f. )  // inserts blank record AFTER current one
  69.  *      ft_dbins( .t. )  // inserts blank record BEFORE current one
  70.  *
  71.  *      // or, if UDC's are your thing...
  72.  *
  73.  *      #command INSERT [<b4: BEFORE>] => ft_dbins( <.b4.> )
  74.  *
  75.  *      INSERT           // inserts blank record AFTER current one
  76.  *      INSERT BEFORE    // inserts blank record BEFORE current one
  77.  *  $SEEALSO$
  78.  *
  79.  *  $INCLUDE$
  80.  *
  81.  *  $END$
  82.  */
  83.  
  84.  
  85. #ifdef FT_TEST
  86.  
  87.  
  88. //--------------------------------------------------------------------------//
  89.   FUNCTION TestDriver
  90. //--------------------------------------------------------------------------//
  91.  
  92. #command LIST => ;
  93.   set filter to ;;
  94.   dbgotop() ;;
  95.   dbeval( { || qqout( ltrim( str( recno() ) ), FAM->cName, FAM->dBirth, ;
  96.     FAM->nDaysOld, FAM->lIsGirl, FAM->mNotes ), qout() } ) ;;
  97.   set filter to FAM->lIsGirl
  98.  
  99. #command PAUSE <c> => ;
  100.   qout( 'Press (almost) any key to insert ' + <c> + '...' ) ;;
  101.   inkey( 0 ) ;;
  102.   qout() ;;
  103.   qout()
  104.  
  105. dbcreate( 'FT_DBINS', { ;
  106.   { 'cName',    'C',  7, 0 }, ;
  107.   { 'dBirth',   'D',  8, 0 }, ;
  108.   { 'nDaysOld', 'N',  5, 0 }, ;
  109.   { 'lIsGirl',  'L',  1, 0 }, ;
  110.   { 'mNotes',   'M', 10, 0 } } )
  111.  
  112. use FT_DBINS alias FAM exclusive
  113.  
  114. set filter to FAM->lIsGirl
  115.  
  116. append blank
  117.  
  118. FAM->cName    := 'Ryan'
  119. FAM->dBirth   := ctod( '6/6/85' )
  120. FAM->nDaysOld := date() - FAM->dBirth
  121. FAM->lIsGirl  := .f.
  122. FAM->mNotes   := 'Likes to play Word Rescue.'
  123.  
  124. append blank
  125.  
  126. FAM->cName    := 'Amanda'
  127. FAM->dBirth   := ctod( '10/2/90' )
  128. FAM->nDaysOld := date() - FAM->dBirth
  129. FAM->lIsGirl  := .t.
  130. FAM->mNotes   := 'Likes Minnie Mouse.'
  131.  
  132. cls
  133. list
  134.  
  135. pause 'Susan before Ryan'
  136.  
  137. goto 1
  138.  
  139. ft_dbins( .t. )
  140.  
  141. FAM->cName    := 'Susan'
  142. FAM->dBirth   := ctod( '12/21/61' )
  143. FAM->nDaysOld := date() - FAM->dBirth
  144. FAM->lIsGirl  := .t.
  145. FAM->mNotes   := "Likes Todd (except when he's on the PC ;-)."
  146.  
  147. list
  148.  
  149. pause 'Zachary after Ryan'
  150.  
  151. goto 2
  152.  
  153. ft_dbins()
  154.  
  155. FAM->cName    := 'Zachary'
  156. FAM->dBirth   := ctod( '2/27/88' )
  157. FAM->nDaysOld := date() - FAM->dBirth
  158. FAM->lIsGirl  := .f.
  159. FAM->mNotes   := 'Likes Barney.'
  160.  
  161. list
  162.  
  163. pause 'Emily after Amanda'
  164.  
  165. goto 4
  166.  
  167. ft_dbins( .f. )
  168.  
  169. FAM->cName    := 'Emily'
  170. FAM->dBirth   := ctod( '2/20/92' )
  171. FAM->nDaysOld := date() - FAM->dBirth
  172. FAM->lIsGirl  := .t.
  173. FAM->mNotes   := "Likes to eat and sleep (just like dad ;-)."
  174.  
  175. list
  176.  
  177. close database
  178.  
  179. erase FT_DBINS.dbf
  180. erase FT_DBINS.dbt
  181.  
  182. RETURN nil
  183. //--------------------------------------------------------------------------//
  184.  
  185.  
  186. #endif
  187.  
  188.  
  189. //--------------------------------------------------------------------------//
  190.   FUNCTION ft_dbins( lBefore )
  191. //--------------------------------------------------------------------------//
  192.  
  193. /*
  194.  
  195. Modus Operandi:
  196.  
  197. 1) Append a blank record at the end of the file.
  198.  
  199. 2) Back up through the file, "moving" each record down one position
  200.    (preserving it's deleted() status) until the current record plus 1 is
  201.    reached (or current record if inserting BEFORE).
  202.  
  203. 3) Blank out the "inserted" record and recall() it if it's deleted().
  204.  
  205. Please note that "goto recno() + 1" is used in place of dbskip() and "goto
  206. recno() - 1" is used in place of dbskip ( -1 ).  This effectively defeats
  207. any filter and eliminates the need to save and restore the filter condition
  208. via the macro operator.
  209.  
  210. */
  211.  
  212. #define DBS_NAME  1
  213. #define FLD_BLK   1
  214. #define FLD_VAL   2
  215.  
  216. LOCAL nRec     := recno() + 1
  217. LOCAL lSavDel  := set( _SET_DELETED, .f. )
  218. LOCAL nSavOrd  := indexord()
  219. LOCAL aFields  := {}
  220. LOCAL lDeleted := .f.
  221.  
  222. IF lBefore = nil; lBefore := .f.; ENDIF
  223.  
  224. IF lBefore
  225.  
  226.   // stop moving records when the current record is reached
  227.   --nRec
  228.  
  229. ENDIF
  230.  
  231. // build the array of field get/set blocks with cargo space for field values
  232. aeval( dbstruct(), { | a | ;
  233.   aadd( aFields, { fieldblock( a[ DBS_NAME ] ), nil } ) } )
  234.  
  235. // process in physical order
  236. dbsetorder( 0 )
  237.  
  238. // add a new record at eof
  239. dbappend()
  240.  
  241. // back up through the file moving records down as we go
  242. WHILE recno() > nRec
  243.  
  244.   // store all values from previous record in the appropriate cargo space
  245.   goto recno() - 1
  246.   aeval( aFields, { | a | a[ FLD_VAL ] := eval( a[ FLD_BLK ] ) } )
  247.  
  248.   // save deleted status
  249.   lDeleted := deleted()
  250.  
  251.   // replace all values in next record with stored cargo values
  252.   goto recno() + 1
  253.   aeval( aFields, { | a | eval( a[ FLD_BLK ], a[ FLD_VAL ] ) } )
  254.  
  255.   // set deleted status
  256.   iif( lDeleted, dbdelete(), dbrecall() )
  257.  
  258.   // go to previous record
  259.   goto recno() - 1
  260.  
  261. END
  262.  
  263. // blank out the "inserted" record
  264. aeval( aFields, { | a, cType | ;
  265.   cType := valtype( eval( a[ FLD_BLK ] ) ), ;
  266.   eval( a[ FLD_BLK ], ;
  267.     iif( cType $ 'CM', '', ;
  268.     iif( cType = 'N',  0, ;
  269.     iif( cType = 'D',  ctod( '  /  /  ' ), ;
  270.     iif( cType = 'L',  .f., nil ) ) ) ) ) } )
  271.  
  272. // make sure it's not deleted
  273. dbrecall()
  274.  
  275. // leave things the way we found them
  276. dbsetorder( nSavOrd )
  277. set( _SET_DELETED, lSavDel )
  278.  
  279. RETURN nil
  280. //--------------------------------------------------------------------------//