Guardar Arreglos en campo de una tabla

Post Reply
hugotheler
Posts: 15
Joined: Wed Sep 05, 2007 7:32 pm

Guardar Arreglos en campo de una tabla

Post by hugotheler »

Hola :

.Alguien sabe si en Xharbour-FiveWin con el RDD de ADS se puede almacenar un arreglo en un campo memo. En Clipper-FiveWin con ADS si lo puedo hacer.


Gracias
Theler Hugo
R.F.
Posts: 840
Joined: Thu Oct 13, 2005 7:05 pm

Post by R.F. »

Si, en campos memo con el driver CDX y en campos blob con ADTs
Saludos
R.F.
hugotheler
Posts: 15
Joined: Wed Sep 05, 2007 7:32 pm

Post by hugotheler »

Gracias Rene , voy a probar.
hugotheler
Posts: 15
Joined: Wed Sep 05, 2007 7:32 pm

Como hago para grabar en un campo BLOB

Post by hugotheler »

Hola :

Como hago para grabar en un campo BLOB ( un Arreglo ) , Que funcion utilizo ??

En clipper 5.3 y ADS lo hago muy simple :

Field->CampoMemo := aDatos

Lo mismo para leerlo de un archivo

aDatos := Field->CampoMemo

Esto no me es soportado ( Aparentemente por xHarbour ) y ADS...? o necesito alguna otra función...?
User avatar
carlos vargas
Posts: 1421
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Post by carlos vargas »

aver por partes :-)

por ejemplo en unas de mis app tengo una tabla de cliente, dicha tabla tiene un campo memo en donde se almacena un arreglo que es una tabla de pagos (tabla de amortizacion).

basicamente DBFCDX y RDD similar deben en teoria almacenar un array y luego al aplicarlo a una var esta variable contiene el array.

ejemplo.

Code: Select all

local aDir := Directory("*.*")
local aTbl := {{"ARREGLO","M",10,00}}

dbcreate("prueba.dbf",aTbl,"DBFCDX")

use prueba

prueba->ARREGLO := aDir

aDir := NIL

aDir := prueba->ARREGLO
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
User avatar
carlos vargas
Posts: 1421
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Post by carlos vargas »

Continuando el caso es que no me funciono de esta manera por que algo habia en ese entonces que fallaba en el rdd.

por lo que tube que hacer uso de dos funciones de xharbour que pasara el contenido del arreglo a texto y luego que una vez recuperado el texto lo trasnformara en array.

como estoy alejado de mi codigo hoy, y la verdad me acuerdo poco, creo recordar que hb_valtoprg pasa el valor del array a texto que se almcena facilmente a un campo memo y una funcion hb_arrayexec o algo asi que pasa un texto a un array nuevamente.

en esto ultimo habria que investigar :-) de cualquier forma mañana puedo postear el codigo que utilizo.

me informas como avanzas :-)

salu2
carlos vargas
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
User avatar
carlos vargas
Posts: 1421
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Post by carlos vargas »

aca el codigo :-)

SALD->TT_NOTAS := ValToPrgExp(aInfo[CP_DETALLE]) //aca se guarda

cDetalle:=SALD->TT_NOTAS

IF !Empty(cDetalle)
aDetalle := &cDetalle
IF ISARRAY(aDetalle)

Code: Select all

PROCEDURE ReporteDeSaldo_Proceso(lDetalle)
   LOCAL cId
   LOCAL anInfo
   LOCAL nCuotas
   PRIVATE nContador

   /*desabilita controles*/
   oFecha:disable()
   oBtnOk:disable()
   oBtnExit:disable()

   /*incializa contador*/
   nContador   := 0

   /*solo contratos activos*/
   IF empty( dFecha )
      SET FILTER TO CONT->USSALDOI>0 .AND. CONT->USMONTO>10 .AND. !CANCELADO
   ELSE
      SET FILTER TO CONT->USSALDOI>0 .AND. CONT->USMONTO>10 .AND. CONT->FECHA <= DFECHA .AND. !CANCELADO
   ENDIF
   CONT->(DBGoTop())

   /*cuenta registros*/
   COUNT TO nContador

   /*define margen de progress bar*/
   oPBar:SetRange(1,nContador)

   /*inicio de tabla de contratos*/
   CONT->(DBGoTop())

   /*procesa cada contrato hasta alcanzar el final del archivo*/
   nContador := 0
   WHILE !CONT->(Eof())

      /*actualiza avanze en barra de progreso*/
      oPBar:SetPos(++nContador)
      oGet:SetText("Procesando contrato no. ["+RTrim(CONT->ID)+"]")

      /*procesa llamadas de windows*/
      SysRefresh()

      /*recupera informacion de los pagos de este contrato*/
      IF !lDetalle
         aInfo:=ReporteDeSaldo_LoPagado()
      ELSE
         aInfo:=ReporteDeSaldo_LoPagado2()
      ENDIF

      /*inserta informacion de pagos de este contrato*/
      SALD->(DBAppend())
      SALD->TT_CONTA := nContador
      SALD->TT_CONTR := CONT->ID
      SALD->TT_SUSCR := CONT->NOMBRE
      SALD->TT_FECHA := CONT->FECHA
      SALD->TT_PAGAD := aInfo[CP_PAGADO ]
      SALD->TT_CAPIT := aInfo[CP_CAPITAL]
      SALD->TT_INTER := aInfo[CP_INTERES]
      SALD->TT_SEGUR := aInfo[CP_SEGURO ]
      SALD->TT_NUMPA := aInfo[CP_PAGOS  ]
      SALD->TT_NOTAS := ValToPrgExp(aInfo[CP_DETALLE])     //aca se guarda

      cId:=CONT->ID

      /*numero de cuotas*/
      IF StrCharCount(cId,"-")>2
         SALD->TT_NUMCU:=Val(StrToken(cId,3,"-"))*12
      ENDIF

      /*calculo del valor inicial del contrato*/
      SALD->TT_VALOR:=ReporteDeSaldo_ValorContrato()

      /*calculo del saldo*/
      SALD->TT_SALDO:=SALD->TT_VALOR - SALD->TT_PAGAD

      /*siguiente contrato*/
      CONT->(DBSkip())

   ENDDO

   /*mensaje informativo*/
   Msginfo("Fin de proceso, "+AllTrim(Transform(nContador,"99,999,999"))+" Contratos procesados")

   /*reporte a excel*/
   IF lDetalle
      ReporteDeDetalle_ToExcel()
   ELSE
      ReporteDeSaldo_ToExcel()
   ENDIF

   /*habilita controles*/
   oFecha:enable()
   oBtnOk:enable()
   oBtnExit:enable()

RETURN
PROCEDURE ReporteDeDetalle_ToExcel()
PRIVATE oExcel, oHoja, nRow, cRango, nSaldo1, nSaldo2, nSaldo3
PRIVATE cDetalle, aDetalle, nLenDetalle, x
PRIVATE nSaldoAnt, lInicio, dMes, dAno, dFinMes, nPagoAcu, dFecPag, dFecAnt

IF !MsgNoYes( "Exportar reporte a excel?" )
RETURN
ENDIF

TRY
oExcel := GetActiveObject( "Excel.Application" )
CATCH
TRY
oExcel := CreateObject( "Excel.Application" )
CATCH
MsgAlert( "ERROR! Excel no esta disponible. ", Ole2TxtError() )
RETURN
END
END

CursorWait()
SysRefresh()
oDlg:SetText( "Importando datos a excel!" )

oPBar:SetRange(1,nContador)

nRow:=0

oExcel:WorkBooks:Add()

oHoja := oExcel:Get( "ActiveSheet" )
oHoja:Cells:Font:Name := "Tahoma"
oHoja:Cells:Font:Size := 10

oHoja:Cells(++nRow,1):Value := "Jardines del Recuerdo, S.A."
oHoja:Cells(++nRow,1):Value := "Detalle de pagos de contratos"
IF !empty(dFecha)
oHoja:Cells(++nRow,1):Value := CMonth(dFecha) + " del año " + Str(Year(dFecha),4)
ENDIF

oHoja:Range( "A1:A2" ):Font:Name := "Times New Roman"
oHoja:Range( "A1:A2" ):Font:Size := 14
oHoja:Range( "A1:A2" ):Font:Bold := TRUE
oHoja:Range( "A1:A2" ):Font:Color := CLR_BLUE
oHoja:Range( "A3:A3" ):Font:Size := 12
oHoja:Range( "A3:A3" ):Font:Bold := TRUE
oHoja:Range( "A3:A3" ):Font:Color := CLR_RED

nRow += 2

oHoja:Cells( nRow, 1 ):Value := "No." //A - 1
oHoja:Cells( nRow, 2 ):Value := "ID Contrato" //B - 2
oHoja:Cells( nRow, 3 ):Value := "Suscriptor" //C - 3
oHoja:Cells( nRow, 4 ):Value := "Fecha Cont." //D - 4
oHoja:Cells( nRow, 5 ):Value := "Fecha UCP" //E - 4
oHoja:Cells( nRow, 6 ):Value := "Saldo Ant. U$" //F - 5
oHoja:Cells( nRow, 7 ):Value := "Debe U$" //G - 6
oHoja:Cells( nRow, 8 ):Value := "Haber U$" //H - 7
oHoja:Cells( nRow, 9 ):Value := "Saldo U$" //I - 8

oHoja:Rows( ltrim( str( nRow ) ) + ":" + ltrim( str( nRow ) ) ):RowHeight := 28
oHoja:Rows( ltrim( str( nRow ) ) + ":" + ltrim( str( nRow ) ) ):VerticalAlignment := xlCenter

cRango := "A" + LTrim( Str( nRow ) ) + ":I" + LTrim( Str( nRow ) )

oHoja:Range( cRango ):Font:Bold := TRUE
oHoja:Range( cRango ):Font:Color := CLR_YELLOW
oHoja:Range( cRango ):Interior:Color := CLR_CYAN
oHoja:Range( cRango ):Borders():LineStyle := 1

oHoja:Columns( 1 ):HorizontalAlignment := xlCenter
oHoja:Columns( 6 ):HorizontalAlignment := xlRight
oHoja:Columns( 7 ):HorizontalAlignment := xlRight
oHoja:Columns( 8 ):HorizontalAlignment := xlRight
oHoja:Columns( 9 ):HorizontalAlignment := xlRight

oHoja:Columns( 1 ):NumberFormat := "#,##0"
oHoja:Columns( 4 ):NumberFormat := "dd/mm/yyyy"
oHoja:Columns( 5 ):NumberFormat := "dd/mm/yyyy"
oHoja:Columns( 6 ):NumberFormat := "#,##0.00"
oHoja:Columns( 7 ):NumberFormat := "#,##0.00"
oHoja:Columns( 8 ):NumberFormat := "#,##0.00"
oHoja:Columns( 9 ):NumberFormat := "#,##0.00"

oHoja:Range( "A1:A3" ):HorizontalAlignment := xlLeft

oGet:SetText( "Exportando los datos a una hoja en EXCEL" )

nSaldo1 := nSaldo2 := nSaldo3 := nContador := 0
SALD->(DBGoTop())
++nRow
DO WHILE !SALD->(Eof())

IF nContador % 20 = 0
SysRefresh()
ENDIF

oHoja:Cells(nRow,1):Value := SALD->TT_CONTA
oHoja:Cells(nRow,2):Value := SALD->TT_CONTR
oHoja:Cells(nRow,3):Value := RTrim(SALD->TT_SUSCR)

cDetalle:=SALD->TT_NOTAS

IF !Empty(cDetalle)
aDetalle := &cDetalle //aca se convierte a array nuevamente
IF ISARRAY(aDetalle)
nLenDetalle := Len( aDetalle )
nPagoEnMes := 0
FOR x:=1 TO nLenDetalle
dFechaPago := aDetalle[x,1]
IF Beetwen(dFechaPago,bom(dFecha),eom(dFecha))
nPagoEnMes += aDetalle[x,3]
ENDIF
NEXT
oHoja:Cells( nRow, 4 ):Value := aDetalle[1,1]
oHoja:Cells( nRow, 5 ):Value := aDetalle[nLenDetalle,1]
oHoja:Cells( nRow, 6 ):Value := aDetalle[nLenDetalle,4]+nPagoEnMes
oHoja:Cells( nRow, 7 ):Value := 0
oHoja:Cells( nRow, 8 ):Value := nPagoEnMes
oHoja:Cells( nRow, 9 ):Value := aDetalle[nLenDetalle,4]
ENDIF
ELSE
oHoja:Cells( nRow, 4 ):Value := SALD->TT_FECHA//DFECHA
oHoja:Cells( nRow, 6 ):Value := 0
oHoja:Cells( nRow, 7 ):Value := SALD->TT_VALOR
oHoja:Cells( nRow, 8 ):Value := 0
oHoja:Cells( nRow, 9 ):Value := SALD->TT_VALOR
ENDIF

++nRow
SALD->(DBSkip())

oPBar:SetPos(++nContador)

ENDD

CursorArrow()
SysRefresh()

oHoja:Columns( 2 ):AutoFit()
oHoja:Columns( 3 ):AutoFit()
oHoja:Columns( 4 ):AutoFit()
oHoja:Columns( 5 ):AutoFit()
oHoja:Columns( 6 ):AutoFit()
oHoja:Columns( 7 ):AutoFit()
oHoja:Columns( 8 ):AutoFit()
oHoja:Columns( 9 ):AutoFit()

oHoja:SaveAs( "saldo"+DToS(Date())+".xls" )

oExcel:Visible := TRUE
oHoja := NIL
oExcel := NIL

RETURN

Code: Select all


Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
User avatar
Raymundo Islas M.
Posts: 590
Joined: Tue Mar 14, 2006 11:34 pm
Location: Acapulco, Gro. MEXICO

Post by Raymundo Islas M. »

Hola Carlos

Esto es exactamente lo que iba a buscar hoy, ya que me acaba de surgir la necesidad de grabar los datos de un arreglo, para despues recuperlos y aplicarlos a X proceso.

El detalle es que si agrego el campo memo a la base, me manda un error y me truena la app, si se lo quito trabaja normal, estoy linkando la DBFFTP.LIB.

Cualquier sugerencia al respecto es bienvenida :D


Saludos Amigo
FWH 10.6 + xHarbour + Borland 582
User avatar
carlos vargas
Posts: 1421
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Post by carlos vargas »

a ver, que te parece si lo miramos en detalle en el meseenger hoy por la tarde, luego publicamos los resultados aca mismo :-)

veremos en detalle lo que necesitas realizar.

salu2
carlos vargas
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
User avatar
Raymundo Islas M.
Posts: 590
Joined: Tue Mar 14, 2006 11:34 pm
Location: Acapulco, Gro. MEXICO

Post by Raymundo Islas M. »

Carlos :

Claro que si, estare en linea.

Saludos Amigo
FWH 10.6 + xHarbour + Borland 582
User avatar
carlos vargas
Posts: 1421
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Post by carlos vargas »

Ray prueba este prg, si bien no guara en memo, por que me queda revisar tu problema, aca se demuestra como almacenar un array y luego recuperarlo.

quedamos hoy en la tarde por el msn :-)

Code: Select all


PROCEDURE Main
	LOCAL aArray := {{"carlos",.t.,123,date(),nil}}
	local bArray := {1,date(),time(),pi(),.f.,nil}
	local a, b, c, d

	a := ArrayToPrg( aArray )
	b := ArrayToPrg( bArray )

        ?a
	?b

	c=&(a)
	d=&(b)

	?valtype(c),len(c),len(c[1]),c[1,1]
	?valtype(d),len(d),d[1],d[2],d[3],d[4],d[5],d[6]

RETURN

//--------------------------------------------------------------//

FUNCTION ArrayToPrg( xVal )
	LOCAL cType := ValType( xVal )
	LOCAL cRet  := '{}'
	LOCAL aVar

    DO CASE
	CASE cType == "A"	
		cRet := "{ "
		FOR EACH aVar IN xVal
			cRet += ( ArrayToPrg( aVar ) + ", " )
		NEXT
		IF cRet[ -2 ] == ','
			cRet[ -2 ] := ' '
		ENDIF
		cRet[ -1 ] := '}'
		RETURN cRet
	CASE cType == "D"
		RETURN "stod( '" + dtos( xVal ) + "' )"
	CASE cType == "N"
		RETURN ltrim( str( xVal ) )
	CASE cType == "L"
		RETURN iif( xVal, ".T.", ".F." )
	CASE cType == "C"
	    RETURN "'"+xVal+"'"
        CASE cType == "U"
	    RETURN "NIL"
	ENDCASE

RETURN cRet

//--------------------------------------------------------------//
Salu2
Carlos Vargas
Desde Managua, Nicaragua (CA)
Post Reply