{**************************************************************************************************} { WARNING: JEDI preprocessor generated unit. Do not edit. } {**************************************************************************************************} {**************************************************************************************************} { } { Project JEDI Code Library (JCL) } { } { The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } { you may not use this file except in compliance with the License. You may obtain a copy of the } { License at http://www.mozilla.org/MPL/ } { } { Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } { ANY KIND, either express or implied. See the License for the specific language governing rights } { and limitations under the License. } { } { The Initial Developer of the Original Code is Oliver Schneider (Assarbad att gmx dott info). } { Portions created by Oliver Schneider are Copyright (C) 1995 - 2004 Oliver Schneider. } { All rights reserved. } { } { Obtained through: } { Joint Endeavour of Delphi Innovators (Project JEDI) } { } { You may retrieve the latest version of the original file at the Original Developer's homepage, } { located at [http://assarbad.net]. Note that the original file can be used with an arbitrary OSI- } { approved license as long as you follow the additional terms given in the original file. } { Additionally a C/C++ (MS VC++) version is available under the same terms. } { } { Contributor(s): } { Oliver Schneider (assarbad) } { Robert Marquardt (marquardt) } { Robert Rossmair (rrossmair) } { } {**************************************************************************************************} { } { Windows NT 4.0 compatible implementation of the CreateHardLink() API introduced in Windows } { 2000. } { } {**************************************************************************************************} // Last modified: $Date: 2005/04/07 01:12:02 $ // For history see end of file unit Hardlinks; {$ALIGN ON} {$MINENUMSIZE 4} interface (* All possible combinations of the above DEFINEs have been tested and work fine. # | A B C ---|--------- 1 | 0 0 0 A = STDCALL 2 | 0 0 X B = RTDL 3 | X 0 0 C = PREFERAPI 4 | X 0 X 5 | X X 0 6 | X X X *) uses Windows; {$EXTERNALSYM CreateHardLinkW} {$EXTERNALSYM CreateHardLinkA} // Well, we did not decide yet ;) - bind to either address, depending on whether // the API could be found. type TFNCreateHardLinkW = function(szLinkName, szLinkTarget: PWideChar; lpSecurityAttributes: PSecurityAttributes): BOOL; stdcall; TFNCreateHardLinkA = function(szLinkName, szLinkTarget: PAnsiChar; lpSecurityAttributes: PSecurityAttributes): BOOL; stdcall; var CreateHardLinkW: TFNCreateHardLinkW = nil; CreateHardLinkA: TFNCreateHardLinkA = nil; var hNtDll: THandle = 0; // For runtime dynamic linking bRtdlFunctionsLoaded: Boolean = False; // To show wether the RTDL functions had been loaded implementation const szNtDll = 'NTDLL.DLL'; // Import native APIs from this DLL szCreateHardLinkA = 'CreateHardLinkA'; szCreateHardLinkW = 'CreateHardLinkW'; (****************************************************************************** Note, I only include function prototypes and constants here which are needed! For other prototypes or constants check out the related books of - Gary Nebbett - Sven B. Schreiber - Rajeev Nagar Note, one my homepage I have also some Native APIs listed in Delphi translated form. Not all of them might be translated correctly with respect to the fact whether or not they are pointer and whether or not the alignment of variables or types is always correct. This might be reviewed by me somewhen in future. ******************************************************************************) // ================================================================= // Type definitions // ================================================================= 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 // ================================================================= 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; 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 MyCreateHardLinkW // ... otherwise this one (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; if not bRtdlFunctionsLoaded then Exit; // 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); // Finally free the buffer RtlFreeHeap(hHeap, 0, usNtName_LinkTarget.Buffer); end; (****************************************************************************** Hint: ----- For all closer information see the CreateHardLinkW function above. Specific to the ANSI-version: ----------------------------- The ANSI-Version can be used as if it was used on Windows 2000. This holds for all supported systems for now. ******************************************************************************) function MyCreateHardLinkA // ... otherwise this one (szLinkName, szLinkTarget: PAnsiChar; lpSecurityAttributes: PSecurityAttributes): BOOL; var usLinkName: UNICODE_STRING; usLinkTarget: UNICODE_STRING; hHeap: Pointer; begin Result := False; if not bRtdlFunctionsLoaded then Exit; // Get the process' heap hHeap := NtpGetProcessHeap; // Create and allocate a UNICODE_STRING from the zero-terminated parameters if RtlCreateUnicodeStringFromAsciiz(usLinkName, szLinkName) then try if RtlCreateUnicodeStringFromAsciiz(usLinkTarget, szLinkTarget) then try // Call the Unicode version Result := CreateHardLinkW(usLinkName.Buffer, usLinkTarget.Buffer, lpSecurityAttributes); finally // free the allocated buffer RtlFreeHeap(hHeap, 0, usLinkTarget.Buffer); end; finally // free the allocate buffer RtlFreeHeap(hHeap, 0, usLinkName.Buffer); end; end; const // Names of the functions to import szRtlCreateUnicodeStringFromAsciiz = 'RtlCreateUnicodeStringFromAsciiz'; szZwClose = 'ZwClose'; szZwSetInformationFile = 'ZwSetInformationFile'; szRtlPrefixUnicodeString = 'RtlPrefixUnicodeString'; szZwOpenSymbolicLinkObject = 'ZwOpenSymbolicLinkObject'; szZwQuerySymbolicLinkObject = 'ZwQuerySymbolicLinkObject'; szZwOpenFile = 'ZwOpenFile'; szRtlAllocateHeap = 'RtlAllocateHeap'; szRtlFreeHeap = 'RtlFreeHeap'; szRtlDosPathNameToNtPathName_U = 'RtlDosPathNameToNtPathName_U'; szRtlInitUnicodeString = 'RtlInitUnicodeString'; szRtlDetermineDosPathNameType_U = 'RtlDetermineDosPathNameType_U'; szRtlNtStatusToDosError = 'RtlNtStatusToDosError'; var hKernel32: THandle = 0; initialization // GetModuleHandle because this DLL is loaded into any Win32 subsystem process anyway // implicitly. And Delphi cannot create applications for other subsystems without // major changes in SysInit und System units. hKernel32 := GetModuleHandle(kernel32); // If we prefer the real Windows APIs try to get their addresses @CreateHardLinkA := GetProcAddress(hKernel32, szCreateHardLinkA); @CreateHardLinkW := GetProcAddress(hKernel32, szCreateHardLinkW); // If they could not be retrieved resort to our home-grown version if not (Assigned(@CreateHardLinkA) and Assigned(@CreateHardLinkW)) then begin // GetModuleHandle because this DLL is loaded into any Win32 subsystem process anyway // implicitly. And Delphi cannot create applications for other subsystems without // major changes in SysInit und System units. hNtDll := GetModuleHandle(szNtDll); if hNtDll <> 0 then begin // Get all the function addresses @RtlCreateUnicodeStringFromAsciiz := GetProcAddress(hNtDll, szRtlCreateUnicodeStringFromAsciiz); @ZwClose := GetProcAddress(hNtDll, szZwClose); @ZwSetInformationFile := GetProcAddress(hNtDll, szZwSetInformationFile); @RtlPrefixUnicodeString := GetProcAddress(hNtDll, szRtlPrefixUnicodeString); @ZwOpenSymbolicLinkObject := GetProcAddress(hNtDll, szZwOpenSymbolicLinkObject); @ZwQuerySymbolicLinkObject := GetProcAddress(hNtDll, szZwQuerySymbolicLinkObject); @ZwOpenFile := GetProcAddress(hNtDll, szZwOpenFile); @RtlAllocateHeap := GetProcAddress(hNtDll, szRtlAllocateHeap); @RtlFreeHeap := GetProcAddress(hNtDll, szRtlFreeHeap); @RtlDosPathNameToNtPathName_U := GetProcAddress(hNtDll, szRtlDosPathNameToNtPathName_U); @RtlInitUnicodeString := GetProcAddress(hNtDll, szRtlInitUnicodeString); @RtlDetermineDosPathNameType_U := GetProcAddress(hNtDll, szRtlDetermineDosPathNameType_U); @RtlNtStatusToDosError := GetProcAddress(hNtDll, szRtlNtStatusToDosError); // Check whether we could retrieve all of them bRtdlFunctionsLoaded := // Update the "loaded" status Assigned(@RtlCreateUnicodeStringFromAsciiz) and Assigned(@ZwClose) and Assigned(@ZwSetInformationFile) and Assigned(@RtlPrefixUnicodeString) and Assigned(@ZwOpenSymbolicLinkObject) and Assigned(@ZwQuerySymbolicLinkObject) and Assigned(@ZwOpenFile) and Assigned(@RtlAllocateHeap) and Assigned(@RtlFreeHeap) and Assigned(@RtlDosPathNameToNtPathName_U) and Assigned(@RtlInitUnicodeString) and Assigned(@RtlDetermineDosPathNameType_U) and Assigned(@RtlNtStatusToDosError); end; @CreateHardLinkA := @MyCreateHardLinkA; @CreateHardLinkW := @MyCreateHardLinkW; end; // if not (Assigned(@CreateHardLinkA) and Assigned(@CreateHardLinkW)) then ... // History: { Version 1.13a - 2005-03-06 + Minor correction in the prototype of RtlDosPathNameToNtPathName_U() to easier pass NIL as the 4th parameter. Version 1.13 - 2005-03-03 + NtMyGetProcessHeap() renamed to NtpGetProcessHeap() + Removed declarations for TEB/PEB/TIB and supplement. As they depend on structures which are unlikely to change, the respective offsets can be hardcoded. As soon as this function becomes OS-version- dependent, adapted offsets will be used. Version 1.12c - 2004-10-26 + Implementation of Robert Marquardts proposals for the sake of brevity in the CreateHardLinkW() implementation - C-like returns + Removal of potential bug in CreateHardLinkA() implementation + Removal of two unused function prototypes + Some more comments and corrections and indentations + Perl script to create "my" version from JCL prototype + Compiles fine on Delphi 4 (minor changes would be necessary for D3) Version 1.12b - 2004-10-26 + Added some constants and replaced literals by them + Removed some superfluous constants and records Version 1.12a - 2004-10-21 + "Original" file renamed according to the change in the JCL prototype Hardlink.pas -> Hardlinks.pas + The original version is now being created using: jpp -c -uJCL -dMSWINDOWS -uUNIX -uHAS_UNIT_LIBC -x..\ Hardlinks.pas + Changes will first occur in this prototype and the output of the preprocessor undefining the "JCL" symbol will be mirrored to my site afterwards. The prototype at the JCL is the reference from now on. Version 1.12 - 2004-10-18 + Code-cleaning (removal of the currently not working softlink stuff from 1.10) + Comments for Project JEDI (JCL) + Some extra declarations to be compatible with JclNTFS + Runtime dynamic linking + Checked into the JCL Version 1.11 - 2004-07-01 + Bugfix from Nico Bendlin - Odd behavior of NtMyGetProcessHeap() ! Version 1.10 - 2004-04-16 [this was taken out again in 1.12] ! + Implemented softlinks for directories (junction points/reparse points) Version 1.01 - 2003-08-25 + Implemented hardlinks } end.