Guardar Array

[rolando]

Hola amigos,

Quisiera saber si hay alguna función para guardar un array en un archivo en el disco rígido y, en tal caso, una función para recuperarlo.

Gracias.

Rolando

[horacio]

Aqui hay una

/*
* File......: SAVEARR.PRG
* Author....: David Barrett
* CIS ID....: 72037,105
* Date......: $Date: 15 Aug 1991 23:06:06 $
* Revision..: $Revision: 1.2 $
* Log file..: $Logfile: E:/nanfor/src/savearr.prv $
*
* This is an original work by David Barrett and is placed in the
* public domain.
*
* Modification history:
* ---------------------
*
* $Log: E:/nanfor/src/savearr.prv $
*
* Rev 1.2 15 Aug 1991 23:06:06 GLENN
* Forest Belt proofread/edited/cleaned up doc
*
* Rev 1.1 14 Jun 1991 19:52:54 GLENN
* Minor edit to file header
*
* Rev 1.0 07 Jun 1991 23:39:38 GLENN
* Initial revision.
*
*
*/



MEMVAR lRet

#ifdef FT_TEST // test program to demonstrate functions

LOCAL aArray := { {'Invoice 1', CTOD('04/15/91'), 1234.32, .T.},;
{'Invoice 2', DATE(), 234.98, .F.},;
{'Invoice 3', DATE() + 1, 0, .T.} }, aSave
LOCAL nErrorCode := 0
FT_SAVEARR(aArray,'INVOICE.DAT',@nErrorCode)
IF nErrorCode = 0
CLS
DispArray(aArray)
aSave := FT_RESTARR('INVOICE.DAT',@nErrorCode)
IF nErrorCode = 0
DispArray(aSave)
ELSE
? 'Error restoring array'
ENDIF
ELSE
? 'Error writing array'
ENDIF
RETURN

FUNCTION DispArray(aTest)
LOCAL nk
FOR nk := 1 TO LEN(aTest)
? aTest[nk, 1]
?? ' '
?? DTOC(aTest[nk, 2])
?? ' '
?? STR(aTest[nk, 3])
?? ' '
?? IF(aTest[nk, 4], 'true', 'false')
NEXT
RETURN Nil
#endif




/* $DOC$
* $FUNCNAME$
* FT_SAVEARR()
* $CATEGORY$
* Array
* $ONELINER$
* Save Clipper array to a disc file.
* $SYNTAX$
* FT_SAVEARR( <aArray>, <cFileName>, <nErrorCode> ) -> lRet
* $ARGUMENTS$
* <aArray> is any Clipper array except those containing
* compiled code blocks.
*
* <cFileName> is a DOS file name.
*
* <nErrorCode> will return any DOS file error.
*
* All arguments are required.
*
* $RETURNS$
* .F. if there was a DOS file error or the array contained
* code blocks, otherwise returns .T.
* $DESCRIPTION$
* FT_SAVEARR() saves any Clipper array, except those
* containing compiled code blocks, to a disc file. The
* array can be restored from the disc file using
* FT_RESTARR().
*
* $EXAMPLES$
* aArray := { {'Invoice 1',CTOD('04/15/91'),1234.32,.T.},;
* {'Invoice 2',DATE(),234.98,.F.},;
* {'Invoice 3',DATE() + 1,0,.T.} }
* nErrorCode := 0
* FT_SAVEARR(aArray,'INVOICE.DAT',@nErrorCode)
* IF nErrorCode = 0
* aSave := FT_RESTARR('INVOICE.DAT',@nErrorCode)
* IF nErrorCode # 0
* ? 'Error restoring array'
* ENDIF
* ELSE
* ? 'Error writing array'
* ENDIF
*
* $SEEALSO$
* FT_RESTARR()
* $END$
*/


FUNCTION FT_SAVEARR(aArray, cFileName, nErrorCode)
LOCAL nHandle, lRet
nHandle = FCREATE(cFileName)
nErrorCode = FError()
IF nErrorCode = 0
lRet := _ftsavesub(aArray, nHandle, @nErrorCode)
FCLOSE(nHandle)
IF (lRet) .AND. (FERROR() # 0)
nErrorCode = FERROR()
lRet = .F.
ENDIF
ELSE
lRet = .F.
ENDIF
RETURN lRet

STATIC FUNCTION _ftsavesub(xMemVar, nHandle, nErrorCode)
LOCAL cValType, nLen, cString
PRIVATE lRet // accessed in code block
lRet := .T.
cValType := ValType(xMemVar)
FWrite(nHandle, cValType, 1)
IF FError() = 0
DO CASE
CASE cValType = "A"
nLen := Len(xMemVar)
FWrite(nHandle, L2Bin(nLen), 4)
IF FError() = 0
AEVAL(xMemVar, {|xMemVar1| lRet := _ftsavesub(xMemVar1, nHandle) } )
ELSE
lRet = .F.
ENDIF
CASE cValType = "B"
lRet := .F.
CASE cValType = "C"
nLen := Len(xMemVar)
FWrite(nHandle, L2Bin(nLen), 4)
FWrite(nHandle, xMemVar)
CASE cValType = "D"
nLen := 8
FWrite(nHandle, L2Bin(nLen), 4)
FWrite(nHandle, DTOC(xMemVar))
CASE cValType = "L"
nLen := 1
FWrite(nHandle, L2Bin(nLen), 4)
FWrite(nHandle, IF(xMemVar, "T", "F") )
CASE cValType = "N"
cString := STR(xMemVar)
nLen := LEN(cString)
FWrite(nHandle, L2Bin(nLen), 4)
FWrite(nHandle, cString)
ENDCASE
ELSE
lRet = .F.
ENDIF
nErrorCode = FError()
RETURN lRet


/* $DOC$
* $FUNCNAME$
* FT_RESTARR()
* $CATEGORY$
* Array
* $ONELINER$
* Restore a Clipper array from a disc file
* $SYNTAX$
* FT_RESTARR( <cFileName>, <nErrorCode> ) -> aArray
* $ARGUMENTS$
* <cFileName> is a DOS file name.
*
* <nErrorCode> will return any DOS file error.
*
* All arguments are required.
* $RETURNS$
* Return an array variable.
* $DESCRIPTION$
* FT_RESTARR() restores an array which was saved to
* a disc file using FT_SAVEARR().
*
* $EXAMPLES$
* aArray := { {'Invoice 1',CTOD('04/15/91'),1234.32,.T.},;
* {'Invoice 2',DATE(),234.98,.F.},;
* {'Invoice 3',DATE() + 1,0,.T.} }
* nErrorCode := 0
* FT_SAVEARR(aArray,'INVOICE.DAT',@nErrorCode)
* IF nErrorCode = 0
* aSave := FT_RESTARR('INVOICE.DAT',@nErrorCode)
* IF nErrorCode # 0
* ? 'Error restoring array'
* ENDIF
* ELSE
* ? 'Error writing array'
* ENDIF
*
* $SEEALSO$
* FT_SAVEARR()
* $END$
*/

FUNCTION FT_RESTARR(cFileName, nErrorCode)
LOCAL nHandle, aArray
nHandle := FOPEN(cFileName)
nErrorCode := FError()
IF nErrorCode = 0
aArray := _ftrestsub(nHandle, @nErrorCode)
FCLOSE(nHandle)
ELSE
aArray := {}
ENDIF
RETURN aArray

STATIC FUNCTION _ftrestsub(nHandle, nErrorCode)
LOCAL cValType, nLen, cLenStr, xMemVar, cMemVar, nk
cValType := ' '
FREAD(nHandle, @cValType, 1)
cLenStr := SPACE(4)
FREAD(nHandle, @cLenStr, 4)
nLen = Bin2L(cLenStr)
nErrorCode = FError()
IF nErrorCode = 0
DO CASE
CASE cValType = "A"
xMemVar := {}
FOR nk := 1 TO nLen
AADD(xMemVar, _ftrestsub(nHandle)) // Recursive call
NEXT
CASE cValType = "C"
xMemVar := SPACE(nLen)
FREAD(nHandle, @xMemVar, nLen)
CASE cValType = "D"
cMemVar = SPACE(8)
FREAD(nHandle, @cMemVar,8)
xMemVar := CTOD(cMemVar)
CASE cValType = "L"
cMemVar := ' '
FREAD(nHandle, @cMemVar, 1)
xMemVar := (cMemVar = "T")
CASE cValType = "N"
cMemVar := SPACE(nLen)
FREAD(nHandle, @cMemVar, nLen)
xMemVar = VAL(cMemVar)
ENDCASE
nErrorCode := FERROR()
ENDIF
RETURN xMemVar


[Antonio Linares]

Rolando,

Revisa las funciones de FWH ASave() y ARead().

Puedes usar:
MemoWrit( "array.txt", ASave( aArray ) )

y luego para restaurar:
aArray = ARead( MemoRead( "array.txt" ) )