paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-12 15:09:33 +02:00
Code Issues Packages Projects Releases Wiki Activity
e457cdad8a
fpc/rtl/nativent/sysos.inc
Jonas Maebe df6a2dce00 + unicodestring support for assign/erase/rename 
+ codepage support for textrec/filerec and the above routines
  * textrec/filerec now store the filename by default using widechar. It is
    possible to switch back to ansichars using the FPC_ANSI_TEXTFILEREC define.
    In that case, from now on the filename will always be stored in
    DefaultFileSystemEncoding
  * fixed potential buffer overflows and non-null-terminated file names in
    textrec/filerec
  + dodirseparators(pwidechar), changed the dodirseparators(pchar/pwidechar)
    parameters into var-parameters and gave those routines an extra parameter
    that indicates whether the p(wide)char can be changed in place if
    necessary or whether a copy must be made first (avoids us having to make
    all strings always unique everywhere, because they might be changed on
    some platforms via a pchar)
  * do_open/do_erase/do_rename got extra boolean parameters indicating whether
    the passed pchars point to data that can be freely changed (to pass on to
    dodirseparators() if applicable)
  * objects.pp: force assign(pchar) to be called, because
    assign(array[0..255]) cannot choose between pchar and rawbytestring
    versions (and removing the pchar version means that assign(pchar) will
    be mapped to assign(shortstring) in {$h-})
  * fixed up some routines in other units that depend on the format of
    the textrec/filerec.name field

git-svn-id: branches/cpstrrtl@25137 -
2013-07-19 16:30:51 +00:00

408 lines
12 KiB
PHP
Raw Blame History

{
Basic stuff for NativeNT RTLs
This file is part of the Free Pascal run time library.
Copyright (c) 2009-2010 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
{$ifdef kmode}
ntdll = 'ntoskrnl.exe';
{$else}
ntdll = 'ntdll.dll';
{$endif}
type
PHandle = ^THandle;
TNtUnicodeString = packed record
Length: Word; // used characters in buffer
MaximumLength: Word; // maximum characters in buffer
Buffer: PWideChar;
end;
PNtUnicodeString = ^TNtUnicodeString;
// using Int64 is an alternative (QWord might have unintended side effects)
TLargeInteger = packed record
case Boolean of
True:(LowPart: LongWord;
HighPart: LongInt);
False:(QuadPart: Int64);
end;
PLargeInteger = ^TLargeInteger;
TObjectAttributes = record
Length: LongWord;
RootDirectory: THandle;
ObjectName: PNtUnicodeString;
Attributes: LongWord;
SecurityDescriptor: Pointer; // Points to type SECURITY_DESCRIPTOR
SecurityQualityOfService: Pointer; // Points to type SECURITY_QUALITY_OF_SERVICE
end;
PObjectAttributes = ^TObjectAttributes;
TRtlDriveLetterCurDir = packed record
Flags: Word;
Length: Word;
TimeStamp: LongWord;
DosPath: TNtUnicodeString;
end;
TCurDir = packed record
DosPath: TNtUnicodeString;
Handle: THandle;
end;
TRtlUserProcessParameters = packed record
MaximumLength: LongWord;
Length: LongWord;
Flags: LongWord;
DebugFlags: LongWord;
ConsoleHandle: THandle;
ConsoleFlags: LongWord;
StandardInput: THandle;
StandardOutput: THandle;
StandardError: THandle;
CurrentDirectory: TCurDir;
DllPath: TNtUnicodeString;
ImagePathName: TNtUnicodeString;
CommandLine: TNtUnicodeString;
Environment: ^Word; // PWSTR
StartingX: LongWord;
StartingY: LongWord;
CountX: LongWord;
CountY: LongWord;
CountCharsX: LongWord;
CountCharsY: LongWord;
FillAttribute: LongWord;
WindowFlags: LongWord;
ShowWindowFlags: LongWord;
WindowTitle: TNtUnicodeString;
DesktopInfo: TNtUnicodeString;
ShellInfo: TNtUnicodeString;
RuntimeData: TNtUnicodeString;
CurrentDirectories: array[0..31] of TRtlDriveLetterCurDir;
end;
PRtlUserProcessParameters = ^TRtlUserProcessParameters;
// a simple version of the PEB that contains the common stuff
TSimplePEB = packed record
InheritedAddressSpace: Byte;
ReadImageFileExecOptions: Byte;
BeingDebugged: Byte;
SpareBool: Byte;
Mutant: THandle;
ImageBaseAddress: Pointer;
Ldr: Pointer;
ProcessParameters: PRtlUserProcessParameters;
SubSystemData: Pointer;
ProcessHeap: Pointer;
FastPebLock: Pointer;
FastPebLockRoutine: Pointer;
FastPebUnlockRoutine: Pointer;
EnvironmentUpdateCount: LongWord;
KernelCallbackTable: Pointer;
EventLogSection: Pointer;
EventLog: Pointer;
FreeList: Pointer;
TlsExpansionCounter: LongWord;
TlsBitmap: Pointer;
TlsBitmapBits: array[0..1] of LongWord;
ReadOnlySharedMemoryBase: Pointer;
ReadOnlySharedMemoryHeap: Pointer;
ReadOnlyStaticServerData: Pointer;
AnsiCodePageData: Pointer;
OemCodePageData: Pointer;
UnicodeCaseTableData: Pointer;
NumberOfProcessors: LongWord;
NtGlobalFlag: LongWord;
CriticalSectionTimeout: TLargeInteger;
HeapSegmentReserve: LongWord;
HeapSegmentCommit: LongWord;
HeapDeCommitTotalFreeThreshold: LongWord;
HeapDeCommitFreeBlockThreshold: LongWord;
NumberOfHeaps: LongWord;
MaximumNumberOfHeaps: LongWord;
ProcessHeaps: Pointer;
GdiSharedHandleTable: Pointer;
ProcessStarterHelper: Pointer;
GdiDCAttributeList: LongWord;
LoaderLock: Pointer;
OSMajorVersion: LongWord;
OSMinorVersion: LongWord;
OSBuildNumber: Word;
OSCSDVersion: Word;
OSPlatformId: LongWord;
ImageSubSystem: LongWord;
ImageSubSystemMajorVersion: LongWord;
ImageSubSystemMinorVersion: LongWord;
ImageProcessAffinityMask: LongWord;
GdiHandleBuffer: array[0..$21] of LongWord;
PostProcessInitRoutine: Pointer;
TlsExpansionBitmap: Pointer;
TlsExpansionBitmapBits: array[0..$19] of Word;
SessionId: LongWord;
end;
PSimplePEB = ^TSimplePEB;
PExceptionRegistrationRecord = ^TExceptionRegistrationRecord;
TExceptionRegistrationRecord = packed record
Next: PExceptionRegistrationRecord;
Handler: Pointer; //PExceptionRoutine;
end;
PNTTIB = ^TNTTIB;
TNTTIB = packed record
ExceptionList: PExceptionRegistrationRecord;
StackBase: Pointer;
StackLimit: Pointer;
SubSystemTib: Pointer;
union1: record
case Boolean of
True: (FiberData: Pointer);
False: (Version: DWord);
end;
ArbitraryUserPointer: Pointer;
Self: PNTTIB;
end;
TClientID = packed record
UniqueProcess: LongWord;
UniqueThread: LongWord;
end;
PClientID = ^TClientID;
TSimpleTEB = packed record
NtTib: TNTTIB;
EnvironmentPointer: Pointer;
ClientId: TClientID;
end;
PSimpleTEB = ^TSimpleTEB;
const
STATUS_SUCCESS = LongInt($00000000);
STATUS_PENDING = LongInt($00000103);
STATUS_END_OF_FILE = LongInt($C0000011);
STATUS_ACCESS_DENIED = LongInt($C0000022);
STATUS_OBJECT_TYPE_MISMATCH = LongInt($C0000024);
STATUS_PIPE_BROKEN = LongInt($C000014B);
STATUS_OBJECT_NAME_NOT_FOUND = LongInt($C0000034);
STATUS_FILE_IS_A_DIRECTORY = LongInt($C00000BA);
OBJ_INHERIT = $00000002;
OBJ_PERMANENT = $00000010;
FILE_DIRECTORY_FILE = $00000001;
FILE_NON_DIRECTORY_FILE = $00000040;
FILE_SYNCHRONOUS_IO_NONALERT = $00000020;
FILE_OPEN_FOR_BACKUP_INTENT = $00004000;
FILE_OPEN_REMOTE_INSTANCE = $00000400;
STANDARD_RIGHTS_REQUIRED = $000F0000;
FILE_SHARE_READ = $00000001;
FILE_SHARE_WRITE = $00000002;
FILE_SHARE_DELETE = $00000004;
FILE_OPEN = $00000001;
FILE_CREATE = $00000002;
FILE_OVERWRITE_IF = $00000005;
FILE_ATTRIBUTE_NORMAL = $00000080;
NT_SYNCHRONIZE = $00100000; // normally called SYNCHRONIZE
NT_DELETE = $00010000; // normally called DELETE
GENERIC_READ = LongWord($80000000);
GENERIC_WRITE = $40000000;
GENERIC_ALL = $10000000;
FILE_READ_ATTRIBUTES = $00000080;
FileStandardInformation = 5;
FileRenameInformation = 10;
FileDispositionInformation = 13;
FilePositionInformation = 14;
FileAllocationInformation = 19;
FileEndOfFileInformation = 20;
{ Share mode open }
fmShareCompat = $00000000;
fmShareExclusive = $10;
fmShareDenyWrite = $20;
fmShareDenyRead = $30;
fmShareDenyNone = $40;
type
TIoStatusBlock = record
Status: LongInt;
Information: PLongWord;
end;
PIoStatusBlock = ^TIoStatusBlock;
TFileDispositionInformation = record
DeleteFile: LongBool;
end;
TFileStandardInformation = record
AllocationSize: TLargeInteger;
EndOfFile: TLargeInteger;
NumberOfLinks: LongWord;
DeletePending: ByteBool;
Directory: ByteBool;
end;
TFilePositionInformation = record
CurrentByteOffset: TLargeInteger;
end;
TFileEndOfFileInformation = record
EndOfFile: TLargeInteger;
end;
TFileAllocationInformation = record
AllocationSize: TLargeInteger;
end;
TFileRenameInformation = record
ReplaceIfExists: ByteBool;
RootDirectory: THandle;
FileNameLength: LongWord;
FileName: array[0..0] of WideChar;
end;
PFileRenameInformation = ^TFileRenameInformation;
threadvar
errno: LongInt;
procedure Errno2InoutRes;
var
r: Word;
begin
{$message warning 'Correctly implement Errno2InoutRes'}
case errno of
STATUS_OBJECT_NAME_NOT_FOUND:
r := 2;
STATUS_OBJECT_TYPE_MISMATCH:
r := 3;
STATUS_ACCESS_DENIED:
r := 5;
STATUS_END_OF_FILE:
r := 100;
else
r := errno;
end;
errno := 0;
InOutRes := r;
end;
function NtCreateFile(FileHandle: PHandle; DesiredAccess: LongWord;
ObjectAttributes: PObjectAttributes; IoStatusBlock: PIOStatusBlock;
AllocationSize: PLargeInteger; FileAttributes: LongWord;
ShareAccess: LongWord; CreateDisposition: LongWord; CreateOptions: LongWord;
EaBuffer: Pointer; EaLength: LongWord): LongInt; stdcall; external ntdll;
function NtCreateDirectoryObject(DirectoryHandle: PHandle;
DesiredAccess: LongWord; ObjectAttributes: PObjectAttributes): LongInt;
stdcall; external ntdll;
function NtOpenDirectoryObject(DirectoryHandle: PHandle;
DesiredAccess: LongWord; ObjectAttributes: PObjectAttributes): LongInt;
stdcall; external ntdll;
function NtClose(Handle: THandle): LongInt; stdcall; external ntdll;
function NtMakeTemporaryObject(Handle: THandle): LongInt; stdcall;
external ntdll;
function NtSetInformationFile(FileHandle: THandle;
IoStatusBlock: PIoStatusBlock; FileInformation: Pointer;
FileInformationLength: LongWord; FileInformationClass: LongWord):
LongInt; stdcall; external ntdll;
function NtQueryInformationFile(FileHandle: THandle;
IoStatusBlock: PIoStatusBlock; FileInformation: Pointer;
FileInformationLength: LongWord; FileInformationClass: LongWord):
LongInt; stdcall; external ntdll;
function NtReadFile(FileHandle: THandle; Event: THandle; ApcRoutine: Pointer;
ApcContext: Pointer; IoStatusBlock: PIOStatusBlock; Buffer: Pointer;
Length: LongWord; ByteOffset: PLargeInteger; Key: PLongWord): LongInt;
stdcall; external ntdll;
function NtWriteFile(FileHandle: THandle; Event: THandle;
ApcRoutine: Pointer; ApcContext: Pointer; IoStatusBlock: PIOStatusBlock;
Buffer: Pointer; Length: LongWord; ByteOffset: PLargeInteger; Key: PLongWord):
LongInt; stdcall; external ntdll;
function NtWaitForSingleObject(Handle: THandle; Alertable: ByteBool;
Timeout: PLargeInteger): LongInt; stdcall; external ntdll;
function NtDisplayString(aString: PNtUnicodeString): LongInt; stdcall; external ntdll;
{ TODO : move to platform specific file }
function NtCurrentTEB: PSimpleTEB; assembler;
asm
movl %fs:(0x18),%eax
end;
(* from NDKUtils *)
procedure SysInitializeObjectAttributes(var aObjectAttr: TObjectAttributes;
aName: PNtUnicodeString; aAttributes: LongWord; aRootDir: THandle;
aSecurity: Pointer);
begin
with aObjectAttr do begin
Length := SizeOf(TObjectAttributes);
RootDirectory := aRootDir;
Attributes := aAttributes;
ObjectName := aName;
SecurityDescriptor := aSecurity;
SecurityQualityOfService := Nil;
end;
end;
procedure SysPCharToNtStr(var aNtStr: TNtUnicodeString; aText: PChar;
aLen: LongWord);
var
i: Integer;
begin
if (aLen = 0) and (aText <> Nil) and (aText^ <> #0) then
aLen := StrLen(aText);
aNtStr.Length := aLen * SizeOf(WideChar);
aNtStr.MaximumLength := aNtStr.Length;
aNtStr.Buffer := GetMem(aNtStr.Length);
for i := 0 to aLen-1 do
aNtStr.Buffer[i] := aText[i];
end;
procedure SysPWideCharToNtStr(var aNtStr: TNtUnicodeString; aText: PWideChar;
aLen: LongWord);
var
i: Integer;
begin
if (aLen = 0) and (aText <> Nil) and (aText^ <> #0) then
aLen := Length(aText);
aNtStr.Length := aLen * SizeOf(WideChar);
aNtStr.MaximumLength := aNtStr.Length;
aNtStr.Buffer := GetMem(aNtStr.Length);
Move(aText[0],aNtStr.Buffer[0],aLen);
end;
procedure SysUnicodeStringToNtStr(var aNtStr: TNtUnicodeString; const s: UnicodeString);
var
i: Integer;
begin
aNtStr.Length := Length(s) * SizeOf(WideChar);
aNtStr.MaximumLength := aNtStr.Length;
aNtStr.Buffer := GetMem(aNtStr.Length);
if aNtStr.Length<>0 then
Move(s[1],aNtStr.Buffer[0],aNtStr.Length);
end;
procedure SysFreeNtStr(var aNtStr: TNtUnicodeString);
begin
if aNtStr.Buffer <> Nil then begin
FreeMem(aNtStr.Buffer);
aNtStr.Buffer := Nil;
end;
aNtStr.Length := 0;
aNtStr.MaximumLength := 0;
end;
Reference in New Issue View Git Blame Copy Permalink