Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Table from Array
Message
 
 
To
05/03/2005 17:27:25
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Environment versions
Visual FoxPro:
VFP 8 SP1
OS:
Windows XP SP2
Network:
Windows 2000 Server
Database:
Visual FoxPro
Miscellaneous
Thread ID:
00993044
Message ID:
00993128
Views:
15
>How do I create a temp table from an array?

I'v used next code:
*===========================================================================
* Procedure......:   DbfFormArray
* Purpose........:   Creates DBF from an (data) array
* Parameters.....:  @ArrayName, with optional @FieldNames, DbfName to create,
*                   Append data from array, close table before exiting
* Return Type....:  Character, Created table path and name
* Author.........:  Arto Toikka
*===========================================================================
PROCEDURE DbfFromArray
LPARAMETERS taArray, taFieldNames, tcDbfName, tlNoAppend, tlCloseTable
*!* This function creates free table from given array
*!* and appends array content to that table
*!* DbfFormArray is used as:
*!* DbfFormArray(@ArrayName [,@taFieldNames] [,tlNoAppend] [,tlCloseTable])
*!* when ArrayName is actual array OR
*!* DbfFormArray(ArrayName [,@taFieldNames] [,tlNoAppend] [,tlCloseTable])
*!* when ArrayName is variable containing name of the array.
*!* f.ex.
*!*
*!* APRINTER(aTest)
*!* DbfFromArray(@aTest)
*!*
*!* OR
*!*
*!* APRINTER(aTest)
*!* cTest = "aTest"
*!* DbfFromArray(cTest)
*!*
*!* Creates a free table with two field
*!* Appends aTest (APRINTER()) info to table
*!* and Returns created table's path and name
*!*
*!* taFieldNames    Field names to use instead of Field1, 2, 3...
*!* tcDbfName       Table path and name to create, otherwise table name is 
*!*                 created with the function sys(2015)
*!* tlNoAppend      .T. Array content is not appended to the created table
*!*                 (Default .F.)  
*!* tlCloseTable    .T. table is closed before returning it's name
*!*                 (Default .F.)
*!* 
*!* Tips:
*!* 1) Sort Array before calling DbfFormArray
*!*    or create indexes after DbfFromArray
*!* 2) If temporary table, remember to erase created table after usage!

EXTERNAL ARRAY taFieldNames
EXTERNAL ARRAY taArray

LOCAL ;
  lnFstParamType, ;
  lnFields, ;
  laStructure[1,16], ;
  lni, ;
  lnj, ;
  lnSelect, ;
  lcExclusive, ;
  lcMyTEMPDir, ;
  lcTmpDbf, ;
  lcRetVal

IF TYPE('taArray[1]') = 'U'
  IF TYPE('&taArray[1]') = 'U'
    IF UPPER(LEFT(taArray,5)) = "THIS." OR ;
      UPPER(LEFT(taArray,9)) = "THISFORM."
      MESSAGEBOX('Reference to This. or Thisform. not allowed with an array',16,'Error',3000)
      RETURN ''
    ELSE
      MESSAGEBOX('Not an Array',16,'Error',3000)
      RETURN ''
    ENDIF
  ELSE
    m.lnFstParamType = 0  && Variable containing arrays name
  ENDIF
ELSE
  m.lnFstParamType = 1  && Array
ENDIF  

m.lnSelect = SELECT()
m.lcExclusive = SET("EXCLUSIVE")

IF m.lnFstParamType = 1  && Array
  m.lnRows = ALEN(m.taArray,1)
  m.lnCols = ALEN(m.taArray,2)
ELSE
  m.lnRows = ALEN(&taArray,1)
  m.lnCols = ALEN(&taArray,2)
ENdif  

IF m.lnCols = 0
  m.lnCols = 1
Endif

*---------------------
*!* Structure of fields
FOR m.lni = 1 TO m.lnCols  && Fields
  DIMENSION laStructure[m.lni,16]
  m.laStructure[m.lni,1]  = ;
    IIF(TYPE('m.taFieldNames[m.lni]') = 'C',;
      LEFT(ALLTRIM(m.taFieldNames[m.lni]),10),'Field'+TRANSFORM(m.lni))
  IF m.lnFstParamType=1
    m.laStructure[m.lni,2] = TYPE('taArray[1,m.lni]')
  ELSE
    m.laStructure[m.lni,2] = TYPE('&taArray[1,m.lni]')
  ENDIF
  *** IIF works if & inside
  ****  m.laStructure[m.lni,2]  = IIF(m.lnFstParamType=1, ;
  ****       TYPE('taArray[m.lni,1]'),TYPE('&taArray[m.lni,1]'))
  m.laStructure[m.lni,3]  = 0
  m.laStructure[m.lni,4]  = 0
  m.laStructure[m.lni,5]  = .F. 
  m.laStructure[m.lni,6]  = .F.
  m.laStructure[m.lni,7]  = ''
  m.laStructure[m.lni,8]  = ''
  m.laStructure[m.lni,9]  = ''
  m.laStructure[m.lni,10] = ''
  m.laStructure[m.lni,11] = ''
  m.laStructure[m.lni,12] = ''
  m.laStructure[m.lni,13] = ''
  m.laStructure[m.lni,14] = ''
  m.laStructure[m.lni,15] = ''
  m.laStructure[m.lni,16] = ''

  *---------------------
  *!* Length of fields
  DO CASE
    CASE m.laStructure[m.lni,2] == 'Y'
      m.laStructure[m.lni,3] = 8
    CASE m.laStructure[m.lni,2] == 'D' OR m.laStructure[m.lni,2] == 'T'
      m.laStructure[m.lni,3] = 8
    CASE m.laStructure[m.lni,2] == 'L'
      m.laStructure[m.lni,3] = 1
    CASE m.laStructure[m.lni,2] == 'C'
      FOR m.lnj = 1 TO m.lnRows
        *** IIF desn't work if & inside AND m.lnFstParamType = 1 because &taArray is checked too and it isn't an array
        ****m.laStructure[m.lni,3] = ;
        ****  MAX(m.laStructure[m.lni,3],LEN(IIF(m.lnFstParamType=1, ;
        ****    m.taArray[m.lnj,m.lni],&taArray[m.lnj,m.lni])))
        IF m.lnFstParamType=1
          m.laStructure[m.lni,3] = MAX(m.laStructure[m.lni,3],LEN(TRANSFORM(m.taArray[m.lnj,m.lni])))
        ELSE
          m.laStructure[m.lni,3] = MAX(m.laStructure[m.lni,3],LEN(TRANSFORM(&taArray[m.lnj,m.lni])))
        ENDIF
      NEXT
      m.laStructure[m.lni,3] = ;
        IIF(m.laStructure[m.lni,3]>254,254,m.laStructure[m.lni,3])
    CASE m.laStructure[m.lni,2] == 'N'
      FOR m.lnj = 1 TO m.lnRows
        *** IIF desn't work if & inside AND m.lnFstParamType = 1 because &taArray is checked too and it isn't an array
        ****m.laStructure[m.lni,3] = ;
        ****  MAX(m.laStructure[m.lni,3],;
        ****    LEN(TRANSFORM(INT(IIF(m.lnFstParamType=1, ;
        ****    m.taArray[m.lnj,m.lni],&taArray[m.lnj,m.lni])))))
        IF m.lnFstParamType=1
          m.laStructure[m.lni,3] = MAX(m.laStructure[m.lni,3],LEN(TRANSFORM(INT(m.taArray[m.lnj,m.lni]))))
        ELSE
          m.laStructure[m.lni,3] = MAX(m.laStructure[m.lni,3],LEN(TRANSFORM(INT(&taArray[m.lnj,m.lni]))))
        ENDIF
        *** IIF desn't work if & inside AND m.lnFstParamType = 1 because &taArray is checked too and it isn't an array
        ****m.laStructure[m.lni,4] = ;
        ****  MAX(m.laStructure[m.lni,4],;
        ****    IIF((AT(SET('POINT'),TRANSFORM(IIF(m.lnFstParamType=1, ;
        ****    m.taArray[m.lnj,m.lni],&taArray[m.lnj,m.lni]))))=0,0,;
        ****      LEN(TRANSFORM((IIF(m.lnFstParamType=1, ;
        ****    m.taArray[m.lnj,m.lni],&taArray[m.lnj,m.lni])-;
        ****    INT(IIF(m.lnFstParamType=1, ;
        ****    m.taArray[m.lnj,m.lni],&taArray[m.lnj,m.lni])))))-2))
        IF m.lnFstParamType=1
          m.laStructure[m.lni,4] = MAX(m.laStructure[m.lni,4],;
            IIF(AT(SET('POINT'),TRANSFORM(m.taArray[m.lnj,m.lni]))=0,0,;
              LEN(TRANSFORM(m.taArray[m.lnj,m.lni])-INT(m.taArray[m.lnj,m.lni]))-2))
        ELSE
          m.laStructure[m.lni,4] = MAX(m.laStructure[m.lni,4],;
            IIF(AT(SET('POINT'),TRANSFORM(&taArray[m.lnj,m.lni]))=0,0,;
              LEN(TRANSFORM(&taArray[m.lnj,m.lni])-INT(&taArray[m.lnj,m.lni]))-2))
        ENDIF
      NEXT
  ENDCASE
  *---------------------
  
NEXT
*---------------------

*--------------------
*!* Create temporary table name if needed
IF TYPE('m.tcDbfName') # 'C' OR ;
  EMPTY(m.tcDbfName)

  m.lcMyTEMPDir = ;
    IIF(Len(Getenv('TEMP'))=0,Sys(5)+Curdir()+;
    IIF(!Right(Curdir(),1)=='\','\',''),;
   Getenv('TEMP')+Iif(!Right(Getenv('TEMP'),1)=='\','\',''))
   
  m.tcDbfName = m.lcMyTEMPDir + Sys(2015)

  Do While File(m.tcDbfName+'.DBF') && Or File(m.lcTmpDbf+".FPT")
    m.tcDbfName = m.lcMyTEMPDir + Sys(2015)
  ENDDO
Endif  
*---------------------

*---------------------
*!* Create Table
SELECT 0
* IF !m.tlCloseTable
SET EXCLUSIVE ON  && Faster to use Exclusive ON
* ENDIF
  
CREATE TABLE (m.tcDbfName) FREE FROM ARRAY m.laStructure

m.lcRetVal = DBF()

*!* If create table doesn'tt success
*!* next takes care that no other
*!* dbf is used because that dbf is later on
*!* erased
IF AT(UPPER(m.tcDbfName),UPPER(m.lcRetVal)) > 0
 
  *---------------------

  *---------------------
  *!* Append Data
  IF !m.tlNoAppend
    IF m.lnFstParamType = 1  && Array
      APPEND FROM ARRAY m.taArray
    ELSE
      APPEND FROM ARRAY &taArray
    Endif
  ENDIF  
  *---------------------

  *---------------------
  *!* Close table
  IF m.tlCloseTable
    USE
    SELECT (m.lnSelect)
  ENDIF 
ELse
  SELECT (m.lnSelect)
  m.lcRetVal = ""
ENdif
* ELSE
SET EXCLUSIVE &lcExclusive
* ENDIF
*---------------------

RETURN m.lcRetVal && m.lcTmpDbf + '.DBF'
*===========================================================================
* End: DbfFromArray
*===========================================================================
Hope this helps you

AT
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform