Thursday, December 31, 2015

Find Table (dbf) in specified path using Visual Foxpro

Finds tables from a given path (and recurses subdirectories) and returns info about table (filesize, record count, date last modified). Simple demo on ADIR and recursion. Author: Michael J. Babcock, MCP  Freeware 3.0K Last updated: 2009.09.18


FUNCTION FindTable
LPARAMETERS tcTable, tcPath
LOCAL loFind as cusFindTable OF c:\dev\findtable.prg, lcTable as String, lcPath as String
IF VARTYPE(tcTable) = "C" AND NOT EMPTY(tcTable) THEN 
lcTable = tcTable
ELSE
lcTable = "centers"
ENDIF 
IF VARTYPE(tcPath) = "C" AND NOT EMPTY(tcPath) THEN 
lcPath = tcPath
ELSE
lcPath = "c:\symplcty"
ENDIF 

* instantiate tool for processing
loFind = CREATEOBJECT("cusFindTable",lcPath,lcTable)
loFind.FindFiles()

* show matches
SELECT curMatches
LOCATE 
BROWSE TITLE "Matches for " + lcTable NOEDIT FIELDS cPath :H="Path to table", dLastModified :H="Date last modified", iFileSize :H="File size (in bytes)", iRecCount :H="Record Count"
IF RECCOUNT("curProblems")>0 THEN 
SELECT curProblems
LOCATE
BROWSE TITLE "Problems encountered while searching for table " + lcTable NOEDIT 
ENDIF 
CLOSE ALL 
CLEAR ALL


DEFINE CLASS cusFindTable AS Custom 
Name = "cusFindTable"
cTable = "cntrsch.dbf"
cDirectory = CURDIR()
cPath = FULLPATH(CURDIR()) && start path


PROCEDURE Init(tcDirectory as String, tcTable as String)
* create temp cursors 
CREATE CURSOR curMatches (cPath c(80), dLastModified d, iFileSize i, iRecCount i)
CREATE CURSOR curProblems (cPath c(80), cMsg c(80))
SELECT curMatches
INDEX on cPath TAG cPath
INDEX on iRecCount TAG iRecCount DESCENDING 
SET ORDER TO iRecCount

IF VARTYPE(tcDirectory) = "C" AND NOT EMPTY(tcDirectory) THEN 
this.cDirectory = tcDirectory
ENDIF
IF VARTYPE(tcTable) = "C" AND NOT EMPTY(tcTable) THEN 
this.cTable = ALLTRIM(tcTable)
IF RIGHT(this.cTable,4) <> ".dbf" THEN 
this.cTable = this.cTable + ".dbf"
ENDIF 
ENDIF 
this.cPath = FULLPATH(CURDIR())
ENDPROC


FUNCTION FindFiles(tcDirectory as String) as Integer 
* Searches for files and returns match count of cursor.
LOCAL liNumFiles as Integer, laFiles(1), lcDirectory as String, lcDir as String, liLoop as Integer, loException as Exception
IF VARTYPE(tcDirectory) = "C" THEN 
lcDirectory = ADDBS(tcDirectory)
ELSE
lcDirectory = ADDBS(this.cDirectory)
ENDIF 
CHDIR (lcDirectory)
liNumFiles = ADIR(laFiles,this.cTable,"") && get actual matches
FOR liLoop = 1 TO liNumFiles
USE IN (SELECT("MyDBF")) && make sure it's closed
TRY 
USE (lcDirectory + this.cTable) IN 0 NOUPDATE SHARED AGAIN ALIAS MyDBF
INSERT INTO curMatches (cPath, iFileSize, dLastModified, iRecCount) VALUES (lcDirectory,laFiles(liLoop,2),laFiles(liLoop,3),RECCOUNT("MyDBF"))
CATCH TO loException 
INSERT INTO curProblems (cPath,cMsg) VALUES (lcDirectory,loException.Message)
FINALLY 
USE IN (SELECT("MyDBF")) && definitely close it
ENDTRY 
ENDFOR 
liNumFiles = ADIR(laFiles,"","D") && get subdirs
FOR liLoop = 1 TO liNumFiles
IF NOT INLIST(laFiles(liLoop,1),".","..") THEN 
lcDir = lcDirectory+laFiles(liLoop,1)
this.FindFiles(lcDir)
ENDIF 
ENDFOR 
CHDIR (this.cPath)
RETURN RECCOUNT("curMatches")
ENDFUNC && FindFiles(tcDirectory as String) 

ENDDEFINE && _cusFindTable




No comments:

Post a Comment