home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS - Coast to Coast
/
simteldosarchivecoasttocoast.iso
/
pcmag
/
vol11n19.zip
/
DUPREC.PRG
< prev
next >
Wrap
Text File
|
1992-06-05
|
4KB
|
93 lines
*****************************************************************
* TDUPR.PRG Clipper 5.01
* Test program to exercise the DupRec function. Copies
* the database specified on the command line to a new database
* whose structure is sorted alphabetically by field name.
* Use like this: TDUPR fromdbf todbf
*****************************************************************
PARAMETERS cFrom, cTo
SET PROCEDURE TO Tdupr
DO CASE
CASE ( cFrom=NIL .OR. cTo=NIL )
? "Usage: TDUPR fromdbf todbf"
RETURN
CASE AT(".",cTo) > 0 && Don't pass a file extension
? "Won't work with file extension."
RETURN
CASE cFrom = cTo
? "Can't copy a file onto itself"
RETURN
ENDCASE
USE (cFrom) NEW && Open the FROM database
nRecs = RECCOUNT() && Save number of records
COPY STRUCTURE EXTENDED TO (cTo) && Create .DBF with field names
USE (cTo) NEW && Open the field names database
CTmp = cTo + ".$$$" && Create temp filename
SORT TO (cTmp) ON Field_name && Sort field names ascending order
ERASE (cTo) && Erase orig. field names database
CREATE (cTo) FROM (cTmp) && Create the TO database
ERASE (cTmp) && Erase sorted field names database
FOR x = 1 TO nRecs && Add blank records to the TO database
APPEND BLANK
ENDFOR
GO TOP && Move record pointer to the top
SELECT 1 && Select FROM work area
DBEVAL( { || DupRec( 2 ), (cTo)->(DBSKIP()) } ) && Do the copy
CLOSE DATABASES && Close all databases
RETURN
*****************************************************************
* Function DupRec( nToArea ) Clipper 5.01
* Copies current record in current work area to current
* record in destination workarea
*****************************************************************
FUNCTION DupRec( nToArea )
Local aArray, nFromArea
nFromArea := SELECT() && Get current work area
aArray := DBSTRUCT() && Make a new array with names
&& of all the fields
AEVAL(aArray,{ |A| A[3] := FIELDBLOCK( A[1] ) } )
* This creates a load/save code block in aArray[x,3] which had
* contained the field length
AEVAL(aArray,{ |A| A[2] := EVAL( A[3] ) } )
* This executes the code block for each row in aArray and loads
* the record into the array (in the second position)
SELECT ( nToArea ) && Select Destination Work Area
AEVAL(aArray,{ |A| EVAL( A[3], A[2] ) } )
* This executes the code block for each row in aArray and saves
* the record from the array to the database
SELECT ( nFromArea ) && Return to from work area
RETURN && Return to caller
*****************************************************************
* Function Rec2Array() Clipper 5.01
* Copies current record in current work area into an array
*****************************************************************
FUNCTION Rec2Array()
Local aArray := DBSTRUCT() // Make a new array
AEVAL(aArray,{ |A| A[3] := FIELDBLOCK( A[1] ) } )
* Create load/save Code Block in column three
AEVAL(aArray,{ |A| A[2] := EVAL( A[3] ) } )
* Load the record into column two
AEVAL(aArray,{ |A| ASIZE(A, 3) }) // Chop off column four
RETURN aArray // Return the array
*****************************************************************
* Function Array2Rec( aArray ) Clipper 5.01
* Copies an array into the current record in current work area
*****************************************************************
FUNCTION Array2Rec( aArray )
AEVAL(aArray,{ |A| EVAL( A[3], A[2] ) } )
RETURN