Virtual-File-System/VfsUtils.pas

584 lines
19 KiB
ObjectPascal

unit VfsUtils;
(*
*)
(***) interface (***)
uses
SysUtils, Math, Windows,
Utils, WinNative, Alg, TypeWrappers, Lists, DataLib,
StrLib;
type
(* Import *)
TDict = DataLib.TDict;
TObjDict = DataLib.TObjDict;
TString = TypeWrappers.TString;
TList = Lists.TList;
const
MAX_FILENAME_SIZE = WinNative.MAX_FILENAME_LEN * sizeof(WideChar);
DRIVE_CHAR_INDEX_IN_NT_ABS_PATH = 5; // \??\D:
type
TSysOpenFileMode = (OPEN_AS_ANY = 0, OPEN_AS_FILE = WinNative.FILE_NON_DIRECTORY_FILE, OPEN_AS_DIR = WinNative.FILE_DIRECTORY_FILE);
(* WINNT widest file structre wrapper *)
PNativeFileInfo = ^TNativeFileInfo;
TNativeFileInfo = record
Base: WinNative.FILE_ID_BOTH_DIR_INFORMATION;
FileName: WideString;
procedure SetFileName (const NewFileName: WideString);
function CopyFileNameToBuf ({ni} Buf: pbyte; BufSize: integer): boolean;
function GetFileSize: Int64;
end;
(* TNativeFileInfo wrapper for dynamical data structures with memory manamement *)
TFileInfo = class
public
Data: TNativeFileInfo;
constructor Create ({n} Data: PNativeFileInfo = nil);
end;
(* Universal directory listing holder *)
TDirListing = class
private
{O} fFileList: {O} DataLib.TList {OF TFileInfo};
fFileInd: integer;
function GetCount: integer;
public
constructor Create;
destructor Destroy; override;
function IsEnd: boolean;
procedure AddItem ({U} FileInfo: PNativeFileInfo; const FileName: WideString = ''; const InsertBefore: integer = High(integer));
function GetNextItem ({OUT} var {U} Res: TFileInfo): boolean;
procedure Rewind;
(* Always seeks as close as possible *)
function Seek (SeekInd: integer): boolean;
function SeekRel (RelInd: integer): boolean;
function GetDebugDump: string;
property FileInd: integer read fFileInd;
property Count: integer read GetCount;
end; // .class TDirListing
ISysDirScanner = interface
function IterNext ({OUT} var FileName: WideString; {n} FileInfo: WinNative.PFILE_ID_BOTH_DIR_INFORMATION = nil): boolean;
end;
TSysDirScanner = class (Utils.TManagedObject, ISysDirScanner)
protected const
BUF_SIZE = (sizeof(WinNative.FILE_ID_BOTH_DIR_INFORMATION) + MAX_FILENAME_SIZE) * 10;
protected
fOwnsDirHandle: boolean;
fDirHandle: Windows.THandle;
fMask: WideString;
fMaskU: WinNative.UNICODE_STRING;
fIsStart: boolean;
fIsEnd: boolean;
fBufPos: integer;
fBuf: array [0..BUF_SIZE - 1] of byte;
public
constructor Create (const hDir: Windows.THandle; const Mask: WideString); overload;
constructor Create (const DirPath, Mask: WideString); overload;
destructor Destroy; override;
function IterNext ({OUT} var FileName: WideString; {n} FileInfo: WinNative.PFILE_ID_BOTH_DIR_INFORMATION = nil): boolean;
end; // .class TSysDirScanner
(* Packs lower cased WideString bytes into AnsiString buffer *)
function WideStrToCaselessKey (const Str: WideString): string;
(* The opposite of WideStrToKey *)
function CaselessKeyToWideStr (const CaselessKey: string): WideString;
(* Returns expanded unicode path, preserving trailing delimiter, or original path on error *)
function ExpandPath (const Path: WideString): WideString;
(* Returns expanded path without trailing delimiter (for non-drives). Optionally returns flag, whether path had trailing delim or not.
The flag is false for drives *)
function NormalizePath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
(* Returns absolute normalized path with nt path prefix '\??\' (unless path already begins with '\' character).
Optionally returns flag, whether path had trailing delim or not. *)
function ToNtAbsPath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
(* Return true if path is valid absolute path to root drive like '\??\X:' with any/zero number of trailing slashes *)
function IsNtRootDriveAbsPath (const Path: WideString): boolean;
(* Removes optional leading \??\ prefix from path *)
function StripNtAbsPathPrefix (const Path: WideString): WideString;
(* Saves API result in external variable and returns result as is *)
function SaveAndRet (Res: integer; out ResCopy): integer;
(* Opens file/directory using absolute NT path and returns success flag *)
function SysOpenFile (const NtAbsPath: WideString; {OUT} var Res: Windows.THandle; const OpenMode: TSysOpenFileMode = OPEN_AS_ANY; const AccessMode: ACCESS_MASK = GENERIC_READ or SYNCHRONIZE): boolean;
(* Returns TNativeFileInfo record for single file/directory. Short names and files indexes/ids in the result are always empty. *)
function GetFileInfo (const FilePath: WideString; {OUT} var Res: TNativeFileInfo): boolean;
function SysScanDir (const hDir: Windows.THandle; const Mask: WideString): ISysDirScanner; overload;
function SysScanDir (const DirPath, Mask: WideString): ISysDirScanner; overload;
(* Scans specified directory and adds sorted entries to directory listing. Optionally exclude names from Exclude dictionary.
Excluded items must be preprocessed via WideStringToCaselessKey routine *)
procedure GetDirectoryListing (const SearchPath, FileMask: WideString; {Un} Exclude: TDict {OF CaselessKey => not NIL}; DirListing: TDirListing);
(***) implementation (***)
type
TDirListingItem = class
SearchName: WideString;
Info: TNativeFileInfo;
end;
function WideStrToCaselessKey (const Str: WideString): string;
var
ProcessedPath: WideString;
begin
result := '';
if Str <> '' then begin
ProcessedPath := StrLib.WideLowerCase(Str);
SetLength(result, Length(ProcessedPath) * sizeof(ProcessedPath[1]) div sizeof(result[1]));
Utils.CopyMem(Length(result) * sizeof(result[1]), PWideChar(ProcessedPath), PChar(result));
end;
end;
function CaselessKeyToWideStr (const CaselessKey: string): WideString;
begin
result := '';
if CaselessKey <> '' then begin
SetLength(result, Length(CaselessKey) * sizeof(CaselessKey[1]) div sizeof(result[1]));
Utils.CopyMem(Length(result) * sizeof(result[1]), pchar(CaselessKey), PWideChar(result));
end;
end;
function ExpandPath (const Path: WideString): WideString;
var
BufLen: integer;
NumCharsCopied: integer;
FileNameAddr: PWideChar;
begin
result := '';
if Path <> '' then begin
BufLen := 0;
NumCharsCopied := Windows.GetFullPathNameW(PWideChar(Path), 0, nil, FileNameAddr);
while NumCharsCopied > BufLen do begin
BufLen := NumCharsCopied;
SetLength(result, BufLen - 1);
NumCharsCopied := Windows.GetFullPathNameW(PWideChar(Path), BufLen, PWideChar(result), FileNameAddr);
end;
if NumCharsCopied <= 0 then begin
result := Path;
end else begin
SetLength(result, NumCharsCopied);
end;
end; // .if
end; // .function ExpandPath
function NormalizePath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
begin
result := StrLib.ExcludeTrailingDelimW(ExpandPath(Path), HadTrailingDelim);
if (Length(result) = 2) and (result[1] = ':') then begin
result := result + '\';
if HadTrailingDelim <> nil then begin
HadTrailingDelim^ := false;
end;
end;
end;
function ToNtAbsPath (const Path: WideString; {n} HadTrailingDelim: pboolean = nil): WideString;
begin
result := NormalizePath(Path, HadTrailingDelim);
if (result <> '') and (result[1] <> '\') then begin
result := '\??\' + result;
end;
end;
function IsNtRootDriveAbsPath (const Path: WideString): boolean;
const
MIN_VALID_LEN = Length('\??\X:');
var
i: integer;
begin
result := (Length(Path) >= MIN_VALID_LEN) and (Path[1] = '\') and (Path[2] = '?') and (Path[3] = '?') and (Path[4] = '\') and (ord(Path[5]) < 256) and (char(Path[5]) in ['A'..'Z']) and (Path[6] = ':');
if result then begin
for i := MIN_VALID_LEN + 1 to Length(Path) do begin
if Path[i] <> '\' then begin
result := false;
exit;
end;
end;
end;
end; // .function IsNtRootDriveAbsPath
function StripNtAbsPathPrefix (const Path: WideString): WideString;
begin
result := Path;
if (Length(Path) >= 4) and (Path[1] = '\') and (Path[2] = '?') and (Path[3] = '?') and (Path[4] = '\') then begin
result := Copy(Path, 4 + 1);
end;
end;
function SaveAndRet (Res: integer; out ResCopy): integer;
begin
integer(ResCopy) := Res;
result := Res;
end;
procedure TNativeFileInfo.SetFileName (const NewFileName: WideString);
begin
Self.FileName := NewFileName;
Self.Base.FileNameLength := Length(NewFileName) * sizeof(WideChar);
end;
function TNativeFileInfo.CopyFileNameToBuf ({ni} Buf: pbyte; BufSize: integer): boolean;
begin
{!} Assert(Utils.IsValidBuf(Buf, BufSize));
result := integer(Self.Base.FileNameLength) <= BufSize;
if BufSize > 0 then begin
Utils.CopyMem(Self.Base.FileNameLength, PWideChar(Self.FileName), Buf);
end;
end;
function TNativeFileInfo.GetFileSize: Int64;
begin
result := Self.Base.EndOfFile.QuadPart;
end;
constructor TFileInfo.Create ({n} Data: PNativeFileInfo = nil);
begin
if Data <> nil then begin
Self.Data := Data^;
end;
end;
constructor TDirListing.Create;
begin
Self.fFileList := DataLib.NewList(Utils.OWNS_ITEMS);
Self.fFileInd := 0;
end;
destructor TDirListing.Destroy;
begin
SysUtils.FreeAndNil(Self.fFileList);
end;
procedure TDirListing.AddItem (FileInfo: PNativeFileInfo; const FileName: WideString = ''; const InsertBefore: integer = High(integer));
var
{O} Item: TFileInfo;
begin
{!} Assert(FileInfo <> nil);
// * * * * * //
Item := TFileInfo.Create(FileInfo);
if FileName <> '' then begin
Item.Data.SetFileName(FileName);
end;
if InsertBefore >= Self.fFileList.Count then begin
Self.fFileList.Add(Item); Item := nil;
end else begin
Self.fFileList.Insert(Item, InsertBefore); Item := nil;
end;
// * * * * * //
SysUtils.FreeAndNil(Item);
end; // .procedure TDirListing.AddItem
function TDirListing.GetCount: integer;
begin
result := Self.fFileList.Count;
end;
function TDirListing.IsEnd: boolean;
begin
result := Self.fFileInd >= Self.fFileList.Count;
end;
function TDirListing.GetNextItem ({OUT} var Res: TFileInfo): boolean;
begin
result := Self.fFileInd < Self.fFileList.Count;
if result then begin
Res := TFileInfo(Self.fFileList[Self.fFileInd]);
Inc(Self.fFileInd);
end;
end;
procedure TDirListing.Rewind;
begin
Self.fFileInd := 0;
end;
function TDirListing.Seek (SeekInd: integer): boolean;
begin
Self.fFileInd := Alg.ToRange(SeekInd, 0, Self.fFileList.Count - 1);
result := Self.fFileInd = SeekInd;
end;
function TDirListing.SeekRel (RelInd: integer): boolean;
begin
result := Self.Seek(Self.fFileInd + RelInd);
end;
function TDirListing.GetDebugDump: string;
var
FileNames: Utils.TArrayOfStr;
i: integer;
begin
SetLength(FileNames, Self.fFileList.Count);
for i := 0 to Self.fFileList.Count - 1 do begin
FileNames[i] := TFileInfo(Self.fFileList[i]).Data.FileName;
end;
result := StrLib.Join(FileNames, #13#10);
end;
function SysOpenFile (const NtAbsPath: WideString; {OUT} var Res: Windows.THandle; const OpenMode: TSysOpenFileMode = OPEN_AS_ANY; const AccessMode: ACCESS_MASK = GENERIC_READ or SYNCHRONIZE): boolean;
var
FilePathU: WinNative.UNICODE_STRING;
hFile: Windows.THandle;
ObjAttrs: WinNative.OBJECT_ATTRIBUTES;
IoStatusBlock: WinNative.IO_STATUS_BLOCK;
begin
FilePathU.AssignExistingStr(NtAbsPath);
ObjAttrs.Init(@FilePathU);
result := WinNative.NtOpenFile(@hFile, AccessMode, @ObjAttrs, @IoStatusBlock, FILE_SHARE_READ or FILE_SHARE_WRITE, ord(OpenMode) or FILE_SYNCHRONOUS_IO_NONALERT) = WinNative.STATUS_SUCCESS;
if result then begin
Res := hFile;
end;
end; // .function SysOpenFile
function GetFileInfo (const FilePath: WideString; {OUT} var Res: TNativeFileInfo): boolean;
const
BUF_SIZE = sizeof(WinNative.FILE_ALL_INFORMATION) + MAX_FILENAME_SIZE;
var
{U} FileAllInfo: WinNative.PFILE_ALL_INFORMATION;
NtAbsPath: WideString;
hFile: Windows.THandle;
Buf: array [0..BUF_SIZE - 1] of byte;
IoStatusBlock: WinNative.IO_STATUS_BLOCK;
begin
FileAllInfo := @Buf;
// * * * * * //
NtAbsPath := ToNtAbsPath(FilePath);
result := SysOpenFile(NtAbsPath, hFile, OPEN_AS_ANY);
if not result then begin
exit;
end;
if IsNtRootDriveAbsPath(NtAbsPath) then begin
// Return fake info for root drive
result := SaveAndRet(Windows.GetFileAttributesW(PWideChar(StripNtAbsPathPrefix(NtAbsPath))), FileAllInfo.BasicInformation.FileAttributes) <> integer(Windows.INVALID_HANDLE_VALUE);
if result then begin
FillChar(Res.Base, sizeof(Res.Base), 0);
Res.Base.FileAttributes := FileAllInfo.BasicInformation.FileAttributes;
Res.SetFileName(NtAbsPath[DRIVE_CHAR_INDEX_IN_NT_ABS_PATH] + WideString(':\'#0));
end;
end else begin
result := WinNative.NtQueryInformationFile(hFile, @IoStatusBlock, FileAllInfo, BUF_SIZE, ord(WinNative.FileAllInformation)) = WinNative.STATUS_SUCCESS;
if result then begin
Res.Base.FileIndex := 0;
Res.Base.CreationTime := FileAllInfo.BasicInformation.CreationTime;
Res.Base.LastAccessTime := FileAllInfo.BasicInformation.LastAccessTime;
Res.Base.LastWriteTime := FileAllInfo.BasicInformation.LastWriteTime;
Res.Base.ChangeTime := FileAllInfo.BasicInformation.ChangeTime;
Res.Base.FileAttributes := FileAllInfo.BasicInformation.FileAttributes;
Res.Base.EndOfFile := FileAllInfo.StandardInformation.EndOfFile;
Res.Base.AllocationSize := FileAllInfo.StandardInformation.AllocationSize;
Res.Base.EaSize := FileAllInfo.EaInformation.EaSize;
Res.Base.ShortNameLength := 0;
Res.Base.ShortName[0] := #0;
Res.Base.FileNameLength := FileAllInfo.NameInformation.FileNameLength;
Res.Base.FileId.LowPart := 0;
Res.Base.FileId.HighPart := 0;
Res.SetFileName(StrLib.ExtractFileNameW(StrLib.WideStringFromBuf(
@FileAllInfo.NameInformation.FileName,
Max(0, Min(integer(IoStatusBlock.Information) - sizeof(FileAllInfo^), FileAllInfo.NameInformation.FileNameLength)) div sizeof(WideChar)
)));
end; // .if
end; // .else
WinNative.NtClose(hFile);
end; // .function GetFileInfo
constructor TSysDirScanner.Create (const hDir: Windows.THandle; const Mask: WideString);
begin
Self.fOwnsDirHandle := false;
Self.fDirHandle := hDir;
Self.fMask := StrLib.WideLowerCase(Mask);
Self.fMaskU.AssignExistingStr(Self.fMask);
Self.fIsStart := true;
Self.fIsEnd := false;
Self.fBufPos := 0;
end;
constructor TSysDirScanner.Create (const DirPath, Mask: WideString);
var
hDir: Windows.THandle;
begin
hDir := Windows.INVALID_HANDLE_VALUE;
SysOpenFile(ToNtAbsPath(DirPath), hDir, OPEN_AS_DIR);
Self.Create(hDir, Mask);
if hDir <> Windows.INVALID_HANDLE_VALUE then begin
Self.fOwnsDirHandle := true;
end else begin
Self.fIsEnd := true;
end;
end; // .constructor TSysDirScanner.Create
destructor TSysDirScanner.Destroy;
begin
if Self.fOwnsDirHandle then begin
WinNative.NtClose(Self.fDirHandle);
end;
end;
function TSysDirScanner.IterNext ({OUT} var FileName: WideString; {n} FileInfo: WinNative.PFILE_ID_BOTH_DIR_INFORMATION = nil): boolean;
const
MULTIPLE_ENTRIES = false;
var
{n} FileInfoInBuf: WinNative.PFILE_ID_BOTH_DIR_INFORMATION;
IoStatusBlock: WinNative.IO_STATUS_BLOCK;
FileNameLen: integer;
Status: integer;
begin
FileInfoInBuf := nil;
// * * * * * //
result := not Self.fIsEnd and (Self.fDirHandle <> Windows.INVALID_HANDLE_VALUE);
if not result then begin
exit;
end;
if not Self.fIsStart and (Self.fBufPos < Self.BUF_SIZE) then begin
FileInfoInBuf := @Self.fBuf[Self.fBufPos];
FileNameLen := Min(FileInfoInBuf.FileNameLength, Self.BUF_SIZE - Self.fBufPos) div sizeof(WideChar);
FileName := StrLib.WideStringFromBuf(@FileInfoInBuf.FileName, FileNameLen);
if FileInfo <> nil then begin
FileInfo^ := FileInfoInBuf^;
FileInfo.FileNameLength := FileNameLen * sizeof(WideChar);
end;
//VarDump(['Read entry: ', FileName]);
Self.fBufPos := Utils.IfThen(FileInfoInBuf.NextEntryOffset <> 0, Self.fBufPos + integer(FileInfoInBuf.NextEntryOffset), Self.BUF_SIZE);
end else begin
Self.fBufPos := 0;
Status := WinNative.NtQueryDirectoryFile(Self.fDirHandle, 0, nil, nil, @IoStatusBlock, @Self.fBuf, Self.BUF_SIZE, ord(WinNative.FileIdBothDirectoryInformation), MULTIPLE_ENTRIES, @Self.fMaskU, Self.fIsStart);
result := (Status = WinNative.STATUS_SUCCESS) and (integer(IoStatusBlock.Information) <> 0);
//VarDump([Format('Called NtQueryDirectoryFile. Status: %x. Io.Information: %d', [Status, int(IoStatusBlock.Information)])]);
Self.fIsStart := false;
if result then begin
result := Self.IterNext(FileName, FileInfo);
end else begin
Self.fIsEnd := true;
end;
end; // .else
end; // .function TSysDirScanner.IterNext
function SysScanDir (const hDir: Windows.THandle; const Mask: WideString): ISysDirScanner; overload;
begin
result := TSysDirScanner.Create(hDir, Mask);
end;
function SysScanDir (const DirPath, Mask: WideString): ISysDirScanner; overload;
begin
result := TSysDirScanner.Create(DirPath, Mask);
end;
function CompareFileItemsByNameAsc (Item1, Item2: integer): integer;
begin
result := StrLib.CompareBinStringsW(TDirListingItem(Item1).SearchName, TDirListingItem(Item2).SearchName);
if result = 0 then begin
result := StrLib.CompareBinStringsW(TDirListingItem(Item1).Info.FileName, TDirListingItem(Item2).Info.FileName);
end;
end;
procedure SortDirListing ({U} List: TList {OF TDirListingItem});
begin
List.CustomSort(CompareFileItemsByNameAsc);
end;
procedure GetDirectoryListing (const SearchPath, FileMask: WideString; {Un} Exclude: TDict {OF CaselessKey => not NIL}; DirListing: TDirListing);
var
{O} Items: {O} TList {OF TDirListingItem};
{O} Item: {O} TDirListingItem;
i: integer;
begin
{!} Assert(DirListing <> nil);
// * * * * * //
Items := DataLib.NewList(Utils.OWNS_ITEMS);
Item := TDirListingItem.Create;
// * * * * * //
with VfsUtils.SysScanDir(SearchPath, FileMask) do begin
while IterNext(Item.Info.FileName, @Item.Info.Base) do begin
if (Exclude = nil) or (Exclude[WideStrToCaselessKey(Item.Info.FileName)] = nil) then begin
Item.SearchName := StrLib.WideLowerCase(Item.Info.FileName);
Items.Add(Item); Item := nil;
Item := TDirListingItem.Create;
end;
end;
end;
SortDirListing(Items);
for i := 0 to Items.Count - 1 do begin
DirListing.AddItem(@TDirListingItem(Items[i]).Info);
end;
// * * * * * //
SysUtils.FreeAndNil(Items);
SysUtils.FreeAndNil(Item);
end; // .procedure GetDirectoryListing
end.