Página 1 de 1

Salve e recupere arrays em arquivo. Clipper Puro

Enviado: 19 Mai 2005 16:04
por rochinha
Amiguinhos

Achei estas funções em meus .PRgs que servem para tal façanha.

Facil de usar, veja:

Salvar:

Array := { "teste", 123, date() }
EK_SAVEARR( Array, "teste.arr" )

Recuperar:

Array := EK_RESTARR( "teste.arr" )

Muito baba.

Código: Selecionar todos

/*
 *
 * *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
 * Description: Funcoes de controle de Arrays
 * *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
 *
 */
Function EK_SAVEARR(Arg1, Arg2, Arg3)        //Arg1=Array, Arg2=archivo, Arg3=doserror
   local Local1:= Fcreate(Arg2), Local2
   Arg3:= Ferror()
   If (Arg3 == 0)
      Local2:= _eksavesub(Arg1, Local1, @Arg3)
      Fclose(Local1)
      If (Local2 .AND. Ferror() != 0)
         Arg3:= Ferror()
         Local2:= .F.
      EndIf
   Else
      Local2:= .F.
   EndIf
   Return Local2

Static Function _EKSAVESUB(Arg1, Arg2, Arg3)
   local Local1, Local2, Local3
   private lret
   lret:= .T.
   Local1:= ValType(Arg1)
   Fwrite(Arg2, Local1, 1)
   If (Ferror() == 0)
   Do Case
      Case Local1 = "A"
           Local2:= Len(Arg1)
           Fwrite(Arg2, L2Bin(Local2), 4)
           If (Ferror() == 0)
              AeVal(Arg1, {|_1| lret:= _eksavesub(_1, Arg2)})
           Else
              lret:= .F.
           EndIf
      Case Local1 = "B"
           lret:= .F.
      Case Local1 = "C"
           Local2:= Len(Arg1)
           Fwrite(Arg2, L2Bin(Local2), 4)
           Fwrite(Arg2, Arg1)
      Case Local1 = "D"
           Local2:= 8
           Fwrite(Arg2, L2Bin(Local2), 4)
           Fwrite(Arg2, DToC(Arg1))
      Case Local1 = "L"
           Local2:= 1
           Fwrite(Arg2, L2Bin(Local2), 4)
           Fwrite(Arg2, iif(Arg1, "T", "F"))
      Case Local1 = "N"
           Local3:= Str(Arg1)
           Local2:= Len(Local3)
           Fwrite(Arg2, L2Bin(Local2), 4)
           Fwrite(Arg2, Local3)
      Endcase
   Else
      lret:= .F.
   Endif
   Arg3:= ferror()
   Return lret

Function EK_RESTARR(Arg1, Arg2)       // Arg1=Archivo, Arg2=doserror
   Local Local1:= Fopen(Arg1), Local2
   Arg2:= Ferror()
   If (Arg2 == 0)
      Local2:= _ekrestsub(Local1, @Arg2)
      FClose(Local1)
   Else
      Local2:= {}
   Endif
   Return Local2

Static Function _EKRESTSUB(Arg1, Arg2)
   local Local1:= " ", Local2, Local3, Local4, Local5, Local6
   Fread(Arg1, @Local1, 1)
   Local3:= Space(4)
   Fread(Arg1, @Local3, 4)
   Local2:= Bin2L(Local3)
   Arg2:= Ferror()
   If (Arg2 == 0)
      Do Case
         Case Local1 = "A"
            Local4:= {}
            For Local6 := 1 To Local2
               AAdd(Local4, _ekrestsub(Arg1))
            Next Local6
         Case Local1 = "C"
            Local4:= Space(Local2)
            Fread(Arg1, @Local4, Local2)
         Case Local1 = "D"
            Local5:= Space(8)
            Fread(Arg1, @Local5, 8)
            Local4:= CToD(Local5)
         Case Local1 = "L"
            Local5:= " "
            Fread(Arg1, @Local5, 1)
            Local4:= Local5 = "T"
         Case Local1 = "N"
            Local5:= Space(Local2)
            Fread(Arg1, @Local5, Local2)
            Local4:= Val(Local5)
      Endcase
         Arg2:= ferror()
   Endif
   Return Local4
@braços :?)