|
@@ -50,11 +50,14 @@ interface
|
|
TCachedDirectory = class(TFPHashObject)
|
|
TCachedDirectory = class(TFPHashObject)
|
|
private
|
|
private
|
|
FDirectoryEntries : TFPHashList;
|
|
FDirectoryEntries : TFPHashList;
|
|
|
|
+ procedure FreeDirectoryEntries;
|
|
|
|
+ function GetItemAttr(const AName: TCmdStr): byte;
|
|
public
|
|
public
|
|
constructor Create(AList:TFPHashObjectList;const AName:TCmdStr);
|
|
constructor Create(AList:TFPHashObjectList;const AName:TCmdStr);
|
|
destructor destroy;override;
|
|
destructor destroy;override;
|
|
procedure Reload;
|
|
procedure Reload;
|
|
function FileExists(const AName:TCmdStr):boolean;
|
|
function FileExists(const AName:TCmdStr):boolean;
|
|
|
|
+ function FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
|
|
function DirectoryExists(const AName:TCmdStr):boolean;
|
|
function DirectoryExists(const AName:TCmdStr):boolean;
|
|
property DirectoryEntries:TFPHashList read FDirectoryEntries;
|
|
property DirectoryEntries:TFPHashList read FDirectoryEntries;
|
|
end;
|
|
end;
|
|
@@ -67,6 +70,12 @@ interface
|
|
EntryIndex : longint;
|
|
EntryIndex : longint;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+ PCachedDirectoryEntry = ^TCachedDirectoryEntry;
|
|
|
|
+ TCachedDirectoryEntry = record
|
|
|
|
+ RealName: TCmdStr;
|
|
|
|
+ Attr : byte;
|
|
|
|
+ end;
|
|
|
|
+
|
|
TDirectoryCache = class
|
|
TDirectoryCache = class
|
|
private
|
|
private
|
|
FDirectories : TFPHashObjectList;
|
|
FDirectories : TFPHashObjectList;
|
|
@@ -75,6 +84,7 @@ interface
|
|
constructor Create;
|
|
constructor Create;
|
|
destructor destroy;override;
|
|
destructor destroy;override;
|
|
function FileExists(const AName:TCmdStr):boolean;
|
|
function FileExists(const AName:TCmdStr):boolean;
|
|
|
|
+ function FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
|
|
function DirectoryExists(const AName:TCmdStr):boolean;
|
|
function DirectoryExists(const AName:TCmdStr):boolean;
|
|
function FindFirst(const APattern:TCmdStr;var Res:TCachedSearchRec):boolean;
|
|
function FindFirst(const APattern:TCmdStr;var Res:TCachedSearchRec):boolean;
|
|
function FindNext(var Res:TCachedSearchRec):boolean;
|
|
function FindNext(var Res:TCachedSearchRec):boolean;
|
|
@@ -136,15 +146,49 @@ implementation
|
|
|
|
|
|
destructor TCachedDirectory.destroy;
|
|
destructor TCachedDirectory.destroy;
|
|
begin
|
|
begin
|
|
|
|
+ FreeDirectoryEntries;
|
|
FDirectoryEntries.Free;
|
|
FDirectoryEntries.Free;
|
|
inherited destroy;
|
|
inherited destroy;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
+ procedure TCachedDirectory.FreeDirectoryEntries;
|
|
|
|
+ var
|
|
|
|
+ i: Integer;
|
|
|
|
+ begin
|
|
|
|
+ if not(tf_files_case_aware in source_info.flags) then
|
|
|
|
+ exit;
|
|
|
|
+ for i := 0 to DirectoryEntries.Count-1 do
|
|
|
|
+ dispose(PCachedDirectoryEntry(DirectoryEntries[i]));
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
|
|
+ function TCachedDirectory.GetItemAttr(const AName: TCmdStr): byte;
|
|
|
|
+ var
|
|
|
|
+ entry: PCachedDirectoryEntry;
|
|
|
|
+ begin
|
|
|
|
+ if not(tf_files_case_sensitive in source_info.flags) then
|
|
|
|
+ if (tf_files_case_aware in source_info.flags) then
|
|
|
|
+ begin
|
|
|
|
+ entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(AName)));
|
|
|
|
+ if assigned(entry) then
|
|
|
|
+ Result:=entry^.Attr
|
|
|
|
+ else
|
|
|
|
+ Result:=0;
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ Result:=PtrInt(DirectoryEntries.Find(Lower(AName)))
|
|
|
|
+ else
|
|
|
|
+ Result:=PtrInt(DirectoryEntries.Find(AName));
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
procedure TCachedDirectory.Reload;
|
|
procedure TCachedDirectory.Reload;
|
|
var
|
|
var
|
|
- dir : TSearchRec;
|
|
|
|
|
|
+ dir : TSearchRec;
|
|
|
|
+ entry : PCachedDirectoryEntry;
|
|
begin
|
|
begin
|
|
|
|
+ FreeDirectoryEntries;
|
|
DirectoryEntries.Clear;
|
|
DirectoryEntries.Clear;
|
|
if findfirst(IncludeTrailingPathDelimiter(Name)+'*',faAnyFile or faDirectory,dir) = 0 then
|
|
if findfirst(IncludeTrailingPathDelimiter(Name)+'*',faAnyFile or faDirectory,dir) = 0 then
|
|
begin
|
|
begin
|
|
@@ -154,7 +198,15 @@ implementation
|
|
(dir.Name<>'..') then
|
|
(dir.Name<>'..') then
|
|
begin
|
|
begin
|
|
if not(tf_files_case_sensitive in source_info.flags) then
|
|
if not(tf_files_case_sensitive in source_info.flags) then
|
|
- DirectoryEntries.Add(Lower(Dir.Name),Pointer(Ptrint(Dir.Attr)))
|
|
|
|
|
|
+ if (tf_files_case_aware in source_info.flags) then
|
|
|
|
+ begin
|
|
|
|
+ new(entry);
|
|
|
|
+ entry^.RealName:=Dir.Name;
|
|
|
|
+ entry^.Attr:=Dir.Attr;
|
|
|
|
+ DirectoryEntries.Add(Lower(Dir.Name),entry)
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ DirectoryEntries.Add(Lower(Dir.Name),Pointer(Ptrint(Dir.Attr)))
|
|
else
|
|
else
|
|
DirectoryEntries.Add(Dir.Name,Pointer(Ptrint(Dir.Attr)));
|
|
DirectoryEntries.Add(Dir.Name,Pointer(Ptrint(Dir.Attr)));
|
|
end;
|
|
end;
|
|
@@ -168,10 +220,7 @@ implementation
|
|
var
|
|
var
|
|
Attr : Longint;
|
|
Attr : Longint;
|
|
begin
|
|
begin
|
|
- if not(tf_files_case_sensitive in source_info.flags) then
|
|
|
|
- Attr:=PtrInt(DirectoryEntries.Find(Lower(AName)))
|
|
|
|
- else
|
|
|
|
- Attr:=PtrInt(DirectoryEntries.Find(AName));
|
|
|
|
|
|
+ Attr:=GetItemAttr(AName);
|
|
if Attr<>0 then
|
|
if Attr<>0 then
|
|
Result:=((Attr and faDirectory)=0)
|
|
Result:=((Attr and faDirectory)=0)
|
|
else
|
|
else
|
|
@@ -179,14 +228,37 @@ implementation
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
+ function TCachedDirectory.FileExistsCaseAware(const AName:TCmdStr; out FoundName: TCmdStr):boolean;
|
|
|
|
+ var
|
|
|
|
+ entry : PCachedDirectoryEntry;
|
|
|
|
+ Attr : Longint;
|
|
|
|
+ begin
|
|
|
|
+ if (tf_files_case_aware in source_info.flags) then
|
|
|
|
+ begin
|
|
|
|
+ entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(AName)));
|
|
|
|
+ if assigned(entry) then
|
|
|
|
+ begin
|
|
|
|
+ Attr:=entry^.Attr;
|
|
|
|
+ FoundName:=entry^.RealName
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ Attr:=0;
|
|
|
|
+ if Attr<>0 then
|
|
|
|
+ Result:=((Attr and faDirectory)=0)
|
|
|
|
+ else
|
|
|
|
+ Result:=false
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ { should not be called in this case, use plain FileExists }
|
|
|
|
+ Result:=False;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
function TCachedDirectory.DirectoryExists(const AName:TCmdStr):boolean;
|
|
function TCachedDirectory.DirectoryExists(const AName:TCmdStr):boolean;
|
|
var
|
|
var
|
|
Attr : Longint;
|
|
Attr : Longint;
|
|
begin
|
|
begin
|
|
- if not(tf_files_case_sensitive in source_info.flags) then
|
|
|
|
- Attr:=PtrInt(DirectoryEntries.Find(Lower(AName)))
|
|
|
|
- else
|
|
|
|
- Attr:=PtrInt(DirectoryEntries.Find(AName));
|
|
|
|
|
|
+ Attr:=GetItemAttr(AName);
|
|
if Attr<>0 then
|
|
if Attr<>0 then
|
|
Result:=((Attr and faDirectory)=faDirectory)
|
|
Result:=((Attr and faDirectory)=faDirectory)
|
|
else
|
|
else
|
|
@@ -242,6 +314,17 @@ implementation
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
+ function TDirectoryCache.FileExistsCaseAware(const AName:TCmdStr; out FoundName:TCmdStr):boolean;
|
|
|
|
+ var
|
|
|
|
+ CachedDir : TCachedDirectory;
|
|
|
|
+ begin
|
|
|
|
+ Result:=false;
|
|
|
|
+ CachedDir:=GetDirectory(ExtractFileDir(AName));
|
|
|
|
+ if assigned(CachedDir) then
|
|
|
|
+ Result:=CachedDir.FileExistsCaseAware(ExtractFileName(AName),FoundName);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
function TDirectoryCache.DirectoryExists(const AName:TCmdStr):boolean;
|
|
function TDirectoryCache.DirectoryExists(const AName:TCmdStr):boolean;
|
|
var
|
|
var
|
|
CachedDir : TCachedDirectory;
|
|
CachedDir : TCachedDirectory;
|
|
@@ -418,11 +501,24 @@ implementation
|
|
1. NormalCase
|
|
1. NormalCase
|
|
}
|
|
}
|
|
FoundFile:=path+fn;
|
|
FoundFile:=path+fn;
|
|
- If FileExists(FoundFile,allowcache) then
|
|
|
|
- begin
|
|
|
|
- result:=true;
|
|
|
|
- exit;
|
|
|
|
- end;
|
|
|
|
|
|
+{$ifdef usedircache}
|
|
|
|
+ if allowcache then
|
|
|
|
+ begin
|
|
|
|
+ result:=DirCache.FileExistsCaseAware(FoundFile,fn2);
|
|
|
|
+ if (result) then
|
|
|
|
+ begin
|
|
|
|
+ FoundFile:=path+fn2;
|
|
|
|
+ exit
|
|
|
|
+ end
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+{$endif usedircache}
|
|
|
|
+ If FileExists(FoundFile,allowcache) then
|
|
|
|
+ begin
|
|
|
|
+ { don't know the real name in this case }
|
|
|
|
+ result:=true;
|
|
|
|
+ exit;
|
|
|
|
+ end;
|
|
end
|
|
end
|
|
else
|
|
else
|
|
begin
|
|
begin
|