Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Index does match the table
Message
From
23/09/2005 14:23:03
 
 
To
23/09/2005 13:50:38
General information
Forum:
Visual FoxPro
Category:
Databases,Tables, Views, Indexing and SQL syntax
Environment versions
Visual FoxPro:
VFP 6 SP5
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01052434
Message ID:
01052508
Views:
6
You can pull it out from the code below. Actually, you can run the code below on any directory and will create a file called tblstruct.prg that will contain the information. That should get you started. It shows how to get the tag information. BEFORE YOU RUN IT, Look at the mlongarray variable and adjust it to match your vfp6 tables. Also change the empty() field checking for fields that actually exist for vfp6 tables. Comment out any references to any elements above the highest element in a vfp6 table. It is setup to work with vfp9 tables and those higher properties don't exist for vfp6 tables. Don't actually run the generated tblstruct.prg though unless you are working with free tables only. It is a routine we use for free tables and now we don't use it much since we have SDT. It will not add the dbc information for you. Also, since it could possibly create a .prg with too many lines to be able to actually run, I put a limit of 75 tables in the example below so in case you actually ran it, you wouldn't have a prg too large. It needs to check the number of lines instead if actually used. I am only posting it in case the code sample can help you get started.

Also, check the tagcount() loop. I probably didn't check for every possible keyword statement that could occur in an index expression since I pretty much new what was used in our tags and probably left some out. Look at afields(), copy struc to < filename > extended, tagcount(), tag(), and cdx() in vfp6 help. I can't remember which exist in vfp6 and if any do not.
LPARAMETERS tcsrcdir
set safety OFF
set talk OFF
IF TYPE('tcsrcdir') = "L" .or. EMPTY(tcsrcdir)
   tcsrcdir = GETDIR()
ENDIF
IF EMPTY(tcsrcdir)
   RETURN .F.
ENDIF
csrcdir = tcsrcdir
m.srcdir = csrcdir  && just for this example - this program processes 4 directories
m.srcdir2 = csrcdir && just for this example - this program processes 4 directories
m.srcdir3 = csrcdir && just for this example - this program processes 4 directories
m.srcdir4 = csrcdir && just for this example - this program processes 4 directories
=MESSAGEBOX('Click OK to begin')


lncounter = 0   && increment of tables processed
lnlimit = 75    && maximum number of tables to process

WAIT WINDOW "Processing..." NOWAIT
PRIVATE lcerror, err1, outfile
m.outfile = "tblstruct.prg"
lcerror=ON('ERROR')
err1=.F.
llabeled=.F.
FOR isrc = 1 TO 1
   IF LEN(ALLTRIM(csrcdir))=0
      LOOP
   ENDIF
   IF RIGHT(csrcdir,1)!="\"
      csrcdir=csrcdir+"\"
   ENDIF
   DIMENSION dbfnames(1,1)
   dbfnames(1,1) = 'None'
   =ADIR(dbfnames,csrcdir+'*.DBF')
   IF dbfnames(1,1) = 'None'
      WAIT WINDOW 'No files found in '+csrcdir+'!'
      LOOP
   ENDIF
   IF UPPER(TYPE('m.handle'))="U"
      m.handle = FCREATE(m.outfile)
   ENDIF
   IF m.handle < 1
      WAIT WINDOW 'Cannot open output file!'
      RETURN
   ENDIF
   IF !llabeled
      =FPUTS(m.handle,'****************************************************************************')
      =FPUTS(m.handle,'* Program Name: tblstruct.prg')
      =FPUTS(m.handle,'* Creation Date: '+DTOC(DATE())+' '+TIME())
      =FPUTS(m.handle,'* ')
      =FPUTS(m.handle,'* USAGE:')
      =FPUTS(m.handle,'*    1) to populate table array fieldinfo: DO tblstruc WITH <expc>')
      =FPUTS(m.handle,'*       NOTE: the array fieldinfo must exist and global in scope')
      =FPUTS(m.handle,'*    2) to index a table already in use:  gnTagCount=tblstruc([expc])')
      =FPUTS(m.handle,'* PARAMETERS:')
      =FPUTS(m.handle,'*    [expc1] = tablename e.g. insured.dbf ')
      =FPUTS(m.handle,'* RETURNS:')
      =FPUTS(m.handle,'*    if table name only passed: array fieldinfo is populated')
      =FPUTS(m.handle,"*    if 'ix_'+[expc] is passed: tagcount() is returned to calling program")
      =FPUTS(m.handle,'* DIRECTORIES:')
      =FPUTS(m.handle,'*    '+m.srcdir)
      =FPUTS(m.handle,'*    '+m.srcdir2)
      =FPUTS(m.handle,'*    '+m.srcdir3)
      =FPUTS(m.handle,'*    '+m.srcdir4)
      =FPUTS(m.handle,'****************************************************************************')
      =FPUTS(m.handle,'PARAMETERS dbfname')
      =FPUTS(m.handle,'DO CASE')
      llabeled=.T.
   ENDIF
   FOR i = 1 TO ALEN(dbfnames,1)
      WAIT WINDOW "Processing "+dbfnames(i,1)+"..." NOWAIT
      =FWRITE(m.handle,'CASE UPPER(dbfname) = '+"'"+ALLTRIM(dbfnames(i,1))+"'"+CHR(13))
      =FPUTS(m.handle,'   DO mf_'+LEFT(dbfnames(i,1),AT('.',dbfnames(i,1))-1))
      =FPUTS(m.handle,'CASE UPPER(dbfname) = '+"'"+'IX_'+ALLTRIM(dbfnames(i,1))+"'")
      =FPUTS(m.handle,'   PRIVATE gnTagCount')
      =FPUTS(m.handle,'   gnTagCount='+'ix_'+LEFT(dbfnames(i,1),AT('.',dbfnames(i,1))-1)+'()')
      =FPUTS(m.handle,'   RETURN gnTagCount')
   ENDFOR
ENDFOR && isrc=1 to 4

IF dbfnames(1,1) = 'None' .AND. !llabeled
   WAIT WINDOW 'No files found!'
   RETURN
ENDIF

=FPUTS(m.handle,'ENDCASE')

FOR isrct = 1 TO 4
   DO CASE
      CASE isrct=1
         csrcdir = ALLTRIM(srcdir)
      CASE isrct=2
         csrcdir = ALLTRIM(srcdir2)
      CASE isrct=3
         csrcdir = ALLTRIM(srcdir3)
      CASE isrct=4
         csrcdir = ALLTRIM(srcdir4)
   ENDCASE
   IF LEN(ALLTRIM(csrcdir))=0
      LOOP
   ENDIF
   IF RIGHT(csrcdir,1)!="\"
      csrcdir=csrcdir+"\"
   ENDIF
   DIMENSION dbfnames(1,1)
   dbfnames(1,1) = 'None'
   =ADIR(dbfnames,csrcdir+'*.DBF')
   IF dbfnames(1,1) = 'None'
      LOOP
   ENDIF
   FOR i = 1 TO ALEN(dbfnames,1)
      lncounter = lncounter + 1
      IF lncounter > lnlimit
         =MESSAGEBOX(ALLTRIM(STR(lnlimit))+' table limit reached.')
         EXIT
      ENDIF
      lcerror=ON('ERROR')
      ON ERROR WAIT WINDOW "ERROR!" NOWAIT
      USE (csrcdir+dbfnames(i,1)) ALIAS srcefile
      ON ERROR &lcerror
      IF LOWER(ALLTRIM(ALIAS()))<>"srcefile"
         STORE .T. TO err1
         WAIT WINDOW "Could not open "+csrcdir+dbfnames(i,1)
         LOOP
      ENDIF
      =FPUTS(m.handle,'PROCEDURE mf_'+LEFT(dbfnames(i,1),AT('.',dbfnames(i,1))-1))
      COPY STRUC TO TEMPFILE EXTENDED
      USE IN srcefile
      USE TEMPFILE
      GO TOP
      PRIVATE mlongarray
      STORE .F. to mlongarray
      IF !EMPTY(field_defa) .or. !EMPTY(field_rule) .or. !EMPTY(field_err) ;
         .or. !EMPTY(table_rule) .or. !EMPTY(table_err) .or. !EMPTY(table_name) ;
         .or. !EMPTY(ins_trig) .or. !EMPTY(upd_trig) .or. !EMPTY(del_trig) ;
         .or. !EMPTY(table_cmt) .or. !EMPTY(field_Next)
         =FPUTS(m.handle,'     DIMENSION fieldinfo('+ALLTRIM(STR(RECCOUNT()))+',18)')
         STORE .T. TO mlongarray
      ELSE
         =FPUTS(m.handle,'     DIMENSION fieldinfo('+ALLTRIM(STR(RECCOUNT()))+',6)')
         STORE .F. TO mlongarray
      ENDIF
      SCAN
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',1)  = '+"'"+RTRIM(FIELD_NAME)+"'")
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',2)  = '+"'"+FIELD_TYPE+"'")
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',3)  = '+ALLTRIM(STR(field_len)))
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',4)  = '+ALLTRIM(STR(field_dec)))
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',5)  = '+IIF(field_null,'.T.','.F.'))
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',6)  = '+IIF(field_nocp,'.T.','.F.'))
         IF mlongarray
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',7)  = '+IIF(!EMPTY(field_defa), ['] + ALLTRIM(field_defa)+['],['']))
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',8)  = '+IIF(!EMPTY(field_rule), ['] + ALLTRIM(field_rule)+['],['']))
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',9)  = '+IIF(!EMPTY(field_err),  ['] + ALLTRIM(field_err)+['],['']))
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',10) = '+IIF(!EMPTY(table_rule), ['] + ALLTRIM(table_rule)+['],['']))
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',11) = '+IIF(!EMPTY(table_err),  ['] + ALLTRIM(table_err)+['],['']))
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',12) = '+IIF(!EMPTY(table_name), ['] + ALLTRIM(table_name)+['],['']))
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',13) = '+IIF(!EMPTY(ins_trig), ['] + ALLTRIM(ins_trig)+['],['']))
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',14) = '+IIF(!EMPTY(upd_trig), ['] + ALLTRIM(upd_trig)+['],['']))
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',15) = '+IIF(!EMPTY(del_trig), ['] + ALLTRIM(del_trig)+['],['']))
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',16) = '+IIF(!EMPTY(table_cmt), ['] + ALLTRIM(table_cmt)+['],['']))
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',17) = '+ALLTRIM(STR(field_next)))
            =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',18) = '+ALLTRIM(STR(field_step)))
         ENDIF
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',13) = '+ins_trig)
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',14) = '+upd_trig)
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',15) = '+del_trig)
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',16) = '+table_cmt)
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',17) = '+ALLTRIM(STR(field_next)))
         =FPUTS(m.handle,'     fieldinfo('+ALLTRIM(STR(RECNO()))+',18) = '+ALLTRIM(STR(field_step)))
      ENDSCAN
      =FPUTS(m.handle,'RETURN')
      USE IN TEMPFILE
      lcerror=ON('ERROR')
      ON ERROR WAIT WINDOW "ERROR!" NOWAIT
      USE (csrcdir+dbfnames(i,1)) ALIAS srcefile
      ON ERROR &lcerror
      IF LOWER(ALLTRIM(ALIAS()))<>"srcefile"
         STORE .T. TO err1
         WAIT WINDOW "Could not open "+csrcdir+dbfnames(i,1)
         LOOP
      ENDIF
      =FPUTS(m.handle,'PROCEDURE ix_'+LEFT(dbfnames(i,1),AT('.',dbfnames(i,1))-1))
      =FPUTS(m.handle,'    PRIVATE gnTagCount')
      =FPUTS(m.handle,'    gnTagCount='+ALLTRIM(STR(TAGCOUNT())))
      FOR lnTag = 1 TO TAGCOUNT()
         =FPUTS(m.handle,'    INDEX ON ';
            + LOWER(SYS(14, lnTag)) +IIF(!EMPTY(FOR(lnTag)),' FOR '+FOR(lnTag),'');
            +IIF(UNIQUE(lnTag),' UNIQUE','') ;
            +' TAG ' + LOWER(TAG(lnTag)))
      ENDFOR
      USE IN srcefile
      =FPUTS(m.handle,'RETURN gnTagCount')
   ENDFOR   && i = 1 To ALEN(dbfnames,1)
   IF lncounter > lnlimit
      EXIT
   ENDIF
ENDFOR   && iscrct = 1 to 4
=FPUTS(m.handle,'')
=FPUTS(m.handle,'')
=FPUTS(m.handle,'*!* EOF: tblstruct.prg')
=FCLOSE(m.outfile)
IF FILE(m.outfile) .AND. !err1
   IF lncounter <= lnlimit
      =MESSAGEBOX("Successfully Finished!")
   ELSE
      =MESSAGEBOX('Verify tblstruct.prg')
   ENDIF
ELSE
   =MESSAGEBOX("ERRORS OCURRED!")
ENDIF
CLOSE ALL
.·*´¨)
.·`TCH
(..·*

010000110101001101101000011000010111001001110000010011110111001001000010011101010111001101110100
"When the debate is lost, slander becomes the tool of the loser." - Socrates
Vita contingit, Vive cum eo. (Life Happens, Live With it.)
"Life is not measured by the number of breaths we take, but by the moments that take our breath away." -- author unknown
"De omnibus dubitandum"
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform