mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 08:09:29 +02:00
Improve NativeNT RTL (tested on Windows 7)
* fix DirectoryExists which didn't yet work without System privileges * fix FileExists which didn't use the correct access flags + implement FindFirst/FindNext/FindClose which is conceptually based on the Find-mechanism of the Unix RTL as for the object hierarchy I can't use the same mechanism that Windows provides for filesystems (the function NtQueryDirectoryFile provides the possibility to pass a pattern, but I'm not using that functionality; maybe I'll update FindNext in the future to use this for speed up...). Note: The PChar "workaround" is needed, because string reallocation does currently not work... (maybe Reallocmem is buggy) - remove FindMatch which is only provided by Windows SysUtils and DOS units + add functions/constants/types which are used by Find* to the NDK includes - remove "packed" from file information types (Windows 7 didn't like the size otherwise) git-svn-id: trunk@21438 -
This commit is contained in:
svenbarth
parent
3b7a933e9d
commit
22d1a8bbab
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -7944,6 +7944,7 @@ rtl/nativent/ndk/ketypes.inc svneol=native#text/plain
|
||||
rtl/nativent/ndk/ntdef.inc svneol=native#text/plain
|
||||
rtl/nativent/ndk/ntstatus.inc svneol=native#text/plain
|
||||
rtl/nativent/ndk/obfuncs.inc svneol=native#text/plain
|
||||
rtl/nativent/ndk/obtypes.inc svneol=native#text/plain
|
||||
rtl/nativent/ndk/peb_teb.inc svneol=native#text/plain
|
||||
rtl/nativent/ndk/pstypes.inc svneol=native#text/plain
|
||||
rtl/nativent/ndk/rtlfuncs.inc svneol=native#text/plain
|
||||
|
||||
@ -35,6 +35,7 @@ const
|
||||
{$include iotypes.inc}
|
||||
{$include rtltypes.inc}
|
||||
{$include ketypes.inc}
|
||||
{$include obtypes.inc}
|
||||
{$include pstypes.inc}
|
||||
{$include peb_teb.inc}
|
||||
|
||||
|
||||
@ -38,6 +38,20 @@ function NtOpenFile(
|
||||
OpenOptions: ULONG
|
||||
): NTSTATUS; external ntdll;
|
||||
|
||||
function NtQueryDirectoryFile(
|
||||
FileHandle: HANDLE;
|
||||
Event: HANDLE; {OPTIONAL}
|
||||
ApcRoutine: PIO_APC_ROUTINE; {OPTIONAL}
|
||||
ApcContext: PVOID; {OPTIONAL}
|
||||
IoStatusBlock: PIO_STATUS_BLOCK;
|
||||
FileInformation: PVOID;
|
||||
Length: ULONG;
|
||||
FileInformationClass: FILE_INFORMATION_CLASS;
|
||||
ReturnSingleEntry: NT_BOOLEAN;
|
||||
FileName: PUNICODE_STRING; {OPTIONAL}
|
||||
RestartScan: NT_BOOLEAN
|
||||
): NTSTATUS; external ntdll;
|
||||
|
||||
function NtQueryFullAttributesFile(
|
||||
ObjectAttributes: POBJECT_ATTRIBUTES;
|
||||
FileInformation: PFILE_NETWORK_OPEN_INFORMATION
|
||||
|
||||
@ -104,8 +104,8 @@ type
|
||||
//
|
||||
// I/O Status Block
|
||||
//
|
||||
_IO_STATUS_BLOCK = packed record
|
||||
union1: packed record
|
||||
_IO_STATUS_BLOCK = record
|
||||
union1: record
|
||||
case Boolean of
|
||||
True: (Status: NTSTATUS);
|
||||
False: (Pointer: PVOID);
|
||||
@ -118,7 +118,7 @@ type
|
||||
//
|
||||
// File Information structures for NtQueryInformationFile
|
||||
//
|
||||
_FILE_BASIC_INFORMATION = packed record
|
||||
_FILE_BASIC_INFORMATION = record
|
||||
CreationTime: LARGE_INTEGER;
|
||||
LastAccessTime: LARGE_INTEGER;
|
||||
LastWriteTime: LARGE_INTEGER;
|
||||
@ -126,9 +126,9 @@ type
|
||||
FileAttributes: ULONG;
|
||||
end;
|
||||
FILE_BASIC_INFORMATION = _FILE_BASIC_INFORMATION;
|
||||
PFILE_BASIC_INFORMATION = FILE_BASIC_INFORMATION;
|
||||
PFILE_BASIC_INFORMATION = ^FILE_BASIC_INFORMATION;
|
||||
|
||||
_FILE_STANDARD_INFORMATION = packed record
|
||||
_FILE_STANDARD_INFORMATION = record
|
||||
AllocationSize: LARGE_INTEGER;
|
||||
EndOfFile: LARGE_INTEGER;
|
||||
NumberOfLinks: ULONG;
|
||||
@ -138,7 +138,7 @@ type
|
||||
FILE_STANDARD_INFORMATION = _FILE_STANDARD_INFORMATION;
|
||||
PFILE_STANDARD_INFORMATION = ^FILE_STANDARD_INFORMATION;
|
||||
|
||||
_FILE_NETWORK_OPEN_INFORMATION = packed record
|
||||
_FILE_NETWORK_OPEN_INFORMATION = record
|
||||
CreationTime: LARGE_INTEGER;
|
||||
LastAccessTime: LARGE_INTEGER;
|
||||
LastWriteTime: LARGE_INTEGER;
|
||||
@ -150,19 +150,19 @@ type
|
||||
FILE_NETWORK_OPEN_INFORMATION = _FILE_NETWORK_OPEN_INFORMATION;
|
||||
PFILE_NETWORK_OPEN_INFORMATION = ^FILE_NETWORK_OPEN_INFORMATION;
|
||||
|
||||
_FILE_POSITION_INFORMATION = packed record
|
||||
_FILE_POSITION_INFORMATION = record
|
||||
CurrentByteOffset: LARGE_INTEGER;
|
||||
end;
|
||||
FILE_POSITION_INFORMATION = _FILE_POSITION_INFORMATION;
|
||||
PFILE_POSITION_INFORMATION = ^FILE_POSITION_INFORMATION;
|
||||
|
||||
_FILE_DISPOSITION_INFORMATION = packed record
|
||||
_FILE_DISPOSITION_INFORMATION = record
|
||||
DeleteFile: NT_BOOLEAN;
|
||||
end;
|
||||
FILE_DISPOSITION_INFORMATION = _FILE_DISPOSITION_INFORMATION;
|
||||
PFILE_DISPOSITION_INFORMATION = ^FILE_DISPOSITION_INFORMATION;
|
||||
|
||||
_FILE_RENAME_INFORMATION = packed record
|
||||
_FILE_RENAME_INFORMATION = record
|
||||
ReplaceIfExists: NT_BOOLEAN;
|
||||
RootDirectory: HANDLE;
|
||||
FileNameLength: ULONG;
|
||||
@ -171,16 +171,65 @@ type
|
||||
FILE_RENAME_INFORMATION = _FILE_RENAME_INFORMATION;
|
||||
PFILE_RENAME_INFORMATION = ^FILE_RENAME_INFORMATION;
|
||||
|
||||
_FILE_ALLOCATION_INFORMATION = packed record
|
||||
_FILE_BOTH_DIR_INFORMATION = record
|
||||
NextEntryOffset: ULONG;
|
||||
FileIndex: ULONG;
|
||||
CreationTime: LARGE_INTEGER;
|
||||
LastAccessTime: LARGE_INTEGER;
|
||||
LastWriteTime: LARGE_INTEGER;
|
||||
ChangeTime: LARGE_INTEGER;
|
||||
EndOfFile: LARGE_INTEGER;
|
||||
AllocationSize: LARGE_INTEGER;
|
||||
FileAttributes: ULONG;
|
||||
FileNameLength: ULONG;
|
||||
EaSize: ULONG;
|
||||
ShortNameLength: CCHAR;
|
||||
ShortName: array[0..11] of WCHAR;
|
||||
FileName: array[0..0] of WCHAR;
|
||||
end;
|
||||
FILE_BOTH_DIR_INFORMATION = _FILE_BOTH_DIR_INFORMATION;
|
||||
PFILE_BOTH_DIR_INFORMATION = ^FILE_BOTH_DIR_INFORMATION;
|
||||
|
||||
_FILE_NAME_INFORMATION = record
|
||||
FileNameLength: ULONG;
|
||||
FileName: array[0..0] of WCHAR;
|
||||
end;
|
||||
FILE_NAME_INFORMATION = _FILE_NAME_INFORMATION;
|
||||
PFILE_NAME_INFORMATION = ^FILE_NAME_INFORMATION;
|
||||
|
||||
_FILE_ALLOCATION_INFORMATION = record
|
||||
AllocationSize: LARGE_INTEGER;
|
||||
end;
|
||||
FILE_ALLOCATION_INFORMATION = _FILE_ALLOCATION_INFORMATION;
|
||||
PFILE_ALLOCATION_INFORMATION = ^FILE_ALLOCATION_INFORMATION;
|
||||
|
||||
_FILE_END_OF_FILE_INFORMATION = packed record
|
||||
_FILE_END_OF_FILE_INFORMATION = record
|
||||
EndOfFile: LARGE_INTEGER;
|
||||
end;
|
||||
FILE_END_OF_FILE_INFORMATION = _FILE_END_OF_FILE_INFORMATION;
|
||||
PFILE_END_OF_FILE_INFORMATION = ^FILE_END_OF_FILE_INFORMATION;
|
||||
|
||||
_FILE_DIRECTORY_INFORMATION = record
|
||||
NextEntryOffset: ULONG;
|
||||
FileIndex: ULONG;
|
||||
CreationTime: LARGE_INTEGER;
|
||||
LastAccessTime: LARGE_INTEGER;
|
||||
LastWriteTime: LARGE_INTEGER;
|
||||
ChangeTime: LARGE_INTEGER;
|
||||
EndOfFile: LARGE_INTEGER;
|
||||
AllocationSize: LARGE_INTEGER;
|
||||
FileAttributes: ULONG;
|
||||
FileNameLength: ULONG;
|
||||
FileName: array[0..0] of WCHAR;
|
||||
end;
|
||||
FILE_DIRECTORY_INFORMATION = _FILE_DIRECTORY_INFORMATION;
|
||||
PFILE_DIRECTORY_INFORMATION = ^FILE_DIRECTORY_INFORMATION;
|
||||
|
||||
//
|
||||
// APC Callback for NtCreateFile
|
||||
//
|
||||
PIO_APC_ROUTINE = procedure(
|
||||
ApcContext: PVOID;
|
||||
IoStatusBlock: PIO_STATUS_BLOCK;
|
||||
Reserved: ULONG); stdcall;
|
||||
|
||||
|
||||
@ -20,6 +20,12 @@ const
|
||||
|
||||
STATUS_PENDING = NTSTATUS($00000103);
|
||||
|
||||
STATUS_NO_MORE_FILES = NTSTATUS($80000006);
|
||||
STATUS_NO_MORE_ENTRIES = NTSTATUS($8000001A);
|
||||
|
||||
STATUS_INVALID_HANDLE = NTSTATUS($C0000008);
|
||||
STATUS_INVALID_PARAMETER = NTSTATUS($C000000D);
|
||||
STATUS_OBJECT_TYPE_MISMATCH = NTSTATUS($C0000024);
|
||||
STATUS_OBJECT_NAME_COLLISION = NTSTATUS($C0000035);
|
||||
|
||||
|
||||
|
||||
@ -21,6 +21,24 @@ function NtOpenDirectoryObject(
|
||||
ObjectAttributes: POBJECT_ATTRIBUTES
|
||||
): NTSTATUS; external ntdll;
|
||||
|
||||
function NtQueryDirectoryObject(
|
||||
DirectoryHandle: HANDLE;
|
||||
Buffer: PVOID;
|
||||
BufferLength: ULONG;
|
||||
ReturnSingleEntry: NT_BOOLEAN;
|
||||
RestartScan: NT_BOOLEAN;
|
||||
Context: PULONG;
|
||||
ReturnLength: PULONG {OPTIONAL}
|
||||
): NTSTATUS; external ntdll;
|
||||
|
||||
function NtQueryObject(
|
||||
ObjectHandle: HANDLE;
|
||||
ObjectInformationClass: OBJECT_INFORMATION_CLASS;
|
||||
ObjectInformation: PVOID;
|
||||
Length: ULONG;
|
||||
ResultLength: PULONG {OPTIONAL}
|
||||
): NTSTATUS; external ntdll;
|
||||
|
||||
function NtWaitForSingleObject(
|
||||
_Object: HANDLE;
|
||||
Alertable: NT_BOOLEAN;
|
||||
|
||||
82
rtl/nativent/ndk/obtypes.inc
Normal file
82
rtl/nativent/ndk/obtypes.inc
Normal file
@ -0,0 +1,82 @@
|
||||
{%MainUnit ndk.pas}
|
||||
{
|
||||
Native Development Kit for Native NT
|
||||
|
||||
This file is part of the Free Pascal run time library.
|
||||
This unit contains types for use with the Object Manager.
|
||||
Copyright (c) 2012 by Sven Barth
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
const
|
||||
//
|
||||
// Directory Object Access Rights
|
||||
//
|
||||
DIRECTORY_QUERY = $0001;
|
||||
DIRECTORY_TRAVERSE = $0002;
|
||||
DIRECTORY_CREATE_OBJECT = $0004;
|
||||
DIRECTORY_CREATE_SUBDIRECTORY = $0008;
|
||||
{ TODO }
|
||||
//DIRECTORY_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or $F);
|
||||
|
||||
type
|
||||
//
|
||||
// Object Information Classes for NtQueryInformationObject
|
||||
//
|
||||
_OBJECT_INFORMATION_CLASS = (
|
||||
ObjectBasicInformation,
|
||||
ObjectNameInformation,
|
||||
ObjectTypeInformation,
|
||||
ObjectTypesInformation,
|
||||
ObjectHandleFlagInformation,
|
||||
ObjectSessionInformation,
|
||||
MaxObjectInfoClass
|
||||
);
|
||||
OBJECT_INFORMATION_CLASS = _OBJECT_INFORMATION_CLASS;
|
||||
|
||||
//
|
||||
// Object Information Types for NtQueryInformationObject
|
||||
//
|
||||
_OBJECT_NAME_INFORMATION = record
|
||||
Name: UNICODE_STRING;
|
||||
end;
|
||||
OBJECT_NAME_INFORMATION = _OBJECT_NAME_INFORMATION;
|
||||
POBJECT_NAME_INFORMATION = ^OBJECT_NAME_INFORMATION;
|
||||
|
||||
_OBJECT_HANDLE_ATTRIBUTE_INFORMATION = record
|
||||
Inherit: NT_BOOLEAN;
|
||||
ProtectFromClose: NT_BOOLEAN;
|
||||
end;
|
||||
OBJECT_HANDLE_ATTRIBUTE_INFORMATION = _OBJECT_HANDLE_ATTRIBUTE_INFORMATION;
|
||||
POBJECT_HANDLE_ATTRIBUTE_INFORMATION = ^OBJECT_HANDLE_ATTRIBUTE_INFORMATION;
|
||||
|
||||
_OBJECT_DIRECTORY_INFORMATION = record
|
||||
Name: UNICODE_STRING;
|
||||
TypeName: UNICODE_STRING;
|
||||
end;
|
||||
OBJECT_DIRECTORY_INFORMATION = _OBJECT_DIRECTORY_INFORMATION;
|
||||
POBJECT_DIRECTORY_INFORMATION = ^OBJECT_DIRECTORY_INFORMATION;
|
||||
|
||||
_OBJECT_BASIC_INFORMATION = record
|
||||
Attributes: ULONG;
|
||||
GrantedAccess: ACCESS_MASK;
|
||||
HandleCount: ULONG;
|
||||
PointerCount: ULONG;
|
||||
PagedPoolUsage: ULONG;
|
||||
NonPagedPoolUsage: ULONG;
|
||||
Reserved: array[0..2] of ULONG;
|
||||
NameInformationLength: ULONG;
|
||||
TypeInformationLength: ULONG;
|
||||
SecurityDescriptorLength: ULONG;
|
||||
CreateTime: LARGE_INTEGER;
|
||||
end;
|
||||
OBJECT_BASIC_INFORMATION = _OBJECT_BASIC_INFORMATION;
|
||||
POBJECT_BASIC_INFORMATION = ^OBJECT_BASIC_INFORMATION;
|
||||
|
||||
@ -18,6 +18,8 @@
|
||||
type
|
||||
WCHAR = WideChar;
|
||||
PWSTR = PWideChar;
|
||||
CCHAR = Byte;
|
||||
PCCHAR = ^CCHAR;
|
||||
|
||||
const
|
||||
NT_DELETE = $00010000;
|
||||
|
||||
@ -28,6 +28,17 @@ uses
|
||||
{$DEFINE HAS_SLEEP}
|
||||
{$DEFINE HAS_CREATEGUID}
|
||||
|
||||
type
|
||||
TNativeNTFindData = record
|
||||
SearchSpec: String;
|
||||
NamePos: LongInt;
|
||||
Handle: THandle;
|
||||
IsDirObj: Boolean;
|
||||
SearchAttr: LongInt;
|
||||
Context: ULONG;
|
||||
LastRes: NTSTATUS;
|
||||
end;
|
||||
|
||||
{ Include platform independent interface part }
|
||||
{$i sysutilh.inc}
|
||||
|
||||
@ -56,7 +67,7 @@ const
|
||||
0,
|
||||
FILE_SHARE_READ,
|
||||
FILE_SHARE_WRITE,
|
||||
FILE_SHARE_READ or FILE_SHARE_WRITE);
|
||||
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE);
|
||||
var
|
||||
ntstr: UNICODE_STRING;
|
||||
objattr: OBJECT_ATTRIBUTES;
|
||||
@ -72,6 +83,25 @@ end;
|
||||
|
||||
|
||||
function FileCreate(const FileName : String) : THandle;
|
||||
begin
|
||||
FileCreate := FileCreate(FileName, fmShareDenyNone, 0);
|
||||
end;
|
||||
|
||||
|
||||
function FileCreate(const FileName : String; Rights: longint) : THandle;
|
||||
begin
|
||||
FileCreate := FileCreate(FileName, fmShareDenyNone, Rights);
|
||||
end;
|
||||
|
||||
|
||||
function FileCreate(const FileName : String; ShareMode : longint; Rights: longint) : THandle;
|
||||
const
|
||||
ShareModeFlags: array[0..4] of ULONG = (
|
||||
0,
|
||||
0,
|
||||
FILE_SHARE_READ,
|
||||
FILE_SHARE_WRITE,
|
||||
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE);
|
||||
var
|
||||
ntstr: UNICODE_STRING;
|
||||
objattr: OBJECT_ATTRIBUTES;
|
||||
@ -81,24 +111,13 @@ begin
|
||||
AnsiStrToNTStr(FileName, ntstr);
|
||||
InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
|
||||
NtCreateFile(@Result, GENERIC_READ or GENERIC_WRITE or NT_SYNCHRONIZE,
|
||||
@objattr, @iostatus, Nil, FILE_ATTRIBUTE_NORMAL, 0, FILE_OVERWRITE_IF,
|
||||
@objattr, @iostatus, Nil, FILE_ATTRIBUTE_NORMAL,
|
||||
ShareModeFlags[(ShareMode and $F0) shr 4], FILE_OVERWRITE_IF,
|
||||
FILE_NON_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT, Nil, 0);
|
||||
FreeNtStr(ntstr);
|
||||
end;
|
||||
|
||||
|
||||
function FileCreate(const FileName : String; Rights: longint) : THandle;
|
||||
begin
|
||||
FileCreate := FileCreate(FileName);
|
||||
end;
|
||||
|
||||
|
||||
function FileCreate(const FileName : String; ShareMode : longint; Rights: longint) : THandle;
|
||||
begin
|
||||
FileCreate := FileCreate(FileName);
|
||||
end;
|
||||
|
||||
|
||||
function FileRead(Handle : THandle; out Buffer; Count : longint) : Longint;
|
||||
var
|
||||
iostatus: IO_STATUS_BLOCK;
|
||||
@ -288,6 +307,7 @@ end;
|
||||
|
||||
function FileAge(const FileName: String): Longint;
|
||||
begin
|
||||
{ TODO }
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
@ -302,8 +322,8 @@ var
|
||||
begin
|
||||
AnsiStrToNtStr(FileName, ntstr);
|
||||
InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
|
||||
res := NtOpenFile(@h, 0, @objattr, @iostatus,
|
||||
FILE_SHARE_READ or FILE_SHARE_WRITE,
|
||||
res := NtOpenFile(@h, FILE_READ_ATTRIBUTES or NT_SYNCHRONIZE, @objattr,
|
||||
@iostatus, FILE_SHARE_READ or FILE_SHARE_WRITE,
|
||||
FILE_NON_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT);
|
||||
Result := NT_SUCCESS(res);
|
||||
|
||||
@ -325,15 +345,15 @@ begin
|
||||
InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
|
||||
|
||||
{ first test wether this is a object directory }
|
||||
res := NtOpenDirectoryObject(@h, 0, @objattr);
|
||||
res := NtOpenDirectoryObject(@h, DIRECTORY_QUERY, @objattr);
|
||||
if NT_SUCCESS(res) then
|
||||
Result := True
|
||||
else begin
|
||||
if res = STATUS_OBJECT_TYPE_MISMATCH then begin
|
||||
{ this is a file object! }
|
||||
res := NtOpenFile(@h, 0, @objattr, @iostatus,
|
||||
FILE_SHARE_READ or FILE_SHARE_WRITE,
|
||||
FILE_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT);
|
||||
res := NtOpenFile(@h, FILE_READ_ATTRIBUTES or NT_SYNCHRONIZE, @objattr,
|
||||
@iostatus, FILE_SHARE_READ or FILE_SHARE_WRITE,
|
||||
FILE_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT);
|
||||
Result := NT_SUCCESS(res);
|
||||
end else
|
||||
Result := False;
|
||||
@ -344,28 +364,378 @@ begin
|
||||
FreeNtStr(ntstr);
|
||||
end;
|
||||
|
||||
{ copied from rtl/unix/sysutils.pp }
|
||||
Function FNMatch(const Pattern,Name:string):Boolean;
|
||||
Var
|
||||
LenPat,LenName : longint;
|
||||
|
||||
function FindMatch(var f: TSearchRec): Longint;
|
||||
Function DoFNMatch(i,j:longint):Boolean;
|
||||
Var
|
||||
Found : boolean;
|
||||
Begin
|
||||
Found:=true;
|
||||
While Found and (i<=LenPat) Do
|
||||
Begin
|
||||
Case Pattern[i] of
|
||||
'?' : Found:=(j<=LenName);
|
||||
'*' : Begin
|
||||
{find the next character in pattern, different of ? and *}
|
||||
while Found do
|
||||
begin
|
||||
inc(i);
|
||||
if i>LenPat then Break;
|
||||
case Pattern[i] of
|
||||
'*' : ;
|
||||
'?' : begin
|
||||
if j>LenName then begin DoFNMatch:=false; Exit; end;
|
||||
inc(j);
|
||||
end;
|
||||
else
|
||||
Found:=false;
|
||||
end;
|
||||
end;
|
||||
Assert((i>LenPat) or ( (Pattern[i]<>'*') and (Pattern[i]<>'?') ));
|
||||
{Now, find in name the character which i points to, if the * or ?
|
||||
wasn't the last character in the pattern, else, use up all the
|
||||
chars in name}
|
||||
Found:=false;
|
||||
if (i<=LenPat) then
|
||||
begin
|
||||
repeat
|
||||
{find a letter (not only first !) which maches pattern[i]}
|
||||
while (j<=LenName) and (name[j]<>pattern[i]) do
|
||||
inc (j);
|
||||
if (j<LenName) then
|
||||
begin
|
||||
if DoFnMatch(i+1,j+1) then
|
||||
begin
|
||||
i:=LenPat;
|
||||
j:=LenName;{we can stop}
|
||||
Found:=true;
|
||||
Break;
|
||||
end else
|
||||
inc(j);{We didn't find one, need to look further}
|
||||
end else
|
||||
if j=LenName then
|
||||
begin
|
||||
Found:=true;
|
||||
Break;
|
||||
end;
|
||||
{ This 'until' condition must be j>LenName, not j>=LenName.
|
||||
That's because when we 'need to look further' and
|
||||
j = LenName then loop must not terminate. }
|
||||
until (j>LenName);
|
||||
end else
|
||||
begin
|
||||
j:=LenName;{we can stop}
|
||||
Found:=true;
|
||||
end;
|
||||
end;
|
||||
else {not a wildcard character in pattern}
|
||||
Found:=(j<=LenName) and (pattern[i]=name[j]);
|
||||
end;
|
||||
inc(i);
|
||||
inc(j);
|
||||
end;
|
||||
DoFnMatch:=Found and (j>LenName);
|
||||
end;
|
||||
|
||||
Begin {start FNMatch}
|
||||
LenPat:=Length(Pattern);
|
||||
LenName:=Length(Name);
|
||||
FNMatch:=DoFNMatch(1,1);
|
||||
End;
|
||||
|
||||
|
||||
function FindGetFileInfo(const s: String; var f: TSearchRec): Boolean;
|
||||
var
|
||||
ntstr: UNICODE_STRING;
|
||||
objattr: OBJECT_ATTRIBUTES;
|
||||
res: NTSTATUS;
|
||||
h: THandle;
|
||||
iostatus: IO_STATUS_BLOCK;
|
||||
attr: LongInt;
|
||||
filename: String;
|
||||
isfileobj: Boolean;
|
||||
buf: array of Byte;
|
||||
objinfo: OBJECT_BASIC_INFORMATION;
|
||||
fileinfo: FILE_BASIC_INFORMATION;
|
||||
time: LongInt;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
AnsiStrToNtStr(s, ntstr);
|
||||
InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
|
||||
|
||||
filename := ExtractFileName(s);
|
||||
|
||||
function FindFirst(const Path: String; Attr: Longint; out Rslt: TSearchRec): Longint;
|
||||
begin
|
||||
Result := -1;
|
||||
end;
|
||||
{ TODO : handle symlinks }
|
||||
{ If Assigned(F.FindHandle) and ((((PUnixFindData(f.FindHandle)^.searchattr)) and faSymlink) > 0) then
|
||||
FindGetFileInfo:=(fplstat(pointer(s),st)=0)
|
||||
else
|
||||
FindGetFileInfo:=(fpstat(pointer(s),st)=0);}
|
||||
|
||||
attr := 0;
|
||||
Result := False;
|
||||
|
||||
function FindNext(var Rslt: TSearchRec): Longint;
|
||||
begin
|
||||
Result := -1;
|
||||
if (faDirectory and f.FindData.SearchAttr <> 0) and
|
||||
((filename = '.') or (filename = '..')) then begin
|
||||
attr := faDirectory;
|
||||
res := STATUS_SUCCESS;
|
||||
end else
|
||||
res := STATUS_INVALID_PARAMETER;
|
||||
|
||||
isfileobj := False;
|
||||
|
||||
if not NT_SUCCESS(res) then begin
|
||||
{ first check whether it's a directory }
|
||||
res := NtOpenDirectoryObject(@h, DIRECTORY_QUERY, @objattr);
|
||||
if not NT_SUCCESS(res) then
|
||||
if res = STATUS_OBJECT_TYPE_MISMATCH then begin
|
||||
res := NtOpenFile(@h, FILE_READ_ATTRIBUTES or NT_SYNCHRONIZE, @objattr,
|
||||
@iostatus, FILE_SHARE_READ or FILE_SHARE_WRITE,
|
||||
FILE_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT);
|
||||
isfileobj := NT_SUCCESS(res);
|
||||
end;
|
||||
|
||||
if NT_SUCCESS(res) then
|
||||
attr := faDirectory;
|
||||
end;
|
||||
|
||||
if not NT_SUCCESS(res) then begin
|
||||
{ first try whether we have a file object }
|
||||
res := NtOpenFile(@h, FILE_READ_ATTRIBUTES or NT_SYNCHRONIZE, @objattr,
|
||||
@iostatus, FILE_SHARE_READ or FILE_SHARE_WRITE,
|
||||
FILE_NON_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT);
|
||||
isfileobj := NT_SUCCESS(res);
|
||||
if res = STATUS_OBJECT_TYPE_MISMATCH then begin
|
||||
{ is this an object? }
|
||||
res := NtOpenFile(@h, FILE_READ_ATTRIBUTES or NT_SYNCHRONIZE, @objattr,
|
||||
@iostatus, FILE_SHARE_READ or FILE_SHARE_WRITE,
|
||||
FILE_SYNCHRONOUS_IO_NONALERT);
|
||||
if (res = STATUS_OBJECT_TYPE_MISMATCH)
|
||||
and (f.FindData.SearchAttr and faSysFile <> 0) then begin
|
||||
{ this is some other system file like an event or port, so we can only
|
||||
provide it's name }
|
||||
res := STATUS_SUCCESS;
|
||||
attr := faSysFile;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
FreeNtStr(ntstr);
|
||||
|
||||
if not NT_SUCCESS(res) then
|
||||
Exit;
|
||||
|
||||
time := 0;
|
||||
|
||||
if isfileobj then begin
|
||||
res := NtQueryInformationFile(h, @iostatus, @fileinfo, SizeOf(fileinfo),
|
||||
FileBasicInformation);
|
||||
if NT_SUCCESS(res) then begin
|
||||
time := NtToDosTime(fileinfo.LastWriteTime);
|
||||
{ copy file attributes? }
|
||||
end;
|
||||
end else begin
|
||||
res := NtQueryObject(h, ObjectBasicInformation, @objinfo, SizeOf(objinfo),
|
||||
Nil);
|
||||
if NT_SUCCESS(res) then begin
|
||||
time := NtToDosTime(objinfo.CreateTime);
|
||||
{ what about attributes? }
|
||||
end;
|
||||
end;
|
||||
|
||||
if (attr and not f.FindData.SearchAttr) = 0 then begin
|
||||
f.Name := filename;
|
||||
f.Attr := attr;
|
||||
f.Size := 0;
|
||||
{$ifndef FPUNONE}
|
||||
if time = 0 then
|
||||
{ for now we use "Now" as a fall back; ideally this should be the system
|
||||
start time }
|
||||
f.Time := DateTimeToFileDate(Now)
|
||||
else
|
||||
f.Time := time;
|
||||
{$endif}
|
||||
Result := True;
|
||||
end else
|
||||
Result := False;
|
||||
|
||||
NtClose(h);
|
||||
end;
|
||||
|
||||
|
||||
procedure FindClose(var F: TSearchrec);
|
||||
begin
|
||||
{ empty }
|
||||
if f.FindData.Handle <> 0 then
|
||||
NtClose(f.FindData.Handle);
|
||||
end;
|
||||
|
||||
|
||||
function FindNext(var Rslt: TSearchRec): LongInt;
|
||||
{
|
||||
re-opens dir if not already in array and calls FindGetFileInfo
|
||||
}
|
||||
Var
|
||||
DirName : String;
|
||||
FName,
|
||||
SName : string;
|
||||
Found,
|
||||
Finished : boolean;
|
||||
ntstr: UNICODE_STRING;
|
||||
objattr: OBJECT_ATTRIBUTES;
|
||||
buf: array of WideChar;
|
||||
len: LongWord;
|
||||
res: NTSTATUS;
|
||||
i: LongInt;
|
||||
dirinfo: POBJECT_DIRECTORY_INFORMATION;
|
||||
filedirinfo: PFILE_DIRECTORY_INFORMATION;
|
||||
pc: PChar;
|
||||
name: AnsiString;
|
||||
iostatus: IO_STATUS_BLOCK;
|
||||
begin
|
||||
{ TODO : relative directories }
|
||||
Result := -1;
|
||||
{ SearchSpec='' means that there were no wild cards, so only one file to
|
||||
find.
|
||||
}
|
||||
if Rslt.FindData.SearchSpec = '' then
|
||||
Exit;
|
||||
{ relative directories not supported for now }
|
||||
if Rslt.FindData.NamePos = 0 then
|
||||
Exit;
|
||||
|
||||
if Rslt.FindData.Handle = 0 then begin
|
||||
if Rslt.FindData.NamePos > 1 then
|
||||
name := Copy(Rslt.FindData.SearchSpec, 1, Rslt.FindData.NamePos - 1)
|
||||
else
|
||||
if Rslt.FindData.NamePos = 1 then
|
||||
name := Copy(Rslt.FindData.SearchSpec, 1, 1)
|
||||
else
|
||||
name := Rslt.FindData.SearchSpec;
|
||||
AnsiStrToNtStr(name, ntstr);
|
||||
InitializeObjectAttributes(objattr, @ntstr, 0, 0, Nil);
|
||||
|
||||
res := NtOpenDirectoryObject(@Rslt.FindData.Handle,
|
||||
DIRECTORY_QUERY or DIRECTORY_TRAVERSE, @objattr);
|
||||
if not NT_SUCCESS(res) then begin
|
||||
if res = STATUS_OBJECT_TYPE_MISMATCH then
|
||||
res := NtOpenFile(@Rslt.FindData.Handle,
|
||||
FILE_LIST_DIRECTORY or NT_SYNCHRONIZE, @objattr,
|
||||
@iostatus, FILE_SHARE_READ or FILE_SHARE_WRITE,
|
||||
FILE_DIRECTORY_FILE or FILE_SYNCHRONOUS_IO_NONALERT);
|
||||
end else
|
||||
Rslt.FindData.IsDirObj := True;
|
||||
|
||||
FreeNTStr(ntstr);
|
||||
|
||||
if not NT_SUCCESS(res) then
|
||||
Exit;
|
||||
end;
|
||||
{ if (NTFindData^.SearchType = 0) and
|
||||
(NTFindData^.Dirptr = Nil) then
|
||||
begin
|
||||
If NTFindData^.NamePos = 0 Then
|
||||
DirName:='./'
|
||||
Else
|
||||
DirName:=Copy(NTFindData^.SearchSpec,1,NTFindData^.NamePos);
|
||||
NTFindData^.DirPtr := fpopendir(Pchar(pointer(DirName)));
|
||||
end;}
|
||||
SName := Copy(Rslt.FindData.SearchSpec, Rslt.FindData.NamePos + 1,
|
||||
Length(Rslt.FindData.SearchSpec));
|
||||
Found := False;
|
||||
Finished := not NT_SUCCESS(Rslt.FindData.LastRes)
|
||||
or (Rslt.FindData.LastRes = STATUS_NO_MORE_ENTRIES);
|
||||
SetLength(buf, 200);
|
||||
dirinfo := @buf[0];
|
||||
filedirinfo := @buf[0];
|
||||
while not Finished do begin
|
||||
if Rslt.FindData.IsDirObj then
|
||||
res := NtQueryDirectoryObject(Rslt.FindData.Handle, @buf[0],
|
||||
Length(buf) * SizeOf(buf[0]), True, False,
|
||||
@Rslt.FindData.Context, @len)
|
||||
else
|
||||
res := NtQueryDirectoryFile(Rslt.FindData.Handle, 0, Nil, Nil, @iostatus,
|
||||
@buf[0], Length(buf) * SizeOf(buf[0]), FileDirectoryInformation,
|
||||
True, Nil, False);
|
||||
if Rslt.FindData.IsDirObj then begin
|
||||
Finished := (res = STATUS_NO_MORE_ENTRIES)
|
||||
or (res = STATUS_NO_MORE_FILES)
|
||||
or not NT_SUCCESS(res);
|
||||
Rslt.FindData.LastRes := res;
|
||||
if dirinfo^.Name.Length > 0 then begin
|
||||
SetLength(FName, dirinfo^.Name.Length div 2);
|
||||
pc := PChar(FName);
|
||||
for i := 0 to dirinfo^.Name.Length div 2 - 1 do begin
|
||||
if dirinfo^.Name.Buffer[i] < #256 then
|
||||
pc^ := AnsiChar(Byte(dirinfo^.Name.Buffer[i]))
|
||||
else
|
||||
pc^ := '?';
|
||||
pc := pc + 1;
|
||||
end;
|
||||
{$ifdef debug_findnext}
|
||||
Write(FName, ' (');
|
||||
for i := 0 to dirinfo^.TypeName.Length div 2 - 1 do
|
||||
if dirinfo^.TypeName.Buffer[i] < #256 then
|
||||
Write(AnsiChar(Byte(dirinfo^.TypeName.Buffer[i])))
|
||||
else
|
||||
Write('?');
|
||||
Writeln(')');
|
||||
{$endif debug_findnext}
|
||||
end else
|
||||
FName := '';
|
||||
end else begin
|
||||
SetLength(FName, filedirinfo^.FileNameLength div 2);
|
||||
pc := PChar(FName);
|
||||
for i := 0 to filedirinfo^.FileNameLength div 2 - 1 do begin
|
||||
if filedirinfo^.FileName[i] < #256 then
|
||||
pc^ := AnsiChar(Byte(filedirinfo^.FileName[i]))
|
||||
else
|
||||
pc^ := '?';
|
||||
pc := pc + 1;
|
||||
end;
|
||||
end;
|
||||
if FName = '' then
|
||||
Finished := True
|
||||
else begin
|
||||
if FNMatch(SName, FName) then begin
|
||||
Found := FindGetFileInfo(Copy(Rslt.FindData.SearchSpec, 1,
|
||||
Rslt.FindData.NamePos) + FName, Rslt);
|
||||
if Found then begin
|
||||
Result := 0;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function FindFirst(const Path: String; Attr: Longint; out Rslt: TSearchRec): Longint;
|
||||
{
|
||||
opens dir and calls FindNext if needed.
|
||||
}
|
||||
Begin
|
||||
Result := -1;
|
||||
FillChar(Rslt, SizeOf(Rslt), 0);
|
||||
if Path = '' then
|
||||
Exit;
|
||||
Rslt.FindData.SearchAttr := Attr;
|
||||
{Wildcards?}
|
||||
if (Pos('?', Path) = 0) and (Pos('*', Path) = 0) then begin
|
||||
if FindGetFileInfo(Path, Rslt) then
|
||||
Result := 0;
|
||||
end else begin
|
||||
{Create Info}
|
||||
Rslt.FindData.SearchSpec := Path;
|
||||
Rslt.FindData.NamePos := Length(Rslt.FindData.SearchSpec);
|
||||
while (Rslt.FindData.NamePos > 0)
|
||||
and (Rslt.FindData.SearchSpec[Rslt.FindData.NamePos] <> DirectorySeparator)
|
||||
do
|
||||
Dec(Rslt.FindData.NamePos);
|
||||
Result := FindNext(Rslt);
|
||||
end;
|
||||
if Result <> 0 then
|
||||
FindClose(Rslt);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user