hardlinks.pas

East make Tray Icon in delphi

    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
  is passed on to ZwOpenFile()!

  The limit of 1023 hardlinks to one file is probably related to the system or
  NTFS respectively. At least I saw no special hint, why there would be such a
  limit - the original CreateHardLink() does not check the number of links!
  Thus I consider the limit being the same for the original and my rewrite.

  For the ANSI version of this function see below ...

 Remarks from the  Platform SDK:
 -------------------------------
  Any directory entry for a file, whether created with CreateFile or
  CreateHardLink, is a hard link to the associated file. Additional hard links,
  created with the CreateHardLink function, allow you to have multiple directory
  entries for a file, that is, multiple hard links to the same file. These may
  be different names in the same directory, or they may be the same (or
  different) names in different directories. However, all hard links to a file
  must be on the same volume.
  Because hard links are just directory entries for a file, whenever an
  application modifies a file through any hard link, all applications using any
  other hard link to the file see the changes. Also, all of the directory
  entries are updated if the file changes. For example, if the file's size
  changes, all of the hard links to the file will show the new size.
  The security descriptor belongs to the file to which the hard link points.
  The link itself, being merely a directory entry, has no security descriptor.
  Thus, if you change the security descriptor of any hard link, you're actually
  changing the underlying file's security descriptor. All hard links that point
  to the file will thus allow the newly specified access. There is no way to
  give a file different security descriptors on a per-hard-link basis.
  This function does not modify the security descriptor of the file to be linked
  to, even if security descriptor information is passed in the
  lpSecurityAttributes parameter.
  Use DeleteFile to delete hard links. You can delete them in any order
  regardless of the order in which they were created.
  Flags, attributes, access, and sharing as specified in CreateFile operate on
  a per-file basis. That is, if you open a file with no sharing allowed, another
  application cannot share the file by creating a new hard link to the file.

  CreateHardLink does not work over the network redirector.

  Note that when you create a hard link on NTFS, the file attribute information
  in the directory entry is refreshed only when the file is opened or when
  GetFileInformationByHandle is called with the handle of the file of interest.

 ******************************************************************************)
function
{$IFNDEF PREFERAPI}
  CreateHardLinkW // This name is directly published if PREFERAPI is not defined
{$ELSE PREFERAPI}
  MyCreateHardLinkW // ... otherwise this one
{$ENDIF PREFERAPI}
  (szLinkName, szLinkTarget: PWideChar; lpSecurityAttributes: PSecurityAttributes): BOOL;
const
// Mask for any DOS style drive path in object manager notation
  wcsC_NtName: PWideChar = '\??\C:';
// Prefix of a mapped path's symbolic link
  wcsLanMan: PWideChar = '\Device\LanmanRedirector\';
// Size required to hold a number of wide characters to compare drive notation
  cbC_NtName = $10; // 16 bytes
// Access mask to use for opening - just two bits
  dwDesiredAccessHL = DELETE or SYNCHRONIZE;
// OpenOptions for opening of the link target
// The flag FILE_OPEN_REPARSE_POINT has been found by comparison. Probably it carries
// some information wether the file is on the same volume?!
  dwOpenOptionsHL = FILE_SYNCHRONOUS_IO_NONALERT or FILE_OPEN_FOR_BACKUP_INTENT or FILE_OPEN_REPARSE_POINT;
// ShareAccess flags
  dwShareAccessHL = FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE;
var
  usNtName_LinkName, usNtName_LinkTarget: UNICODE_STRING;
  usCheckDrive, usSymLinkDrive, usLanMan: UNICODE_STRING;
  wcsNtName_LinkTarget, wcsFilePart_LinkTarget: PWideChar;
  oaMisc: OBJECT_ATTRIBUTES;
  IOStats: IO_STATUS_BLOCK;
  hHeap: Pointer;
  NeededSize: DWORD;
  Status: NTSTATUS;
  hLinkTarget, hDrive: THandle;
  lpFileLinkInfo: PFILE_LINK_INFORMATION;
begin
  Result := False;
{$IFDEF RTDL}
  if not bRtdlFunctionsLoaded then
    Exit;
{$ENDIF RTDL}
  // Get process' heap
  hHeap := NtpGetProcessHeap;
  {-------------------------------------------------------------
  Preliminary parameter checks which do Exit with error code set
  --------------------------------------------------------------}
  // If any is not assigned ...
  if (szLinkName = nil) or (szLinkTarget = nil) then
  begin
    SetLastError(ERROR_INVALID_PARAMETER);
    Exit;
  end;
  // Determine DOS path type for both link name and target
  if (RtlDetermineDosPathNameType_U(szLinkName) = UNC_PATH) or
    (RtlDetermineDosPathNameType_U(szLinkTarget) = UNC_PATH) then
  begin
    SetLastError(ERROR_INVALID_NAME);
    Exit;
  end;
  // Convert the link target into a UNICODE_STRING
  if not RtlDosPathNameToNtPathName_U(szLinkTarget, usNtName_LinkTarget, nil, nil) then
  begin
    SetLastError(ERROR_PATH_NOT_FOUND);
    Exit;
  end;
  {------------------------
  Actual main functionality
  -------------------------}
  // Initialise the length members
  RtlInitUnicodeString(usNtName_LinkTarget, usNtName_LinkTarget.Buffer);
  // Get needed buffer size (in TCHARs)
  NeededSize := GetFullPathNameW(szLinkTarget, 0, nil, PWideChar(nil^));
  if NeededSize <> 0 then
  begin
    // Calculate needed size (in TCHARs)
    NeededSize := NeededSize + 1; // times SizeOf(WideChar)
    // Freed in FINALLY
    wcsNtName_LinkTarget := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, NeededSize * SizeOf(WideChar));
    // If successfully allocated buffer ...
    if wcsNtName_LinkTarget <> nil then
      try
        {----------------------------------------------------
        Preparation of the checking for mapped network drives
        -----------------------------------------------------}
        // Get the full unicode path name
        if GetFullPathNameW(szLinkTarget, NeededSize, wcsNtName_LinkTarget, wcsFilePart_LinkTarget) <> 0 then
        begin
          // Allocate memory to check the drive object
          usCheckDrive.Buffer := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, cbC_NtName);
          // On success ...
          if usCheckDrive.Buffer <> nil then
            try
              // Copy to buffer and set length members
              lstrcpynW(usCheckDrive.Buffer, wcsC_NtName, lstrlenW(wcsC_NtName) + 1);
              RtlInitUnicodeString(usCheckDrive, usCheckDrive.Buffer);
              // Replace drive letter by the drive letter we want
              usCheckDrive.Buffer[4] := wcsNtName_LinkTarget[0];
              // Init OBJECT_ATTRIBUTES
              oaMisc.Length := SizeOf(oaMisc);
              oaMisc.RootDirectory := 0;
              oaMisc.ObjectName := @usCheckDrive;
              oaMisc.Attributes := OBJ_CASE_INSENSITIVE;
              oaMisc.SecurityDescriptor := nil;
              oaMisc.SecurityQualityOfService := nil;
              {--------------------------------------------
              Checking for (illegal!) mapped network drives
              ---------------------------------------------}
              // Open symbolic link object
              if ZwOpenSymbolicLinkObject(hDrive, SYMBOLIC_LINK_QUERY, oaMisc) = STATUS_SUCCESS then
                try
                  usSymLinkDrive.Buffer := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, MAX_PATH * SizeOf(WideChar));
                  if usSymLinkDrive.Buffer <> nil then
                    try
                      // Query the path the symbolic link points to ...
                      ZwQuerySymbolicLinkObject(hDrive, usSymLinkDrive, nil);
                      // Initialise the length members
                      RtlInitUnicodeString(usLanMan, wcsLanMan);
                      // The path must not be a mapped drive ... check this!
                      if not RtlPrefixUnicodeString(usLanMan, usSymLinkDrive, True) then
                      begin
                        // Initialise OBJECT_ATTRIBUTES
                        oaMisc.Length := SizeOf(oaMisc);
                        oaMisc.RootDirectory := 0;
                        oaMisc.ObjectName := @usNtName_LinkTarget;
                        oaMisc.Attributes := OBJ_CASE_INSENSITIVE;
                        // Set security descriptor in OBJECT_ATTRIBUTES if they were given
                        if lpSecurityAttributes <> nil then