Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
How to determine index type?
Message
From
14/02/2003 13:17:10
 
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Miscellaneous
Thread ID:
00753313
Message ID:
00753342
Views:
18
Here is a program I run that allows us to recreate tables from scratch and their indices if necessary. If you run it against your tables it will tell you what indices were created using the unique clause in addition to other information such as table structures, etc.

Example Usage of tblstruc.prg (created by makefile.prg):
*--Create a new empty table in the correct directory with no indices
PUBLIC ARRAY fieldinfo (1,1)
dbfname="AA18.DBF"
DO tblstruc WITH dbfname
CREATE TABLE ("NEWTEMP.DBF") FROM ARRAY fieldinfo
*--Create indices on new table
SELECT NEWTEMP
gnTagCount=0
gnTagCount=tblstruc("IX_"+dbfname)
IF gnTagCount>0
   *Successfully created indices
ELSE
   *Could not create indices, check what to do
ENDIF
*--Copy the temp table to a fox2x table with the correct name
SELECT NEWTEMP
COPY TO (dbfname) TYPE FOX2X WITH CDX	
*makefile.prg
*TRACY C HOLZER
*creates tables structures and their indices and stores
*the information in a program called tblstruc.prg
*to recreate tables and their indices, after running this program to
*to create the program tblstruc.prg, issue the following:
*DO tblstruc WITH dbfname - creates an array with field info or index info
*then process the arrays
*
*change the source directories (m.srcdir->m.srcdir4) to change the 
*directory locations to document a program's structure and indices.
SET SAFETY OFF
SET TALK OFF
SET ECHO OFF
m.srcdir  = '\profiler\data\'
m.srcdir2 = '\profiler\data\symbols\'
m.srcdir3 = '\profiler\data\rates\'
m.srcdir4 = ''
m.outfile = '\profiler\progs\source\tblstruc.prg'
m.choice = ''
csrcdir=''
PRIVATE lcerror, err1
lcerror=ON('ERROR')
err1=.F.
llabeled=.F.
	FOR isrc = 1 TO 4
		DO CASE
			CASE isrc=1
				csrcdir = ALLTRIM(srcdir)
			CASE isrc=2
				csrcdir = ALLTRIM(srcdir2)
			CASE isrc=3
				csrcdir = ALLTRIM(srcdir3)
			CASE isrc=4
				csrcdir = ALLTRIM(srcdir4)
		ENDCASE
		llabeled=.F.
		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: tblstruc.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)
			IF UPPER(LEFT(dbfnames(i,1),3))="FOX"
				LOOP
			ENDIF
			IF UPPER(LEFT(dbfnames(i,1),8))="LCONTROL"
				LOOP
			ENDIF
			*--TCH 01/06/2002
			IF UPPER(LEFT(dbfnames(i,1),6))="SCANLO"
				LOOP
			ENDIF
			IF UPPER(LEFT(dbfnames(i,1),7))="AUDITAR"
				LOOP
			ENDIF
			IF UPPER(LEFT(dbfnames(i,1),8))="AUDITRAL"
				LOOP
			ENDIF
			IF UPPER(LEFT(dbfnames(i,1),7))="COV9999"
				LOOP
			ENDIF
			IF UPPER(LEFT(dbfnames(i,1),6))="POLREQ"
				LOOP
			ENDIF
			=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)
			IF UPPER(LEFT(dbfnames(i,1),3))="FOX"
				LOOP
			ENDIF
			IF UPPER(LEFT(dbfnames(i,1),8))="LCONTROL"
				LOOP
			ENDIF
			*--TCH 01/06/2002
			IF UPPER(LEFT(dbfnames(i,1),6))="SCANLO"
				LOOP
			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,'')
			=fputs(m.handle,REPLI('*',40))
			=fputs(m.handle,'PROCEDURE mf_'+LEFT(dbfnames(i,1),AT('.',dbfnames(i,1))-1))
			=fputs(m.handle,REPLI('*',40))
			COPY STRUC TO TEMPFILE EXTENDED
			USE IN srcefile
			USE TEMPFILE
			=fputs(m.handle,'     DIMENSION fieldinfo('+ALLTRIM(str(reccount()))+',4)')
			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)))
			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,'')
			=fputs(m.handle,REPLI('*',40))
			=fputs(m.handle,'PROCEDURE ix_'+LEFT(dbfnames(i,1),AT('.',dbfnames(i,1))-1))
			=fputs(m.handle,REPLI('*',40))
			=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)
	ENDFOR	&& iscrct = 1 to 4
	=fputs(m.handle,'')
	=fputs(m.handle,'')
	=fputs(m.handle,'*!* EOF: tblstruc.prg')
	=fclose(m.outfile)
	*--TCH 01/06/2002
	IF FILE(m.outfile) .and. !err1
		WAIT WINDOW "Succefully Finished!" NOWAIT
	ELSE
		WAIT WINDOW "ERROR!" NOWAIT
	ENDIF
CLOSE ALL
HTH,
Tracy
.·*´¨)
.·`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