Guardar Array
Posted:
Wed Mar 12, 2008 3:18 pm
by 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
Posted:
Wed Mar 12, 2008 4:18 pm
by 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
Posted:
Sat May 17, 2008 8:36 am
by 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" ) )