hardlinks.pas

East make Tray Icon in delphi

  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
                          oaMisc.SecurityDescriptor := lpSecurityAttributes^.lpSecurityDescriptor
                        else
                          oaMisc.SecurityDescriptor := nil;
                        oaMisc.SecurityQualityOfService := nil;
                        {----------------------
                        Opening the target file
                        -----------------------}
                        Status := ZwOpenFile(hLinkTarget, dwDesiredAccessHL, oaMisc,
                          IOStats, dwShareAccessHL, dwOpenOptionsHL);
                        if Status = STATUS_SUCCESS then
                          try
                            // Wow ... target opened ... let's try to
                            if RtlDosPathNameToNtPathName_U(szLinkName, usNtName_LinkName, nil, nil) then
                              try
                                // Initialise the length members
                                RtlInitUnicodeString(usNtName_LinkName, usNtName_LinkName.Buffer);
                                // Now almost everything is done to create a link!
                                NeededSize := usNtName_LinkName.Length +
                                  SizeOf(FILE_LINK_INFORMATION) + SizeOf(WideChar);
                                lpFileLinkInfo := RtlAllocateHeap(hHeap, HEAP_ZERO_MEMORY, NeededSize);
                                if lpFileLinkInfo <> nil then
                                  try
                                    lpFileLinkInfo^.ReplaceIfExists := False;
                                    lpFileLinkInfo^.RootDirectory := 0;
                                    lpFileLinkInfo^.FileNameLength := usNtName_LinkName.Length;
                                    lstrcpynW(lpFileLinkInfo.FileName, usNtName_LinkName.Buffer,
                                      usNtName_LinkName.Length);
                                    {----------------------------------------------------
                                    Final creation of the link - "center" of the function
                                    -----------------------------------------------------}
                                    // Hard-link the file as intended
                                    Status := ZwSetInformationFile(hLinkTarget, IOStats,
                                      lpFileLinkInfo, NeededSize, FileLinkInformation);
                                    // On success return TRUE
                                    Result := Status >= 0;
                                  finally
                                    // Free the buffer
                                    RtlFreeHeap(hHeap, 0, lpFileLinkInfo);
                                    // Set last error code
                                    SetLastError(RtlNtStatusToDosError(Status));
                                  end
                                else // if lpFileLinkInfo <> nil then
                                  SetLastError(ERROR_NOT_ENOUGH_MEMORY);
                              finally
                                RtlFreeHeap(hHeap, 0, usNtName_LinkName.Buffer);
                              end
                            else // if RtlDosPathNameToNtPathName_U(szLinkName, usNtName_LinkName...
                              SetLastError(ERROR_INVALID_NAME);
                          finally
                            ZwClose(hLinkTarget);
                          end
                        else // if Status = STATUS_SUCCESS then
                          SetLastError(RtlNtStatusToDosError(Status));
                      end
                      else // if not RtlPrefixUnicodeString(usLanMan, usSymLinkDrive, True) then
                        SetLastError(ERROR_INVALID_NAME);
                    finally
                      RtlFreeHeap(hHeap, 0, usSymLinkDrive.Buffer);
                    end
                  else // if usSymLinkDrive.Buffer <> nil then
                    SetLastError(ERROR_NOT_ENOUGH_MEMORY);
                finally
                  ZwClose(hDrive);
                end;
            finally
              RtlFreeHeap(hHeap, 0, usCheckDrive.Buffer);
            end
          else // if usCheckDrive.Buffer <> nil then
            SetLastError(ERROR_NOT_ENOUGH_MEMORY);
        end
        else // if GetFullPathNameW(szLinkTarget, NeededSize, wcsNtName_LinkTarget...
          SetLastError(ERROR_INVALID_NAME);
      finally
        RtlFreeHeap(hHeap, 0, wcsNtName_LinkTarget);
      end
    else // if wcsNtName_LinkTarget <> nil then
      SetLastError(ERROR_NOT_ENOUGH_MEMORY);
  end
  else // if NeededSize <> 0 then
    SetLastError(ERROR_INVALID_NAME);