|
SeaFree
|
 |
« Reply #2 on: April 24, 2008, 12:52:32 am » |
|
Re: Reading Directories
Because directories need to be read "recursively", it takes some extra effort. You also have to differentiate between folders and files as you go. The NPL module shown below was designed to read and delete files. It includes my "main" routine ("UN4FUNC") so it may not run without a few $DECLARES.
I hope that you find it useful.
SeaFree
0010 % UN4DIR = 03/15/07 = 09/15/05 = SEARCH FOR FILES & DIRECTORIES
;
INCLUDE T "UN4FUNC"
0020 DIM FileNames$(0)0
DIM fileinfo$318,
FileNames$1000000,
LocalTime$8,
PrevPath$255,
systime$16,
Work$256
DIM Count_NewFiles,
Count_NewFileBytes,
Count_OldFiles,
Count_OldFileBytes,
Count_TotalFiles,
Count_TotalFolders,
Count_TotalFileBytes,
DirEle,
FileNamesChar,
Level,
MaxDirs,
MaxFileNameLeng,
ParmsLen=16
0030 ; PUBLIC FUNCTIONS
FUNCTION 'ExtractDateLastModified$/PUBLIC /FORWARD
PROCEDURE 'PurgeObsoleteTemporaryFiles(MinMB,MinFiles)/PUBLIC /FORWARD
PROCEDURE 'WIN_GetFileCount(SearchPath$144,Parms$144,/POINTER Results$)/PUBLIC /FORWARD
; PRIVATE FUNCTIONS
FUNCTION 'ExtractAttrib$(Attr$1)/FORWARD
PROCEDURE 'DirSearch(Path$256,SearchParms$100)/FORWARD
0040 RECORD /PUBLIC Results
FIELD rNewFiles=HEX(B004)
FIELD rNewFileBytes=HEX(B005)
FIELD rTotalFiles=HEX(B004)
FIELD rTotalFileBytes=HEX(B005)
FIELD rTotalFolders=HEX(B004)
END RECORD
0050 FUNCTION 'ExtractDateLastModified$/PUBLIC
DIM fDate$4,
lTime$8,
sTime$16
;
X='FileTimeToLocalFileTime(STR(fileinfo$,5+(3-1)*8,8),lTime$)
X='FileTimeToSystemTime(lTime$,sTime$)
$PACK(F=_DatePack$) fDate$ FROM sTime$.systime_Year,sTime$.systime_Month,sTime$.systime_Day
RETURN (STR(fDate$,,4))
END FUNCTION
0060 FUNCTION 'ExtractAttrib$(Attr$1)
DIM Attrib$5,
tmp$1
;
tmp$=Attr$ AND BIN(_FILE_ATTRIBUTE_READONLY)
IF VAL(tmp$)>0 THEN STR(Attrib$,,1)="R"
;
tmp$=Attr$ AND BIN(_FILE_ATTRIBUTE_ARCHIVE)
IF VAL(tmp$)>0 THEN STR(Attrib$,2,1)="A"
;
tmp$=Attr$ AND BIN(_FILE_ATTRIBUTE_SYSTEM)
IF VAL(tmp$)>0 THEN STR(Attrib$,3,1)="S"
;
tmp$=Attr$ AND BIN(_FILE_ATTRIBUTE_HIDDEN)
IF VAL(tmp$)>0 THEN STR(Attrib$,4,1)="H"
;
tmp$=Attr$ AND BIN(_FILE_ATTRIBUTE_DIRECTORY)
IF POS(tmp$>00)>0 THEN STR(Attrib$,5,1)="D"
RETURN (Attrib$)
END FUNCTION
0100 PROCEDURE 'DirSearch(Path$256,SearchParms$100)
;
DIM Attrib$5,
fName$256,
PrevPath$256,
Work$256,
DirName$256,
DirEle,
FileSize,
hFindFile,
Leng
Work$=Path$ & SearchParms$
hFindFile='FindFirstFile(Work$,fileinfo$)
;
Level+=1
;
WHILE TRUE
;
; Extract file name
; Note that .cAlternate$ is only valid with long names
fName$=STR(fileinfo$.cFileName$,,POS(fileinfo$.cFileName$=00)-1)
IF STR(fName$,,1)="." THEN GOTO NextFile
;
Attrib$='ExtractAttrib$(fileinfo$.dwFileAttributes$)
;
; if a directory, recurse
IF STR(Attrib$,5,1)="D"
IF 'Instr(Path$,"System Volume Information")>0 THEN BREAK
DirName$=Path$ & fName$ & "\"
FileSize=0
Count_TotalFolders+=1
IF Count_TotalFolders>MaxDirs
MaxDirs+=1000
REDIM FileNames$(MaxDirs)255
END IF
FileNames$(Count_TotalFolders)=DirName$
'DirSearch(DirName$,SearchParms$)
END IF
0110 ; Determine file size if not a directory
IF STR(Attrib$,5,1)="D"
FileSize=0
ELSE
$UNPACK(F=HEX(E004)) fileinfo$.nFileSizeLow$ TO FileSize
Count_TotalFiles+=1
;
; Save FileNameLength/Folder Element/Attributes/FileName
Leng=LEN(fName$)
IF FileNamesChar+Leng+ParmsLen>MaxFileNameLeng
MaxFileNameLeng+=1000000
REDIM FileNames$MaxFileNameLeng
END IF
;
IF PrevPath$<>Path$
MAT SEARCH ELEMENT FileNames$(),=STR(Path$,,LEN(Path$)+1) TO DirEle STEP 255
IF DirEle=0 THEN STOP "Path not found "#
PrevPath$=Path$
END IF
;
STR(FileNames$,FileNamesChar,Leng+ParmsLen)=BIN(Leng) & BIN(DirEle,2) & BIN(FileSize,4) & 'ExtractDateLastModified$ & STR(Attrib$,,5) & fName$
FileNamesChar+=Leng+ParmsLen
;
; Sum file size for files to be archived
IF STR(Attrib$,2,1)="A"
Count_NewFileBytes+=FileSize
Count_NewFiles+=1
END IF
END IF
;
Count_TotalFileBytes+=FileSize
;
=NextFile
;
fileinfo$=" "
IF 'FindNextFile(hFindFile,fileinfo$)=0 THEN BREAK
;
WEND
;
'FindClose(hFindFile)
Level-=1
END PROCEDURE
0200 PROCEDURE 'WIN_GetFileCount(SearchPath$144,Parms$144,/POINTER Results$)/PUBLIC
;
IF STR(SearchPath$,LEN(SearchPath$))<>"\" THEN SearchPath$=SearchPath$ & "\"
;
Count_NewFiles=0
Count_NewFileBytes=0
Count_TotalFiles=0
Count_TotalFolders=1
Count_TotalFileBytes=0
FileNamesChar=1
Level=0
MaxDirs=1000
MaxFileNameLeng=1000000
REDIM FileNames$(MaxDirs)255
REDIM FileNames$MaxFileNameLeng
;
FileNames$(1)=SearchPath$
Results$=ALL(00)
'DirSearch(SearchPath$,Parms$)
;
Results$.rNewFiles=Count_NewFiles
Results$.rNewFileBytes=Count_NewFileBytes
Results$.rTotalFiles=Count_TotalFiles
Results$.rTotalFileBytes=Count_TotalFileBytes
Results$.rTotalFolders=Count_TotalFolders
;
REDIM FileNames$(Count_TotalFolders)255
REDIM FileNames$FileNamesChar-1
END PROCEDURE
1000 PROCEDURE 'PurgeObsoleteTemporaryFiles(MinMB,MinFiles)/PUBLIC
;
DIM LongPathName$256,
Results$22,
TempFolderName$144,
Today$4,
Char,
I,
Leng,
X
TempFolderName$='WIN_GetTempPath$
;
IF 'Instr(TempFolderName$,_Key_Tilde$)>0
'GetLongPathName(TempFolderName$,LongPathName$,255)
ELSE
LongPathName$=TempFolderName$
END IF
;
IF STR(TempFolderName$,LEN(TempFolderName$),1)<>"\" THEN TempFolderName$=TempFolderName$ & "\"
'WIN_GetFileCount(TempFolderName$,"*.*",Results$)
;
; Exit if folder has no files
IF Count_TotalFiles=0
IF MinMB>0 THEN RETURN
'MsgBox("Your temporary folder is currently empty."," ",_vbInformation)
RETURN
END IF
;
Work$="20" & DATE
HEXPACK Today$ FROM STR(Work$,,8)
; Calc totals for files last modified > 7 days ago
Char=1
Count_OldFiles=0
Count_OldFileBytes=0
;
FOR I=1 TO Results$.rTotalFiles
Leng=VAL(STR(FileNames$,Char))
IF 'Date_Diff(STR(FileNames$,Char+7,4),Today$)>7
Count_OldFiles+=1
Count_OldFileBytes+=VAL(STR(FileNames$,Char+3),4)
END IF
Char+=Leng+ParmsLen
NEXT I
;
IF Count_OldFileBytes<MinMB*1024^2 AND Count_OldFiles<MinFiles THEN RETURN
;
msg$="Folder = " & LongPathName$ & "^^"
msg$=msg$ & "The temporary folder on your " & STR(TempFolderName$,,2) & " drive contains " & 'FMTL$("###,###,###",Count_OldFiles) & " obsolete files^"
msg$=msg$ & "in " & 'FMTL$("###,###,###",Count_TotalFolders) & " folders totaling " & 'FMTL$("###,###,###.#",Count_OldFileBytes/1E6) & " MB.^^"
;
IF Count_OldFiles+Count_TotalFolders>50 OR Count_OldFileBytes>1E6
msg$=msg$ & "Do you wish to purge these files?^^"
X='WIN_MsgBox(msg$,"Purge Windows temporary files:",_vbQuestion+_vbYesNo)
ELSE
msg$=msg$ & "No action is required at this time.^^"
'MsgBox(msg$,"No action required.",_vbInformation)
X=_vbNo
END IF
1010 IF X=_vbYes
msg$="Please close all non-APM windows before proceeding."
IF 'WIN_MsgBox(msg$,"Suggestion:",_vbInformation+_vbOKCancel)=_vbOK
Char=1
FOR I=1 TO Count_TotalFiles
Leng=VAL(STR(FileNames$,Char))
IF 'Date_Diff(STR(FileNames$,Char+7,4),Today$)>7
DirEle=VAL(STR(FileNames$,Char+1),2)
Work$=FileNames$(DirEle) & STR(FileNames$,Char+ParmsLen,Leng)
'DeleteFile(Work$)
END IF
Char+=Leng+ParmsLen
NEXT I
1020 ; Delete all folders except the root folder and \REPRINT
FOR I=Count_TotalFolders TO 1 STEP -1 BEGIN
IF 'UCase$('TRIM$(TempFolderName$))<>'UCase$('TRIM$(FileNames$(I))) AND 'Instr('UCase$(FileNames$(I)),"\REPRINT")=0
X='RemoveDirectory(FileNames$(I))
END IF
NEXT I
;
'MsgBox("Obsolete temporary file purge completed."," ",_vbInformation)
END IF
;
END IF
END PROCEDURE
|
