📄 hardlinks.pas
字号:
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
{$IFNDEF PREFERAPI}
CreateHardLinkA // This name is directly published if PREFERAPI is not defined
{$ELSE PREFERAPI}
MyCreateHardLinkA // ... otherwise this one
{$ENDIF PREFERAPI}
(szLinkName, szLinkTarget: PAnsiChar; lpSecurityAttributes: PSecurityAttributes): BOOL;
var
usLinkName: UNICODE_STRING;
usLinkTarget: UNICODE_STRING;
hHeap: Pointer;
begin
Result := False;
{$IFDEF RTDL}
if not bRtdlFunctionsLoaded then
Exit;
{$ENDIF RTDL}
// 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;
{$IFDEF RTDL}
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';
{$ENDIF RTDL}
{$IFDEF PREFERAPI}
var
hKernel32: THandle = 0;
{$ENDIF PREFERAPI}
initialization
{$IFDEF PREFERAPI}
// 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
{$ENDIF PREFERAPI}
{$IFDEF RTDL}
// 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;
{$ENDIF RTDL}
{$IFDEF PREFERAPI}
@CreateHardLinkA := @MyCreateHardLinkA;
@CreateHardLinkW := @MyCreateHardLinkW;
end; // if not (Assigned(@CreateHardLinkA) and Assigned(@CreateHardLinkW)) then ...
{$ENDIF PREFERAPI}
// 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.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -