Well, if everybody will post a solution, I will post mine too <g>
It is program that I started long time ago, then abandoned and then some months ago I found again, and although it works, there is still work to do, in particular cleaning up for there are lots of unnecessary things. One thing that I wanted to do but I still didn't do it, is speed up the Regular Expression part of the program, Basically the program populates a cursor and optionally it can populate a treeview (that part has some bugs, can't remember exaclty which were the bugs, I remember it fails given certain conditions.
It still needs work, but I like the idea of having a class like this, I just do not have the time to clean-up/debug, but maybe it gives ideas to others.
Note that there are two ways of getting the information, Basic and not Basic :) In Basic mode, it uses ADIR, in the other mode it uses the FSO and Regular expressions, which gives more information and better filtering capabilities, but at this time the cost is extremely expensive.
Remember is un incomplete/unfinished/bugged program, I just posted for I think I had some good ideas there
Sample Use:
loFileList = NewObject('FileList', 'x:\foxv\hugo\prog\hClassLib.prg', '', 'c:\fox', '{RE}\d{8}\.L\d\d,*.dbf', .t., .t.)
loFileList.Browse()
<pre>
<pre>
define class FileList as session
protected status, FileCount, StatusControl, EOF_Marker, BOF_Marker, RootFolder, Mask, CursorCreated, FileSystemObject, LastError
status = 'Initializing'
FileCount = 0
StatusControl = null
EOF_Marker = '<EOF>'
BOF_Marker = '<BOF>'
RootFolder = ''
Mask = ''
CursorCreated = .F.
FileSystemObject = .null.
RegularExpression = .null.
LastError = ''
function getLastError() as String
return this.LastError
endfunc
procedure Destroy()
with this
.SetStatus(.Name + ' Destroyed')
.StatusControl = null
.FileSystemObject = null
.RegularExpression = null
endwith
endproc
function GetEOF_Marker()
return this.EOF_Marker
endfunc
function GetBOF_Marker()
return this.BOF_Marker
endfunc
function SetEOF_Marker(tcEOF_Marker)
this.EOF_Marker=iif(vartype(tcEOF_Marker)='C' and not empty(tcEOF_Marker), tcEOF_Marker, this.EOF_Marker)
endfunc
function SetBOF_Marker(tcBOF_Marker)
this.BOF_Marker=iif(vartype(tcBOF_Marker)='C' and not empty(tcBOF_Marker), tcBOF_Marker, this.BOF_Marker)
endfunc
protected function ReadMaskedFolder(tcFolder, tcMask, tlIncludeSubDirs, tlIgnoreCase)
local laFiles(1), llRegExp
local lnFiles, lnFile, lcFolder, lnFileCount, lcExt, lnMethod, lcMask, loFolder, loSubFolder, llPassedFilter
lcFolder = addbs(tcFolder)
lcMask = Alltrim(Iif(tlIgnoreCase, Lower(tcMask), tcMask))
lnFileCount = 0
this.SetStatus('Analizing folder: ' + lcFolder + ' for files matching: ' + tcMask)
try
loFolder = this.FileSystemObject.GetFolder(lcFolder)
catch
loFolder = null
endtry
if Isnull(loFolder)
return 0
endif
if tlIncludeSubDirs
for each loSubFolder in loFolder.SubFolders
lnFileCount = lnFileCount + this.ReadFolder(loSubFolder.Path, tcMask, tlIncludeSubDirs, .t., tlIgnoreCase)
endfor
endif
if Left(lcMask, 4) = '{RE}'
llRegExp = .T.
this.RegularExpression.Pattern = Substr(lcMask, 5)
else
llRegExp = .F.
endif
for each loFile in loFolder.Files
llPassedFilter = .F.
if llRegExp
llPassedFilter = this.RegularExpression.Test(loFile.Name)
else
llPassedFilter = Like(lcMask, Iif(tlIgnoreCase, Lower(loFile.Name), loFile.Name))
endif
if llPassedFilter
lnFileCount = lnFileCount + 1
with loFile
insert into c_files ;
( ;
FullName, ;
Size, ;
DateCreated, ;
DateLastAccessed, ;
DateLastModified, ;
ShortName, ;
ShortPath, ;
Type, ;
Attributes ;
) ;
values ;
( ;
.Path, ;
.Size, ;
.DateCreated, ;
.DateLastAccessed, ;
.DateLastModified, ;
.ShortName, ;
.ShortPath, ;
.Type, ;
.Attributes ;
)
endwith
endif
endfor
return lnFileCount
endfunc
protected function SetStatus(tcStatus)
with this
.status = tcStatus
if not Isnull(.StatusControl)
.StatusControl.value = tcStatus
.StatusControl.refresh()
endif
endwith
endfunc
function getXML() as String
local lcXML
Cursortoxml('C_Files', "lcXML", 1, 0, 0, "1")
return lcXML
endfunc
function ClearStatus()
with this
.status = ''
if not Isnull(.StatusControl)
.StatusControl.value = ''
.StatusControl.refresh()
endif
endwith
endfunc
function GetStatus()
return this.status
endfunc
function GetFileCount()
return this.FileCount
endfunc
function next()
if not eof('c_files')
skip in c_files
lcReturn=alltrim(c_files.fullname)
else
lcReturn=this.EOF_Marker
endif
return lcReturn
endfunc
function Previous()
if not bof('c_files')
skip -1 in c_files
lcReturn=alltrim(c_files.fullname)
else
lcReturn=this.BOF_Marker
endif
return lcReturn
endfunc
function first()
go top in c_files
return alltrim(c_files.fullname)
endfunc
function isValid()
return not (eof('c_files') or bof('c_files'))
endfunc
function getMarker()
return iif(this.isValid, '', iif(eof('c_files'), this.EOF_Marker, this.BOF_Marker))
endfunc
function last()
go bottom in c_files
return alltrim(c_files.fullname)
endfunc
function current()
return iif(this.isValid(), alltrim(c_files.fullname), this.getMarker())
endfunc
function getCurrentAsObject() as Object
local loCurrent
loCurrent = null
if this.isValid()
scatter name loCurrent memo
endif
return loCurrent
function recno() as Integer
return recno('c_files')
endfunc
function getOwner() as String
local lcFile, lcFullName, lcPath, loShell, loFolder, loFile, lcOwner
lcOwner = '?'
if this.isValid()
lcFullName = this.current()
lcFile = Justfname(lcFullName)
lcPath = Justpath(lcFullName)
try
loShell = CreateObject ("Shell.Application")
loFolder = loShell.Namespace(lcPath)
loFile = loFolder.ParseName(lcFile)
lcOwner = loFile.ExtendedProperty("Owner")
catch
this.LastError = 'Unable to determine owner'
endtry
else
this.LastError = this.getMarker() + ' encountered'
endif
return lcOwner
function file()
return dbf('c_files')
endfunc
function eof()
return eof('c_files')
endfunc
function bof()
return bof('c_files')
endfunc
function size()
return c_files.size
endfunc
function lastmodified()
return Ctot(dtoc(c_files.date) + ' ' + c_files.Time)
endfunc
function init(tcPath, tcMasks, tlSubdirs, tlBasic, toStatusControl, tcEOF_Marker, tcBOF_Marker)
local lcPath, lcMasks, llValidControl
lcPath = iif(vartype(tcPath) = 'C', addbs(tcPath), '')
lcMasks = iif(vartype(tcMasks) = 'C', alltrim(tcMasks), '*.*')
llValidControl = vartype(toStatusControl) = 'O' and pemstatus(toStatusControl, 'Refresh', 5)
llValidControl = llValidControl and pemstatus(toStatusControl, 'Value', 5)
with this
.FileSystemObject = Createobject('Scripting.FileSystemObject')
.RegularExpression = Createobject('VBScript.RegExp')
.StatusControl = iif(llValidControl, toStatusControl, null)
.SetEOF_Marker(tcEOF_Marker)
.SetBOF_Marker(tcBOF_Marker)
.RootFolder = lcPath
.Mask = lcMasks
if directory(lcPath)
if tlBasic
.FileCount = this.ReadBasicFolder(tcPath, lcMasks, tlSubdirs)
else
.FileCount = this.ReadFolder(tcPath, lcMasks, tlSubdirs)
endif
.SetStatus('Total Files Found: '+alltrim(str(this.FileCount)))
else
.FileCount = 0
.SetStatus('The path: '+lcPath+' was not found or is a System or Hidden one')
endif
endwith
endfunc
procedure InitializeCursor()
create cursor c_files ;
( ;
FullName M, ;
Size n(12,0), ;
DateCreated T, ;
DateLastAccessed T, ;
DateLastModified T, ;
ShortName C(11), ;
ShortPath M, ;
Type M, ;
attributes I ;
)
index on Left(fullname, 240) tag FullName
index on Padr(Justfname(FullName), 240) tag Name
index on DateCreated tag Created
index on DateLastModified tag Modified
index on DateLastAccessed tag Accessed
this.CursorCreated = .T.
endproc
protected function ReadFolder(tcPath as String, tcMasks as String, tlSubdirs as Boolean, tlAdditive as Boolean, tlIgnoreCase as Boolean) as Integer
local lcMasks, laMasks(1), lnMasks, i, lnFileCount
lnFileCount = 0
lcMasks = iif(vartype(tcMasks)#'C' or empty(tcMasks), '*.*', alltrim(tcMasks))
lcMasks = strtran(lcMasks, ';', ',')
lnMasks = alines(laMasks, lcMasks, .t., ',')
if not tlAdditive or not this.CursorCreated
this.InitializeCursor()
endif
for i = 1 to lnMasks
lnFileCount = lnFileCount + this.ReadMaskedFolder(tcPath, laMasks[i], tlSubdirs, tlIgnoreCase)
next i
return lnFileCount
endfunc
function browse()
browse last normal
endfunc
function getListAsArray(taFiles as Array) as Integer
local lcSQL, lnRecords
lnRecords = 0
if Reccount('c_files') = 0
return lnRecords
endif
dimension taFiles(1)
try
select * from c_files into array taFiles
lnRecords = _tally
catch
lnRecords = -1
endtry
return lnRecords
endfunc
protected function ReadBasicMaskedFolder(tcFolder, tcMask, tlIncludeSubDirs)
local laFiles(1)
local lnFiles, lnFile, lcFolder, lnFileCount, lcExt, lnMethod, lcMask, lnAttributes, lcAtt
lcFolder = addbs(tcFolder)
lcMask = alltrim(tcMask)
this.SetStatus('Analizing folder: ' + lcFolder + ' for files matching: ' + tcMask)
lnFileCount = 0
lnFiles = adir(laFiles, lcFolder + lcMask, "HS")
for lnFile = 1 to lnFiles
if 'D'$laFiles[lnFile, 5]
else
lnFileCount = lnFileCount + 1
lcAtt = laFiles[lnFile, 5]
lnAttributes = Iif('A' $ lcAtt, 32, 0) + Iif('H' $ lcAtt, 2, 0) + Iif('R' $ lcAtt, 1, 0) + Iif('S' $ lcAtt, 4, 0)
insert into c_files ;
( ;
FullName, ;
Size, ;
DateCreated, ;
Attributes ;
) ;
values ;
( ;
upper(lcFolder+laFiles[lnFile, 1]), ;
laFiles[lnFile, 2], ;
Ctot(dtoc(laFiles[lnFile, 3]) + ' ' + laFiles[lnFile, 4]), ;
lnAttributes ;
)
endif
next lnFile
if tlIncludeSubDirs
lnFiles = adir(laFiles, lcFolder + '*.*', 'HSD')
for lnFile = 1 to lnFiles
if left(laFiles[lnFile, 1], 1) # '.' and tlIncludeSubDirs
lnFileCount = lnFileCount + this.ReadBasicFolder(lcFolder + laFiles[lnFile, 1], tcMask, tlIncludeSubDirs, .t.)
endif
next lnFile
endif
return lnFileCount
endfunc
protected function ReadBasicFolder(tcPath as String, tcMasks as String, tlSubdirs as Boolean, tlAdditive as Boolean, tlIgnoreCase as Boolean) as Integer
local lcMasks, laMasks(1), lnMasks, i, lnFileCount
ASSERT vartype(M.DebugMode)='U'
lnFileCount = 0
lcMasks = iif(vartype(tcMasks)#'C' or empty(tcMasks), '*.*', alltrim(tcMasks))
lcMasks = strtran(lcMasks, ';', ',')
lnMasks = alines(laMasks, lcMasks, .t., ',')
if not tlAdditive or not this.CursorCreated
this.InitializeCursor()
endif
for i = 1 to lnMasks
lnFileCount = lnFileCount + this.ReadBasicMaskedFolder(tcPath, laMasks[i], tlSubdirs)
next i
return lnFileCount
endfunc
function PopulateTreeView(toTree as Object, tnDepth as Integer, tlIncludeFiles as Boolean) as Integer
local lcNextNode, lnNextNode, lnParent, lnReturn, lcParent, lcRootFolder, loNode, lnBaseLevel, lnDepth
if not (Type("toTree.oleClass") = "C" and Like("MSComctlLib.TreeCtrl.*", toTree.oleClass))
this.LastError = "Invalid parameter given to the PopulateTreeView method, it should be an object which it's oleClass is MSComctlLib.TreeCtrl.*"
return -1
endif
if this.FileCount = 0 or Empty(this.RootFolder)
this.LastError = "There are no files in the list"
return -1
endif
ASSERT vartype(M.DebugMode)='U'
lnReturn = 0
lnDepth = Iif(Vartype(tnDepth) = 'N' and tnDepth >= 0, Int(tnDepth), 0)
lcRootFolder = Addbs(Alltrim(Lower(this.RootFolder)))
lnBaseLevel = Occurs('\', lcRootFolder) - 1
with toTree
.Nodes.Clear()
loNode = .Nodes.Add(,, '0000000000_', lcRootFolder, 0)
loNode.Expanded = .T.
select distinct ;
Padr(Justpath(Strtran(Lower(FullName), lcRootFolder)), 240) as Folder, ;
Padr(Justpath(Justpath(Strtran(Lower(FullName), lcRootFolder))), 240) as Parent, ;
Cast((Occurs('\', FullName) - 1 - lnBaseLevel) as integer) as Depth, ;
Space(11) as Key ;
from C_Files ;
into cursor C_Folders ;
order by 2, 1 ;
having not Empty(Folder) and ((lnDepth = 0) or (Depth <= lnDepth));
readwrite
index on Folder tag Folder
set order to
lnNextNode = 1
scan
if Empty(C_Folders.Parent)
lcParent = '0000000000_'
else
lnRecno = Recno()
if Indexseek(C_Folders.Parent, .t., 'C_Folders', 'Folder')
lcParent = C_Folders.Key
else
lcParent = null
this.LastError = 'Guess what. An error that should never happen has happened!'
endif
go (lnRecno)
endif
if Isnull(lcParent)
lnReturn = -1
this.LastError = 'A node without parent has been found'
loop
endif
lcNextNode = Transform(lnNextNode, '@L 9999999999') + '_'
replace Key with lcNextNode in C_Folders
if Empty(lcParent)
loNode = .Nodes.Add( , , lcNextNode, justfname(C_Folders.Folder))
else
loNode = .Nodes.Add(lcParent, 4, lcNextNode, justfname(C_folders.Folder))
endif
loNode.Expanded = .T.
lnNextNode = lnNextNode + 1
endscan
.Refresh()
endwith
return lnReturn
endfunc
enddefine
"The five senses obstruct or deform the apprehension of reality."
Jorge L. Borges?
"Premature optimization is the root of all evil in programming."
Donald Knuth, repeating C. A. R. Hoare
"To die for a religion is easier than to live it absolutely"
Jorge L. Borges
