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