2010. október 11., hétfő

get target of symlink in delphi

For more information and C# code click here!


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.

Nincsenek megjegyzések:

Megjegyzés küldése