home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol11n19.zip / DUPREC.PRG < prev    next >
Text File  |  1992-06-05  |  4KB  |  93 lines
  1. *****************************************************************
  2. * TDUPR.PRG                                        Clipper 5.01
  3. * Test program to exercise the DupRec function.  Copies
  4. * the database specified on the command line to a new database
  5. * whose structure is sorted alphabetically by field name.
  6. * Use like this:  TDUPR fromdbf todbf
  7. *****************************************************************
  8. PARAMETERS cFrom, cTo
  9. SET PROCEDURE TO Tdupr
  10. DO CASE
  11.   CASE ( cFrom=NIL .OR. cTo=NIL )
  12.     ? "Usage: TDUPR fromdbf todbf"
  13.     RETURN
  14.   CASE AT(".",cTo) > 0             && Don't pass a file extension
  15.     ? "Won't work with file extension."
  16.     RETURN
  17.   CASE cFrom = cTo
  18.     ? "Can't copy a file onto itself"
  19.     RETURN
  20. ENDCASE
  21. USE (cFrom) NEW                    && Open the FROM database
  22. nRecs = RECCOUNT()                 && Save number of records
  23. COPY STRUCTURE EXTENDED TO (cTo)   && Create .DBF with field names
  24. USE (cTo) NEW                      && Open the field names database
  25. CTmp = cTo + ".$$$"                && Create temp filename
  26. SORT TO (cTmp) ON Field_name       && Sort field names ascending order
  27. ERASE (cTo)                        && Erase orig. field names database
  28. CREATE (cTo) FROM (cTmp)           && Create the TO database
  29. ERASE (cTmp)                       && Erase sorted field names database
  30. FOR x = 1 TO nRecs                 && Add blank records to the TO database
  31.   APPEND BLANK
  32. ENDFOR
  33. GO TOP                             && Move record pointer to the top
  34. SELECT 1                           && Select FROM work area
  35. DBEVAL( { || DupRec( 2 ), (cTo)->(DBSKIP()) } )  && Do the copy
  36. CLOSE DATABASES                    && Close all databases
  37. RETURN
  38.  
  39. *****************************************************************
  40. * Function DupRec( nToArea )                         Clipper 5.01
  41. * Copies current record in current work area to current
  42. * record in destination workarea
  43. *****************************************************************
  44. FUNCTION DupRec( nToArea )
  45.   Local aArray, nFromArea
  46.   nFromArea := SELECT()           && Get current work area
  47.   aArray := DBSTRUCT()            && Make a new array with names
  48.                                   && of all the fields
  49.  
  50.   AEVAL(aArray,{ |A|  A[3] := FIELDBLOCK( A[1] ) } )
  51.   * This creates a load/save code block in aArray[x,3] which had
  52.   * contained the field length
  53.  
  54.   AEVAL(aArray,{ |A|  A[2] := EVAL( A[3] ) } )
  55.   * This executes the code block for each row in aArray and loads
  56.   * the record into the array (in the second position)
  57.  
  58.   SELECT ( nToArea )               && Select Destination Work Area
  59.  
  60.   AEVAL(aArray,{ |A|  EVAL( A[3], A[2] ) } )
  61.   * This executes the code block for each row in aArray and saves
  62.   * the record from the array to the database
  63.  
  64.   SELECT ( nFromArea )             && Return to from work area
  65.  
  66.   RETURN                           && Return to caller
  67.  
  68. *****************************************************************
  69. * Function Rec2Array()                               Clipper 5.01
  70. * Copies current record in current work area into an array
  71. *****************************************************************
  72. FUNCTION Rec2Array()
  73.   Local aArray := DBSTRUCT()    // Make a new array
  74.  
  75.   AEVAL(aArray,{ |A|  A[3] := FIELDBLOCK( A[1] ) } )
  76.   * Create load/save Code Block in column three
  77.  
  78.   AEVAL(aArray,{ |A|  A[2] := EVAL( A[3] ) } )
  79.   * Load the record into column two
  80.  
  81.   AEVAL(aArray,{ |A| ASIZE(A, 3) })  // Chop off column four
  82.  
  83.   RETURN aArray                  // Return the array
  84.  
  85. *****************************************************************
  86. * Function Array2Rec( aArray )                       Clipper 5.01
  87. * Copies an array into the current record in current work area
  88. *****************************************************************
  89. FUNCTION Array2Rec( aArray )
  90.   AEVAL(aArray,{ |A|  EVAL( A[3], A[2] ) } )
  91.   RETURN
  92.  
  93.