unit Symlink;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
SE_BACKUP_NAME = 'SeBackupPrivilege';
SYMLINK_PATH = 'your symlink path';
FILE_FLAG_BACKUP_SEMANTICS = $02000000;
FILE_FLAG_OPEN_REPARSE_POINT = $00200000;
FILE_DEVICE_FILE_SYSTEM = 9;
FILE_ANY_ACCESS = 0;
FSCTL_GET_REPARSE_POINT = 42;
METHOD_BUFFERED = 0;
MAXIMUM_REPARSE_DATABUFFER_SIZE = 16 * 1024;
IO_REPARSE_TAG_MOUNT_POINT = $A0000003; // Moiunt point or junction, see winnt.h
IO_REPARSE_TAG_SYMLINK = $A000000C;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
_REPARSE_DATA_BUFFER = record
ReparseTag: DWORD;
ReparseDataLength: Word;
Reserved: Word;
SubstituteNameOffset: Word;
SubstituteNamelength: Word;
PrintNameOffset: Word;
PrintNameLength: Word;
pathBuffer: array[0..MAXIMUM_REPARSE_DATABUFFER_SIZE] of CHAR;
end;
TReparseDataBuffer = _REPARSE_DATA_BUFFER;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetSymlinkTarget(aSymlinkPath : String): String;
var
lSuccess : Boolean;
lToken : THandle;
lTokenPrivileges : TOKEN_PRIVILEGES;
lRLength : Cardinal;
secAttr: TSecurityAttributes;
lFileHandle : THandle;
lControlCode: Cardinal;
lBytesReturned : Cardinal;
lReparseBuffer : TReparseDataBuffer;
iCounter : Integer;
lTargetPath : String;
begin
Result := aSymlinkPath;
lTargetPath := emptyStr;
//not in all cases, we need to have backup privileges
lSuccess := OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES, lToken);
if lSuccess
then
begin
lSuccess:= LookupPrivilegeValue(nil,PWideChar(SE_BACKUP_NAME),lTokenPrivileges.Privileges[0].Luid);
if lSuccess then
begin
lTokenPrivileges.PrivilegeCount := 1;
lTokenPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
lSuccess := AdjustTokenPrivileges(lToken,false, lTokenPrivileges, sizeOf(lTokenPrivileges),nil,lRlength);
end;
CloseHandle(lToken);
if(lSuccess) then
begin
FillChar(secAttr,sizeOf(secAttr),#0);
secAttr.nLength := sizeof(secAttr);
secAttr.lpSecurityDescriptor := nil;
secAttr.bInheritHandle := True;
// Open the file and get its handle
lFileHandle := CreateFile(PWideChar(aSymlinkPath), GENERIC_READ, FILE_SHARE_READ, @secAttr, OPEN_ALWAYS, FILE_FLAG_OPEN_REPARSE_POINT or FILE_FLAG_BACKUP_SEMANTICS, 0);
if lFileHandle <> 0 then
begin
ShowMessage('File is opened ' + SysErrorMessage(GetLastError));
// Make up the control code - see CTL_CODE on ntddk.h
lControlCode := (FILE_DEVICE_FILE_SYSTEM shl 16) or (FILE_ANY_ACCESS shl 12) or (FSCTL_GET_REPARSE_POINT shl 2) or METHOD_BUFFERED;
lSuccess := DeviceIOControl(lFileHandle,lControlCode,nil,0,@lReparseBuffer, MAXIMUM_REPARSE_DATABUFFER_SIZE, lBytesReturned, nil);
ShowMessage('DeviceIOControl ' + BoolToSTR(lSuccess) + ' ' + SysErrorMessage(GetLastError));
if lSuccess then
if (lReparseBuffer.ReparseTag = IO_REPARSE_TAG_SYMLINK) then
begin
for iCounter := 0 to (lReparseBuffer.PrintNameLength div 2) - 1 do
begin
// for some reason symlinks seem to have an extra two characters on the front
lTargetPath := lTargetPath + lReparseBuffer.pathBuffer[(lReparseBuffer.PrintNameOffset div 2) + 2 + iCounter];
end;
Result := lTargetPath;
end;
end;
CloseHandle(lFileHandle);
end;
end
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetSymlinkTarget(SYMLINK_PATH));
end;
end.
