hardlinks.pas

East make Tray Icon in delphi

type
  NTSTATUS = Longint;
  PPWideChar = ^PWideChar;

type
  LARGE_INTEGER = TLargeInteger;
  PLARGE_INTEGER = ^LARGE_INTEGER;

type
  UNICODE_STRING = record
    Length: WORD;
    MaximumLength: WORD;
    Buffer: PWideChar;
  end;
  PUNICODE_STRING = ^UNICODE_STRING;

type
  ANSI_STRING = record
    Length: WORD;
    MaximumLength: WORD;
    Buffer: PAnsiChar;
  end;
  PANSI_STRING = ^ANSI_STRING;

type
  OBJECT_ATTRIBUTES = record
    Length: ULONG;
    RootDirectory: THandle;
    ObjectName: PUNICODE_STRING;
    Attributes: ULONG;
    SecurityDescriptor: Pointer;       // Points to type SECURITY_DESCRIPTOR
    SecurityQualityOfService: Pointer; // Points to type SECURITY_QUALITY_OF_SERVICE
  end;
  POBJECT_ATTRIBUTES = ^OBJECT_ATTRIBUTES;

type
  IO_STATUS_BLOCK = record
    case integer of
      0:
       (Status: NTSTATUS);
      1:
       (Pointer: Pointer;
        Information: ULONG); // 'Information' does not belong to the union!
  end;
  PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;

type
  _FILE_LINK_RENAME_INFORMATION = record // File Information Classes 10 and 11
    ReplaceIfExists: BOOL;
    RootDirectory: THandle;
    FileNameLength: ULONG;
    FileName: array[0..0] of WideChar;
  end;
  FILE_LINK_INFORMATION = _FILE_LINK_RENAME_INFORMATION;
  PFILE_LINK_INFORMATION = ^FILE_LINK_INFORMATION;
  FILE_RENAME_INFORMATION = _FILE_LINK_RENAME_INFORMATION;
  PFILE_RENAME_INFORMATION = ^FILE_RENAME_INFORMATION;

// =================================================================
// Constants
// =================================================================
const
  FileLinkInformation          = 11;
  FILE_SYNCHRONOUS_IO_NONALERT = $00000020; // All operations on the file are
                                            // performed synchronously. Waits
                                            // in the system to synchronize I/O
                                            // queuing and completion are not
                                            // subject to alerts. This flag
                                            // also causes the I/O system to
                                            // maintain the file position context.
                                            // If this flag is set, the
                                            // DesiredAccess SYNCHRONIZE flag also
                                            // must be set.
  FILE_OPEN_FOR_BACKUP_INTENT  = $00004000; // The file is being opened for backup
                                            // intent, hence, the system should
                                            // check for certain access rights
                                            // and grant the caller the appropriate
                                            // accesses to the file before checking
                                            // the input DesiredAccess against the
                                            // file's security descriptor.
  FILE_OPEN_REPARSE_POINT      = $00200000;
  DELETE                       = $00010000;
  SYNCHRONIZE                  = $00100000;
  STATUS_SUCCESS               = NTSTATUS(0);
  OBJ_CASE_INSENSITIVE         = $00000040;
  SYMBOLIC_LINK_QUERY          = $00000001;

  // Should be defined, but isn't
  HEAP_ZERO_MEMORY             = $00000008;

  // Related constant(s) for RtlDetermineDosPathNameType_U()
  INVALID_PATH                 = 0;
  UNC_PATH                     = 1;
  ABSOLUTE_DRIVE_PATH          = 2;
  RELATIVE_DRIVE_PATH          = 3;
  ABSOLUTE_PATH                = 4;
  RELATIVE_PATH                = 5;
  DEVICE_PATH                  = 6;
  UNC_DOT_PATH                 = 7;

// =================================================================
// Function prototypes
// =================================================================

{$IFNDEF RTDL}
function RtlCreateUnicodeStringFromAsciiz(var destination: UNICODE_STRING;
  source: PChar): Boolean; stdcall; external szNtDll;

function ZwClose(Handle: THandle): NTSTATUS; stdcall; external szNtDll;

function ZwSetInformationFile(FileHandle: THandle; var IoStatusBlock: IO_STATUS_BLOCK;
  FileInformation: Pointer; FileInformationLength: ULONG;
  FileInformationClass: DWORD): NTSTATUS; stdcall; external szNtDll;

function RtlPrefixUnicodeString(const usPrefix: UNICODE_STRING;
  const usContainingString: UNICODE_STRING;
  ignore_case: Boolean): Boolean; stdcall; external szNtDll;

function ZwOpenSymbolicLinkObject(var LinkHandle: THandle; DesiredAccess: DWORD;
  const ObjectAttributes: OBJECT_ATTRIBUTES): NTSTATUS; stdcall; external szNtDll;

function ZwQuerySymbolicLinkObject(LinkHandle: THandle;
  var LinkTarget: UNICODE_STRING; ReturnedLength: PULONG): NTSTATUS; stdcall; external szNtDll;

function ZwOpenFile(var FileHandle: THandle; DesiredAccess: DWORD;
  const ObjectAttributes: OBJECT_ATTRIBUTES; var IoStatusBlock: IO_STATUS_BLOCK;
  ShareAccess: ULONG; OpenOptions: ULONG): NTSTATUS; stdcall; external szNtDll;

function RtlAllocateHeap(HeapHandle: Pointer;
  Flags, Size: ULONG): Pointer; stdcall; external szNtDll;

function RtlFreeHeap(HeapHandle: Pointer; Flags: ULONG;
  MemoryPointer: Pointer): Boolean; stdcall; external szNtDll;

function RtlDosPathNameToNtPathName_U(DosName: PWideChar;
  var NtName: UNICODE_STRING; DosFilePath: PPWideChar;
  NtFilePath: PUNICODE_STRING): Boolean; stdcall; external szNtDll;

function RtlInitUnicodeString(var DestinationString: UNICODE_STRING;
  const SourceString: PWideChar): NTSTATUS; stdcall; external szNtDll;

function RtlDetermineDosPathNameType_U(wcsPathNameType: PWideChar): DWORD; stdcall; external szNtDll;

function RtlNtStatusToDosError(status: NTSTATUS): ULONG; stdcall; external szNtDll;

{$ELSE RTDL}

type
  TRtlCreateUnicodeStringFromAsciiz = function(var destination: UNICODE_STRING;
    source: PChar): Boolean; stdcall;

  TZwClose = function(Handle: THandle): NTSTATUS; stdcall;

  TZwSetInformationFile = function(FileHandle: THandle;
    var IoStatusBlock: IO_STATUS_BLOCK; FileInformation: Pointer;
    FileInformationLength: ULONG; FileInformationClass: DWORD): NTSTATUS; stdcall;

  TRtlPrefixUnicodeString = function(const usPrefix: UNICODE_STRING;
    const usContainingString: UNICODE_STRING; ignore_case: Boolean): Boolean; stdcall;

  TZwOpenSymbolicLinkObject = function(var LinkHandle: THandle;
    DesiredAccess: DWORD; const ObjectAttributes: OBJECT_ATTRIBUTES): NTSTATUS; stdcall;

  TZwQuerySymbolicLinkObject = function(LinkHandle: THandle;
    var LinkTarget: UNICODE_STRING; ReturnedLength: PULONG): NTSTATUS; stdcall;

  TZwOpenFile = function(var FileHandle: THandle; DesiredAccess: DWORD;
    const ObjectAttributes: OBJECT_ATTRIBUTES; var IoStatusBlock: IO_STATUS_BLOCK;
    ShareAccess: ULONG; OpenOptions: ULONG): NTSTATUS; stdcall;

  TRtlAllocateHeap = function(HeapHandle: Pointer; Flags, Size: ULONG): Pointer; stdcall;

  TRtlFreeHeap = function(HeapHandle: Pointer; Flags: ULONG;
    MemoryPointer: Pointer): Boolean; stdcall;

  TRtlDosPathNameToNtPathName_U = function(DosName: PWideChar;
    var NtName: UNICODE_STRING; DosFilePath: PPWideChar;
    NtFilePath: PUNICODE_STRING): Boolean; stdcall;

  TRtlInitUnicodeString = function(var DestinationString: UNICODE_STRING;
    const SourceString: PWideChar): NTSTATUS; stdcall;

  TRtlDetermineDosPathNameType_U = function(wcsPathNameType: PWideChar): DWORD; stdcall;

  TRtlNtStatusToDosError = function(status: NTSTATUS): ULONG; stdcall;

// Declare all the _global_ function pointers for RTDL
var
  RtlCreateUnicodeStringFromAsciiz: TRtlCreateUnicodeStringFromAsciiz = nil;
  ZwClose: TZwClose = nil;
  ZwSetInformationFile: TZwSetInformationFile = nil;
  RtlPrefixUnicodeString: TRtlPrefixUnicodeString = nil;
  ZwOpenSymbolicLinkObject: TZwOpenSymbolicLinkObject = nil;
  ZwQuerySymbolicLinkObject: TZwQuerySymbolicLinkObject = nil;
  ZwOpenFile: TZwOpenFile = nil;
  RtlAllocateHeap: TRtlAllocateHeap = nil;
  RtlFreeHeap: TRtlFreeHeap = nil;
  RtlDosPathNameToNtPathName_U: TRtlDosPathNameToNtPathName_U = nil;
  RtlInitUnicodeString: TRtlInitUnicodeString = nil;
  RtlDetermineDosPathNameType_U: TRtlDetermineDosPathNameType_U = nil;
  RtlNtStatusToDosError: TRtlNtStatusToDosError = nil;
{$ENDIF RTDL}


function NtpGetProcessHeap: Pointer; assembler;
asm
  // The structure offsets are now hardcoded to be able to remove otherwise
  // obsolete structure definitions.
//MOV    EAX, FS:[0]._TEB.Peb
  MOV    EAX, FS:$30    // FS points to TEB/TIB which has a pointer to the PEB
//MOV    EAX, [EAX]._PEB.ProcessHeap
  MOV    EAX, [EAX+$18] // Get the process heap's handle
(*
An alternative way to achieve exactly the same (at least in usermode) as above:
  MOV    EAX, FS:$18
  MOV    EAX, [EAX+$30]
  MOV    EAX, [EAX+$18]
*)
end;

(******************************************************************************

 Syntax:
 -------
  C-Prototype! (if STDCALL enabled)

  BOOL WINAPI CreateHardLink(
    LPCTSTR lpFileName,
    LPCTSTR lpExistingFileName,
    LPSECURITY_ATTRIBUTES lpSecurityAttributes // Reserved; Must be NULL!

 Compatibility:
 --------------
  The function can only work on file systems that support hardlinks through the
  underlying FS driver layer. Currently this only includes NTFS on the NT
  platform (as far as I know).
  The function works fine on Windows NT4/2000/XP and is considered to work on
  future Operating System versions derived from NT (including Windows 2003).

 Remarks:
 --------
  This function tries to resemble the original CreateHardLinkW() call from
  Windows 2000/XP/2003 Kernel32.DLL as close as possible. This is why many
  functions used are NT Native API, whereas one could use Delphi or Win32 API
  functions (e.g. memory management). BUT I included much more SEH code and
  omitted extra code to free buffers and close handles. This all is done during
  the FINALLY block (so there are no memory leaks anyway ;).

  Note, that neither Microsoft's code nor mine ignore the Security Descriptor
  from the SECURITY_ATTRIBUTES structure. In both cases the security descriptor