home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
o
/
opuniq.zip
/
DUPFIND.PAS
next >
Wrap
Pascal/Delphi Source File
|
1991-03-08
|
16KB
|
561 lines
{************************************************************************
Find all files with duplicate names on specified drive(s) and write a list
of them. Run DUPFIND without command line parameters to get help.
Requires the commercial product Object Professional to compile.
DUPFIND provides the following general-purpose objects:
Tree - a binary tree (in OPTREE.PAS)
WildMatcher - a string matcher that understands * and ?
Written 1/13/90, Kim Kokkonen, TurboPower Software
Updated 3/08/91 to allow specification of a dup trigger point (/n)
CompuServe ID [76004,2611]
************************************************************************}
{$R-,S-,I-,V-,B-,F-}
program DupFind;
{-Find duplicate files}
uses
Dos, OpString, OpDos, OpRoot, OpTree;
const
FileAttr = AnyFile; {File attributes being checked}
MinDups : Word = 2; {Minimum number of dups to report file}
type
FileStr = String[12];
DirNodePtr = ^DirNode;
DirNode =
object(SingleListNode)
Time : Longint; {Date/time stamp of file in this directory}
Size : Longint; {Size of file in this directory}
DNameP : StringPtr; {Pointer to name of directory}
constructor Init(FileTime, FileSize : Longint; Dirname : PathStr);
{-Initialize a DirNode}
destructor Done; virtual;
{-Destroy a DirNode}
end;
FileNodePtr = ^FileNode;
FileNode =
object(TreeNode)
NameP : StringPtr; {Pointer to name of file}
DirList : SingleList; {List of DirNodes}
constructor Init(FileName : FileStr);
{-Initialize a FileNode}
destructor Done; virtual;
{-Destroy a FileNode}
end;
FileTreePtr = ^FileTree;
FileTree =
object(Tree)
ftUnique : LongInt; {Number of uniquely named files in tree}
ftTotal : LongInt; {Total number of files in tree}
constructor Init;
{-Initialize FileTree}
procedure FileInsert(FileName : FileStr;
FileTime, FileSize : LongInt;
Dirname : PathStr);
{-Add a file and directory name to the tree list}
procedure DumpDups;
{-Dump files that appear at least twice}
procedure GetCounts(var Unique, Total : LongInt);
{-Return the number of unique names and the total number of names}
{-- override virtual methods required by Tree object --}
function Compare(Key1, Key2 : Pointer) : CompareType; virtual;
{-Compare two keys, returning Less, Equal, Greater}
function GetKey(N : TreeNodePtr) : Pointer; virtual;
{-Return a pointer to the key value for node N}
end;
const
AnyChar = '*'; {Match zero or more characters}
OneChar = '?'; {Match exactly one character}
EndChar = #255; {Terminator to match strings}
type
WildMatcherPtr = ^WildMatcher;
WildMatcher =
object(Root)
maCase : Boolean; {True if case-sensitive matching}
maMask : String[128]; {Mask used for matching}
constructor Init(Mask : String; CaseSensitive : Boolean);
{-Initialize the mask string. May fail if Mask is invalid}
function Matches(Name : String) : Boolean;
{-Return True if Name matches Mask}
function GetMask : String;
{-Return the simplified mask}
procedure SimplifyMask;
{-Used internally to simplify mask when object instantiated}
end;
var
StdErr : Text; {File where messages are written}
FileNames : FileTree; {Stores all the files}
FileMask : WildMatcher; {Used for wildcard matching}
DefaultMask : Boolean; {True if mask is *.* and FileMask isn't used}
procedure WriteCopyright;
begin
WriteLn(StdErr,
'DUPFIND 1.1 - Duplicate file finder. Copyright (c) TurboPower Software, 1990'^M^J);
end;
procedure WriteHelp;
{-Write a help message and halt}
begin
WriteLn('Usage: DUPFIND Drive [Drive ...] [/S FileMask] [/n] [>OutputRedirection]');
WriteLn;
WriteLn('DUPFIND creates an alphabetized list of all duplicate files on the');
WriteLn('specified disk drives. One or more valid drive letters must be given.');
WriteLn('By default, DUPFIND scans all files on the drives. Use the /S option');
WriteLn('to limit the search. FileMask is an exact filename or an extended DOS');
WriteLn('wildcard pattern like *.PAS or OP??????.* or even ARC*X.*. By default,');
WriteLn('DUPFIND reports files that are duplicated two or more times. Specify a');
WriteLn('different trigger point with /n, e.g., /1 reports all files.');
WriteLn;
WriteLn('DUPFIND writes a report to standard output. The report looks like the');
WriteLn('following:');
WriteLn(' README.COM');
WriteLn(' 4217 89/06/28 05:50:00 c:\t55\rtl');
WriteLn(' 4200 88/08/29 05:00:00 c:\t5');
WriteLn('which shows the size, date, time, drive, and directory of the dup files.');
WriteLn('The command line');
WriteLn(' DUPFIND C D E /S READ*.* >JUNK');
WriteLn('searches drives C, D, and E for all files starting with READ.');
Halt;
end;
procedure Abort(Msg : String);
{-Report error message and abort}
begin
WriteLn(StdErr, Msg);
Halt(1);
end;
procedure InsufficientMemory;
{-Report insufficient memory and abort}
begin
Abort('Insufficient memory');
end;
constructor DirNode.Init(FileTime, FileSize : Longint; Dirname : PathStr);
{-Initialize the node}
begin
if not SingleListNode.Init then
Fail;
DNameP := nil;
if not GetMemCheck(DNameP, Length(Dirname)+1) then begin
Done;
Fail;
end;
DNameP^ := Dirname;
Time := FileTime;
Size := FileSize;
end;
destructor DirNode.Done;
{-Destroy the node}
begin
if DNameP <> nil then
FreeMem(DNameP, Length(DNameP^)+1);
SingleListNode.Done;
end;
constructor FileNode.Init(FileName : FileStr);
{-Initialize a FileNode}
begin
if not TreeNode.Init then
Fail;
NameP := nil;
if not(DirList.Init and GetMemCheck(NameP, Length(FileName)+1)) then begin
Done;
Fail;
end;
NameP^ := FileName;
end;
destructor FileNode.Done;
{-Destroy a FileNode}
begin
if NameP <> nil then
FreeMem(NameP, Length(NameP^)+1);
DirList.Done;
end;
constructor FileTree.Init;
{-Initialize FileTree}
begin
ftUnique := 0;
ftTotal := 0;
if not Tree.Init then
Fail;
end;
procedure FileTree.FileInsert(FileName : FileStr;
FileTime, FileSize : LongInt;
Dirname : PathStr);
{-Add a file and directory name to the tree list}
var
DirIndex : Word;
FileNP : FileNodePtr;
DNodeP : DirNodePtr;
begin
{See if filename is already in tree}
FileNP := FileNodePtr(Find(@FileName));
if FileNP = nil then begin
{Insert filename in tree}
New(FileNP, Init(FileName));
if FileNP = nil then
InsufficientMemory;
Insert(FileNP);
Inc(ftUnique);
end;
{Create a directory node to add to the dictionary}
New(DNodeP, Init(FileTime, FileSize, Dirname));
if DNodeP = nil then
InsufficientMemory;
{Add directory node to list}
FileNP^.DirList.Append(DNodeP);
inc(ftTotal);
end;
function FileTree.Compare(Key1, Key2 : Pointer) : CompareType;
{-Compare two keys, returning Less, Equal, Greater}
begin
Compare := CompString(StringPtr(Key1)^, StringPtr(Key2)^);
end;
function FileTree.GetKey(N : TreeNodePtr) : Pointer;
{-Return a pointer to the key value for node N}
begin
GetKey := FileNodePtr(N)^.NameP;
end;
function DateTimeStr(DT : LongInt) : String;
{-Return a formatted date-time string}
type
String2 = String[2];
var
T : DateTime;
function W2S2(W : Word) : String2;
var
S : String2;
begin
Str((W mod 100):2, S);
if S[1] = ' ' then
S[1] := '0';
W2S2 := S;
end;
begin
UnpackTime(DT, T);
with T do
DateTimeStr := W2S2(Year)+'/'+W2S2(Month)+'/'+W2S2(Day)+' '+
W2S2(Hour)+':'+W2S2(Min)+':'+W2S2(Sec);
end;
{$F+}
procedure DumpNode(N : TreeNodePtr; T : TreePtr);
{-Dump one tree node}
var
DNodeP : DirNodePtr;
begin
if FileNodePtr(N)^.DirList.Size >= MinDups then begin
{At least two instances of file, write the filename}
WriteLn(FileNodePtr(N)^.NameP^);
{Scan the list of directories}
DNodeP := DirNodePtr(FileNodePtr(N)^.DirList.Head);
while DNodeP <> nil do begin
WriteLn(' ', DNodeP^.Size:8, ' ', DateTimeStr(DNodeP^.Time), ' ',
StLocase(DNodeP^.DNameP^));
DNodeP := DirNodePtr(FileNodePtr(N)^.DirList.Next(DNodeP));
end;
end;
end;
{$F-}
procedure FileTree.DumpDups;
{-Dump files that appear at least Min times}
begin
VisitNodesUp(DumpNode);
end;
procedure FileTree.GetCounts(var Unique, Total : LongInt);
{-Return the number of unique names and the total number of names}
begin
Unique := ftUnique;
Total := ftTotal;
end;
constructor WildMatcher.Init(Mask : String; CaseSensitive : Boolean);
{-Initialize the mask string. May fail}
begin
if not Root.Init then
Fail;
if Length(Mask) > 127 then
Fail;
if Pos(EndChar, Mask) <> 0 then
Fail;
maCase := CaseSensitive;
maMask := Mask;
SimplifyMask;
maMask[Length(maMask)+1] := EndChar;
end;
function WildMatcher.Matches(Name : String) : Boolean;
{-Return True if Name matches Mask}
var
NLen : Byte absolute Name;
MPos : Word;
NPos : Word;
MPSave : Word;
NPSave : Word;
AnyOn : Boolean;
Ch : Char;
begin
Matches := False;
{Add terminator to input string}
Name[NLen+1] := EndChar;
AnyOn := False;
MPos := 1;
NPos := 1;
while (maMask[MPos] <> EndChar) or (Name[NPos] <> EndChar) do begin
{Look for '*'}
if maMask[MPos] = AnyChar then begin
if MPos >= Length(maMask) then begin
{Last character in maMask is '*', rest must match}
Matches := True;
Exit;
end;
AnyOn := True;
NPSave := NPos;
inc(MPos);
MPSave := MPos;
end;
{Get next character from Name string}
if maCase then
Ch := Name[NPos]
else
Ch := UpCase(Name[NPos]);
{Look for literal match}
if (Ch <> EndChar) and ((maMask[MPos] = OneChar) or (maMask[MPos] = Ch))
then begin
{Matching character}
inc(MPos);
inc(NPos);
end else begin
{Mismatched character}
if not AnyOn or (NPSave >= Length(Name)) then
{Fatal mismatch, no '*' in effect or no way to advance past mismatch}
Exit;
{Increment restart point}
inc(NPSave);
{Try again at next Name position}
NPos := NPSave;
{Restart maMask just after the '*'}
MPos := MPSave;
end;
end;
Matches := True;
end;
function WildMatcher.GetMask : String;
{-Return the simplified mask}
begin
GetMask := maMask;
end;
procedure WildMatcher.SimplifyMask;
{-Used internally to simplify mask when object instantiated}
var
MLen : Byte;
MPos : Word;
OMask : String;
OLen : Byte absolute OMask;
begin
MLen := Length(maMask);
MPos := 1;
OLen := 0;
while MPos <= MLen do begin
if (MPos = 1) or (maMask[MPos] <> '*') or (maMask[MPos-1] <> '*') then begin
{Transfer maMask to OMask, skipping repeated asterisks}
inc(OLen);
OMask[OLen] := maMask[MPos];
if not maCase then
OMask[OLen] := UpCase(OMask[OLen]);
end;
inc(MPos);
end;
maMask := OMask;
end;
procedure ScanDir(Dir : PathStr);
{-Scan one directory}
var
FRec : SearchRec;
procedure WriteStatus;
begin
Write(StdErr, Dir);
end;
procedure ClearStatus;
begin
Write(StdErr, ^M, CharStr(' ', Length(Dir)), ^M);
end;
begin
WriteStatus;
FindFirst(AddBackSlash(Dir)+'*.*', FileAttr, FRec);
while DosError = 0 do begin
if (FRec.Attr and VolumeID) <> 0 then
{do nothing for volume labels}
else if (FRec.Attr and Directory <> 0) then begin
{a directory, look deeper}
if (FRec.Name <> '.') and (FRec.Name <> '..') then begin
ClearStatus;
ScanDir(AddBackSlash(Dir)+FRec.Name);
WriteStatus;
end;
end else if DefaultMask or FileMask.Matches(FRec.Name) then
{a matching file, add it to FileTree}
FileNames.FileInsert(FRec.Name, FRec.Time, FRec.Size, Dir);
FindNext(FRec);
end;
ClearStatus;
end;
procedure ScanDrive(DriveLet : Char);
{-Scan one drive for duplicate files. DriveLet assumed to be valid}
begin
ScanDir(DriveLet+':\');
end;
function IsOption(var Param : Word) : Boolean;
{-Return True if ParamStr(Param) is an option, and evaluate it if so}
var
Arg : String[127];
begin
IsOption := False;
Arg := ParamStr(Param);
case Arg[1] of
'/', '-' :
if Length(Arg) <> 2 then
Abort('Invalid option: '+Arg)
else
case UpCase(Arg[2]) of
'S' :
if Param = ParamCount then
Abort('Missing parameter after: '+Arg)
else begin
inc(Param);
Arg := ParamStr(Param);
{Validate mask}
if (Length(Arg) > 12) or
(JustFileName(Arg) <> Arg) or
(Pos('.', Arg) > 9) then
Abort('Invalid file mask: '+Arg);
FileMask.Init(StUpcase(Arg), True);
DefaultMask := (FileMask.GetMask = '*.*');
IsOption := True;
end;
'0'..'9' :
begin
MinDups := Byte(Arg[2])-Byte('0');
IsOption := True;
end;
else
Abort('Invalid option: '+Arg);
end;
end;
end;
function IsValidDrive(DriveName : String) : Boolean;
{-Return true if DriveName specifies a valid drive}
begin
IsValidDrive := False;
case Length(DriveName) of
1 : {OK so far};
2 : {Assure second character is a colon}
if DriveName[2] <> ':' then
Exit;
else
Exit;
end;
IsValidDrive := ValidDrive(Upcase(DriveName[1]));
end;
procedure ValidateDrives;
{-Assure the requested drives are valid}
var
Param : Word;
begin
Param := 1;
while Param <= ParamCount do begin
if not IsOption(Param) then
if not IsValidDrive(ParamStr(Param)) then
Abort('Invalid drive: '+ParamStr(Param));
inc(Param);
end;
end;
procedure ScanDrives;
{-Scan the requested drives for duplicate files}
var
Param : Word;
DriveLet : String[1];
begin
Param := 1;
while Param <= ParamCount do begin
if not IsOption(Param) then begin
DriveLet := Copy(ParamStr(Param), 1, 1); {Minimize stack usage}
ScanDrive(UpCase(DriveLet[1]));
end;
inc(Param);
end;
end;
begin
{StdErr will be used for messages and status}
if not OpenStdDev(StdErr, StdErrHandle) then
Halt;
{Write copyright and help message}
WriteCopyRight;
if ParamCount = 0 then
WriteHelp;
{The FileNames tree object will store the filenames and their locations}
FileNames.Init;
{Scan all files by default}
DefaultMask := True;
{Validate the requested drives before scanning anything}
ValidateDrives;
{Scan the requested drives}
ScanDrives;
{Dump the output}
FileNames.DumpDups;
Close(StdErr);
end.