Convertir Array a DBF

1,336 views
Skip to first unread message

Cesar Palomo

unread,
Oct 18, 2012, 6:50:53 PM10/18/12
to publice...@googlegroups.com
Hola, necesito saber si alguien me puede ayudar a convertir una matriz (array) en una tabla.
La matriz tiene una cantidad distinta de columnas cada vez que se corre el programa, por lo que necesito generar la estructura de la tabla dependiendo de la cantidad de columnas que la tabla tenga y luego copiar los valores del array dentro de la tabla; el comando "append from array" no me funciona mientras no tenga creada la tabla a la que le voy a pasar los valores.

Alguna idea?

FidelJ

unread,
Oct 18, 2012, 7:21:45 PM10/18/12
to publice...@googlegroups.com
Una idea en un ejemplo (que funciona)
DIMENSION galist(6,5)

gaList[1,1]=[Generar determinacion]
gaList[2,1]=[Consultar Determinaciones]
gaList[3,1]=[Saldos a Favor Libre Disponibilidad]
gaList[4,1]=[Saldos a Favor Técnicos]
gaList[5,1]=[Tabla de Retenciones I.V.A.]
gaList[6,1]=[Tabla Retenciones Ganancias]

gaList[1,2]=[detimp]
gaList[2,2]=[deticons]
gaList[3,2]=[detisalfa]
gaList[4,2]=[detisalfa]
gaList[5,2]=[tabretiva]
gaList[6,2]=[tabretiva]

gaList[1,3]=1285
gaList[2,3]=1436
gaList[3,3]=1440
gaList[4,3]=2728.5
gaList[5,3]=1872.15
gaList[6,3]=1916.25

gaList[1,4]=.f.
gaList[2,4]=.t.
gaList[3,4]=.f.
gaList[4,4]=.t.
gaList[5,4]=.f.
gaList[6,4]=.f.

gaList[1,5]=CTOD("15/09/2012")
gaList[2,5]=CTOD("16/09/2012")
gaList[3,5]=CTOD("15/10/2012")
gaList[4,5]=CTOD("16/10/2012")
gaList[5,5]=CTOD("15/11/2012")
gaList[6,5]=CTOD("16/11/2012")

nCol=ALEN(galist,2)
DIMENSION gastruc(nCol,4)
nStru=0
FOR i=1 TO ALEN(gaLIst,2)
cType=VARTYPE(gaList[1,i])
gastruc[i,1]="Campo"+LTRIM(STR(i))
gastruc[i,2]=cType
nDec=0
DO CASE 
CASE ctype="D"
nLen=8
CASE ctype="N"
                        && acá se configura automáticamente en 12,2, pero se puede refinar
                        && detectando si son enteros e incluso el tamaño.
nLen=12
nDec=2
CASE cType="C"
                    && acá se busca el String más largo
   nLen=0
FOR h=1 TO ALEN(gaLIst,1)
IF LEN(gaList[h,i])>nLen
nLen=LEN(galist[h,i])
ENDIF
NEXT
CASE ctype="L"
nLen=1
ENDCASE
gastruc[i,3]=nLen
gastruc[i,4]=nDec
NEXT
IF USED("MITABLA")
SELECT MITABLA
USE
ENDIF
CREATE TABLE MITABLA FREE FROM ARRAY gaStruc
SELECT mitabla
APPEND FROM ARRAY galist
GO top
BROWSE

Allan Raúl Acuña

unread,
Oct 18, 2012, 7:31:25 PM10/18/12
to publice...@googlegroups.com
CREATE CURSOR alias_name 

...[CODEPAGE=nCodePage]

   (fname1 cFieldType [(nFieldWidth [, nPrecision])] [NULL | NOT NULL] 

   [CHECK lExpression [ERROR cMessageText]] 

   [AUTOINC [NEXTVALUE NextValue [STEP StepValue]]]

   [DEFAULT eExpression] [UNIQUE [COLLATE cCollateSequence]]

   [NOCPTRANS] [, fname2 ...]) 

   | FROM ARRAY ArrayName

en la ayuda lo tienes, CREATE CURSOR crsTemp FROM ArrayName

Luego select crsTemp
copy to c:\mitabla.dbf

Intenta y nos comentas!

Saludos cordiales;

Lic. Allan R. Acuña
Desarrollador Independiente
msn= allan...@hotmail.com
skype= niceasysoft
            +(505) 8 831 8191      
www.NicEasySoft.com
Managua, Nicaragua
Centroamérica



Date: Thu, 18 Oct 2012 15:50:53 -0700
From: ce...@cegap.com
To: publice...@googlegroups.com
Subject: [vfp] Convertir Array a DBF


Hola, necesito saber si alguien me puede ayudar a convertir una matriz (array) en una tabla.
La matriz tiene una cantidad distinta de columnas cada vez que se corre el programa, por lo que necesito generar la estructura de la tabla dependiendo de la cantidad de columnas que la tabla tenga y luego copiar los valores del array dentro de la tabla; el comando "append from array" no me funciona mientras no tenga creada la tabla a la que le voy a pasar los valores.

Alguna idea?

--
 
 
 

HernanCano

unread,
Oct 20, 2012, 12:50:13 AM10/20/12
to publice...@googlegroups.com
** Browse_Array.prg
parameter pArray,pHead
set talk off

private lcCreateSQL, lcFields
lcCreateSQL = [ CURSOR cTemp (]

private lcLength, lnColumns, lnRows, lnI, lnR

if empty(pHead)
pHead=[Browse_Array]
endif

**
if empty(pArray)
   wait window pHead+[.  pArray vac¡o.]+chr(13)+[1. Se ejecutar  la demo.....]
   wait window pHead+[.  pArray vac¡o.]+chr(13)+[2. Se ejecutar  la demo...]
   wait window pHead+[.  pArray vac¡o.]+chr(13)+[3. Se ejecutar  la demo]
   dimension pArray(1)
   =adir(pArray,[*.prg])
endif
**
if type([pArray(1)])=[U]
   wait window pHead+[: no es un arreglo]
   return
endif
**

*disp memo like parray
*wait

*-- Get the total number of rows & columns
lnRows   = ALEN(pArray,1)
lnColumns= ALEN(pArray,2)

*disp memo
*wait

**
if lnRows<1
   wait window pHead+[: no hay datos];
    +[; Rows: ]+alltrim(str(lnRows));
    +[; Cols: ]+alltrim(str(lnColumns))
   return
endif
**
if lnColumns<1
   wait window pHead+[: unidimensional];
    +[; Rows: ]+alltrim(str(lnRows));
    +[; Cols: ]+alltrim(str(lnColumns)) time 1
   lnColumns=1
endif
**

*-- Loop through the columns array and generate the fields part of the sql
lcFields = []

if lnColumns>1 or .t.

FOR lnI = 1 TO lnColumns
   lcType = TYPE("pArray[1,lnI]")

   lcLength = 0
   FOR lnR = 1 TO lnRows
      lcLength = max(lcLength, LEN(transform(pArray[lnR,lnI])) )
   NEXT

   if lcLength = 0
   wait window pHead+[: what has happend?: ¿lcLength = 0?]
   endif
   if lnI = 1
      lcLength = max(lcLength, LEN(transform(pHead)) )
   endif

   DO CASE
   CASE lcType = "C"
      lcLength = ALLTRIM(STR(lcLength))
   CASE INLIST(lcType, "I", "F", "N", "Y")
      lcLength = ALLTRIM(STR(lcLength))
   CASE INLIST(lcType, "M", "G", "L")
      lcLength = []
   OTHERWISE
      lcLength = []
   ENDCASE

   if !empty(lcLength)
      lcLength = " (" + lcLength + ")"
   endif

   lcFields = lcFields + IIF(EMPTY(lcFields), [], [, ]) + ;
     "c_" + ALLTRIM(STR(lnI)) + [ ] + lcType + lcLength
NEXT

else

FOR lnI = 1 TO lnRows
   lcType = TYPE("pArray[1,lnI]")

   lcLength = LEN(transform(pArray[1,lnI]))
 
   if lcLength = 0
   wait window pHead+[: what has happend?: ¿lcLength = 0?]
   endif

   DO CASE
   CASE lcType = "C"
      lcLength = ALLTRIM(STR(lcLength))
   CASE INLIST(lcType, "I", "F", "N", "Y")
      lcLength = ALLTRIM(STR(lcLength))
   CASE INLIST(lcType, "M", "G", "L")
      lcLength = []
   OTHERWISE
      lcLength = []
   ENDCASE

   if !empty(lcLength)
      lcLength = " (" + lcLength + ")"
   endif

   lcFields = lcFields + IIF(EMPTY(lcFields), [], [, ]) + ;
     "c_" + ALLTRIM(STR(lnI)) + [ ] + lcType + lcLength
NEXT

endif

CREATE &lcCreateSQL &lcFields )

if lnColumns>1 or .t.
   FOR lnRowCount = 1 TO lnRows
      APPEND BLANK
      FOR lnColCount = 1 TO lnColumns
         REPLACE (FIELD(lnColCount)) WITH pArray[lnRowCount, lnColCount]
      NEXT
   NEXT
else
   APPEND BLANK
   FOR lnColCount = 1 TO lnRows
      REPLACE (FIELD(lnColCount)) WITH pArray[1, lnColCount]
   NEXT
endif
if type(FIELD(1))=type([pHead])
APPEND BLANK
REPLACE (FIELD(1)) WITH pHead
endif

browse noedit nodelete

HernanCano

unread,
Oct 20, 2012, 12:51:58 AM10/20/12
to publice...@googlegroups.com
**
** Dic-2006: hernancano
**
** funciona en FPW
** no falla cuando es unidimensional
*
* Name: Array Browser
*     : This is a development tool that allows to view an array in
*          the Browse window
*
* Note 1 : The colum Name format : <T>_<C>_<L>
*          T - Column type, V if there are diff types of values in the column
*          C - Column Number
*          L - Max len requered to represent value in this column.
*              Added only in the columns with data types of variable size.
*
* Note 2 : The BrowseArrayCursor cursor isn't closed to allow BROWSE NOWAIT
*
* Author : Sergey Berezniker    
*        : Version 1.0.10    04/25/2002
* Email  : sergeyb-at-isgcom.com
*        : This program is placed into Public domain. Comments and suggestions
*            are welcome.
*
* Changes: 19.03.2002 by Daniel Gramunt: Optional parameter < tcCaption > added
*          03/19/2002 by --SB-- : Modified the BROWSE command to display in the
*                                 desktop.
*          04/24/2002 by --SB-- : Fixed problem with the objects in the array.
*          04/25/2002 by --SB-- : The size isn't added to the column name with
*                                 fixed size data types in it
#if left(type([_VFP]),1)==[O]
LPARAMETER taArray, tcCaption, tlKeepOpen
#else
PARAMETER taArray, tcCaption, tlKeepOpen
#endif

* Make sure that parameter passed is an array
*if !_IsArray(@taArray)
if type("taArray[1]")=[U]
   *MessageBox("Please pass array by reference!", 48, PROGRAM() + " - Array Browser")
   wait window "Pase un arreglo por referencia!"+chr(13)+program() + " - Array Browser"
   return .f.
endif
**

#if left(type([_VFP]),1)==[O]
Local lcTalkOld, lcOldArea
LOCAL lnRows, lnCols, lnI, lnJ, lcType, lnSize, ll1d, lnDec, lcRow, llAddSize,;
  lvValue, laStru[1], lcCaption
#else
private lcTalkOld, lcOldArea
private lnRows, lnCols, lnI, lnJ, lcType, lnSize, ll1d, lnDec, lcRow,;
  llAddSize, lvValue, laStru[1], lcCaption
#endif

if upper(set([TALK]))=[ON]
   set talk off
   lcTalkOld=[ON]
else
   lcTalkOld=[OFF]
endif

lcOldArea = SELECT(0)

lcCaption = IIF(TYPE("tcCaption")="C" AND NOT EMPTY(tcCaption),;
                tcCaption, "Browse_Array_Cursor" )

* Makes a cursor out of a one or two-dimensional array and browses it

* Controls if the MAX size of the value in the column is added
*    to the column name
llAddSize = .T.

* Figure out the size of an array
lcCursor = "crs" + RIGHT(SYS(2015), 7)  && BrowseCrs
lnRows =      alen(taArray,1)
lnCols = max( alen(taArray,2), 1 )
ll1d   = (lnCols = 1)        && Is array 1D?
DIMENSION laStru(lnCols+1, 16)
lcRow  = ""
laStru = ""

* Create an array with cursor structure definition
FOR lnI = 1 TO lnCols
   lcCol = alltrim(transform(lnI,[@]))
   lvValue = taArray( 1, lni )
  *laStru[ lnI, 1 ] = VARTYPE(lvValue )
   laStru[ lnI, 1 ] = TYPE([lvValue])
   laStru[ lnI, 2 ] = "C"
   lnSize = 1
   FOR lnJ = 1 TO lnRows
      IF ll1d
         lvValue = taArray( lnJ )
      ELSE
         lvValue = taArray( lnJ, lnI )
      ENDIF
      IF laStru[ lnI, 1 ] <> TYPE( "lvValue" )
         laStru[ lnI, 1 ] = "V"
      ENDIF
      * --sb--  04/24/2002  -- Fixed a problem with an object in array element
      lnSize = max( lnSize, len( B_R_Transform(lvValue)))
   ENDFOR

   laStru[ lnI, 1 ] = laStru[ lnI, 1 ] + "_" + lcCol
   * --sb--  04/25/2002  -- Don't add size if it's fixed for that data type
   IF llAddSize AND NOT inlist(left(laStru[ lnI,1],1),"L","D","I","T","O","G")
      laStru[ lnI, 1 ] = laStru[ lnI, 1 ] + "_" + alltrim(transform(lnSize,[@]))
   ENDIF

   lnSize = MIN( 254, lnSize)

   laStru[ lnI, 3 ] = lnSize
   laStru[ lnI, 4 ] = 0
   laStru[ lnI, 5 ] = .F.
   laStru[ lnI, 6 ] = .F.

   * Create "insert into" values clause
   * --sb--  04/24/2002  -- Fixed problem with an object in array element
   lcRow = lcRow + IIF(EMPTY( lcRow ), "", ", ") + ;
      "B_R_Transform( taArray[lnI" + IIF(ll1d, "", "," +lcCol) + "] )"

ENDFOR

lAlFinal=.f.
if lAlFinal

   lnI = alen(laStru,1)
   lcRow = lcRow + ", 0"

else

   for lnI = alen(laStru,1) TO 2 step -1
      for nK=1 to alen(laStru,2)
         laStru[ lnI, nK ] = laStru[ lnI-1, nK ]
      endfor
   endfor
   lnI = 1
   lcRow =  "0, "+lcRow

endif

laStru[ lnI, 1 ] = "Row_______"
laStru[ lnI, 2 ] = "N"
laStru[ lnI, 3 ] = 7
laStru[ lnI, 4 ] = 0
laStru[ lnI, 5 ] = .F.
laStru[ lnI, 6 ] = .F.

* Make a cursor with fields defined by laStru
*CREATE CURSOR BrowseArrayCursor FROM ARRAY laStru
CREATE CURSOR (lcCursor) FROM ARRAY laStru

* Add rows into cursor

FOR lnI = 1 TO lnRows
   *INSERT INTO BrowseArrayCursor VALUES ( &lcRow )
   lcCreate = "INSERT INTO " + lcCursor + " VALUES ( "+lcRow +")"
   &lcCreate
ENDFOR

**
IF USED(lcCursor)
   REPLACE ALL Row_______ WITH RECNO()
   LOCATE  && GO TOP
   KEYBOARD "{CTRL+F10}" CLEAR
   IF tlKeepOpen
     *BROWSE NOWAIT IN SCREEN LAST NORMAL TITLE (lcCaption)
      BROWSE NOWAIT IN SCREEN NORMAL TITLE (lcCaption) noedit
   ELSE
     *BROWSE NORMAL noedit
      BROWSE NORMAL TITLE (lcCaption) noedit
      USE IN (lcCursor)
   ENDIF
ENDIF
**
SELECT (lcOldArea)
SET TALK &lcTalkOld
RETURN

*-------------------------------------------------------
* Function returns "(Obj)" if the passed value is an object
*    otherwise it works like Transform() w/o 2nd parameter
*FUNCTION B_R_Transform(tvVal)
FUNCTION B_R_Transform
parameter tvVal
*RETURN iif(Vartype(tvVal)="O", "(Obj)", Transform(tvVal))
*#DEFINE  OBJECT_CAPTION  "(Object)"
#DEFINE  OBJECT_CAPTION  "(Obj)"
RETURN iif(type([tvVal])="O", OBJECT_CAPTION, alltrim(transform(tvVal,[@])))

**

Reply all
Reply to author
Forward
0 new messages