Создание hardlink и symbolic link
01.01.2007
{ **** UBPFD *********** by kladovka.net.ru ****
>> Создание hardlink и symbolic link.
Исходный код утилиты, которая создает hard и symbolic links почти как в unix.
Hardlink можно создать только для файлов и только на NTFS.
Symbolic link можно создать только для директориев и только на
NTFS5 (Win2K/XP) и он не может указывать на сетевой ресурс.
Зависимости: Windows, SysUtils
Автор: Alex Konshin, akonshin@earthlink.net, Boston, USA
Copyright: http://home.earthlink.net/~akonshin/files/xlink.zip
Дата: 30 декабря 2002 г.
********************************************** }
program xlink;
uses
Windows, SysUtils;
{$APPTYPE CONSOLE}
{$R xlink.res}
type
TOptions = set of (optSymbolicLink,optOverwrite,optRecursive,optDirectory);
int64rec = packed record
lo: LongWord;
hi: LongInt;
end;
const
FILE_DOES_NOT_EXIST = DWORD(-1);
//=============================================================
function isFileExists( const AFileName: String ): Boolean;
var
h: THandle;
rFindData: TWin32FindData;
begin
h := Windows.FindFirstFile( PChar(AFileName), rFindData );
Result := h<>INVALID_HANDLE_VALUE;
if not Result then Exit;
Windows.FindClose(h);
Result := ( rFindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY ) = 0;
end;
//-------------------------------------------------------------
// warning: function assumes that it is correct directory name
function isDirectoryEmpty( const ADirectoryName: String ): Boolean;
var
h: THandle;
len : Integer;
rFindData: TWin32FindData;
sSeachMask : String;
begin
len := Length(ADirectoryName);
if (PChar(ADirectoryName)+len-1)^='\' then sSeachMask := ADirectoryName+'*'
else sSeachMask := ADirectoryName+'\*';
h := Windows.FindFirstFile( PChar(sSeachMask), rFindData );
Result := (h=INVALID_HANDLE_VALUE);
Windows.FindClose(h);
end;
//-------------------------------------------------------------
function SysErrorMessage( ErrorCode: Integer ): string;
var
Len: Integer;
Buffer: Array[0..255] of Char;
begin
Len := FormatMessage(
FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
nil, ErrorCode, 0, Buffer, SizeOf(Buffer), nil );
while (Len>0) and (Buffer[Len-1] in [#0..#32, '.']) do Dec(Len);
SetString( Result, Buffer, Len );
end;
//-------------------------------------------------------------
procedure _CreateHardlink( AFileName : String; AFileWCName : PWideChar; ALinkName: String; overwrite: Boolean );
var
aLinkWCFileName, aLinkFullName: Array[0..MAX_PATH] of WChar;
pwFilePart: LPWSTR;
hFileSource: THandle;
rStreamId: WIN32_STREAM_ID;
cbPathLen, dwStreamHeaderSize, dwBytesWritten: DWORD;
lpContext: Pointer;
begin
StringToWidechar( ALinkName, aLinkWCFileName, MAX_PATH );
hFileSource :=
Windows.CreateFile(
PChar(AFileName),
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
nil,
OPEN_EXISTING,
0,
0
);
if hFileSource=INVALID_HANDLE_VALUE then
raise Exception.Create('Cannot open file "'+AFileName+'"');
try
cbPathLen := Windows.GetFullPathNameW( aLinkWCFileName, MAX_PATH,
aLinkFullName, pwFilePart );
if cbPathLen<=0 then
raise Exception.Create('Invalid link name "'+ALinkName+'"');
cbPathLen := (cbPathLen+1)*SizeOf(WChar);
lpContext := nil;
rStreamId.dwStreamId := BACKUP_LINK;
rStreamId.dwStreamAttributes := 0;
rStreamId.dwStreamNameSize := 0;
int64rec(rStreamId.Size).hi := 0;
int64rec(rStreamId.Size).lo := cbPathLen;
dwStreamHeaderSize := PChar(@rStreamId.cStreamName)-PChar(@rStreamId)
+LongInt(rStreamId.dwStreamNameSize);
if not BackupWrite(
hFileSource,
Pointer(@rStreamId), // buffer to write
dwStreamHeaderSize, // number of bytes to write
dwBytesWritten,
False, // don't abort yet
False, // don't process security
lpContext
) then RaiseLastOSError;
if not BackupWrite(
hFileSource,
Pointer(@aLinkFullName), // buffer to write
cbPathLen, // number of bytes to write
dwBytesWritten,
False, // don't abort yet
False, // don't process security
lpContext
) then RaiseLastOSError;
// free context
if not BackupWrite(
hFileSource,
nil, // buffer to write
0, // number of bytes to write
dwBytesWritten,
True, // abort
False, // don't process security
lpContext
) then RaiseLastOSError;
finally
CloseHandle(hFileSource);
end;
end;
//-------------------------------------------------------------
// ADirName and ADirForLinks must not end with backslach
procedure _CreateHardlinksForSubDirectory( const ADirName, ADirForLinks: String; options: TOptions );
var
h: THandle;
sExistedFile, sLinkName : String;
dwAttributes : DWORD;
rFindData: TWin32FindData;
awcFileName : Array[0..MAX_PATH] of WChar;
begin
dwAttributes := GetFileAttributes( PChar(ADirForLinks) );
if dwAttributes=FILE_DOES_NOT_EXIST then
begin
// WriteLn('Create Directory ',ADirForLinks);
if not CreateDir(ADirForLinks) then
raise Exception.Create('Cannot create directory "'+ADirForLinks+'".');
end
else if (dwAttributes and FILE_ATTRIBUTE_DIRECTORY)=0 then
raise Exception.Create('File "'+ADirName
+'" already exists and it is not a directory.');
h := Windows.FindFirstFile( PChar(ADirName+'\*'), rFindData );
if h=INVALID_HANDLE_VALUE then Exit;
try
repeat
if (rFindData.cFileName[0]='.') and
( (rFindData.cFileName[1]=#0) or ((rFindData.cFileName[1]='.') and
(rFindData.cFileName[2]=#0))) then Continue;
sExistedFile := ADirName+'\'+rFindData.cFileName;
sLinkName := ADirForLinks+'\'+rFindData.cFileName;
if (rFindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)=0 then
begin
awcFileName[
Windows.MultiByteToWideChar( 0, 0, PChar(sExistedFile),
MAX_PATH,awcFileName,MAX_PATH)
] := #0;
_CreateHardlink( sExistedFile, awcFileName, sLinkName,
optOverwrite in options );
end
else if optRecursive in options then
begin
_CreateHardlinksForSubDirectory(sExistedFile,sLinkName,options);
end;
until not Windows.FindNextFile(h,rFindData);
finally
Windows.FindClose(h);
end;
end;
//-------------------------------------------------------------
procedure CreateHardlink( AFileName, ALinkName: String; options: TOptions );
var
dwAttributes: DWORD;
aFileSource : Array[0..MAX_PATH] of WChar;
begin
dwAttributes := Windows.GetFileAttributes(PChar(AFileName));
if dwAttributes=FILE_DOES_NOT_EXIST then
raise Exception.Create('File "'+AFileName+'" does not exist.');
if (dwAttributes and FILE_ATTRIBUTE_DIRECTORY)<>0 then
raise Exception.Create('Cannot create hardlink for directory (file "'
+AFileName+'").');
dwAttributes := Windows.GetFileAttributes(PChar(ALinkName));
if dwAttributes<>FILE_DOES_NOT_EXIST then
begin
if not(optOverwrite in options) then
raise Exception.Create('File "'+ALinkName+'" already exists.');
if (dwAttributes and FILE_ATTRIBUTE_DIRECTORY)<>0 then
raise Exception.Create('Cannot overwrite directory "'+AFileName+'".');
end;
StringToWidechar( AFileName, aFileSource, MAX_PATH );
_CreateHardlink( AFileName, aFileSource, ALinkName, optOverwrite in options );
end;
//-------------------------------------------------------------
procedure CreateHardlinksForDirectory( const ADirName, ADirForLinks: String; options: TOptions );
var
dwAttributes: DWORD;
len : Integer;
sDirName, sDirForLinks : String;
begin
dwAttributes := Windows.GetFileAttributes(PChar(ADirName));
if dwAttributes=FILE_DOES_NOT_EXIST then
raise Exception.Create('Directory "'+ADirName+'" does not exist.');
if (dwAttributes and FILE_ATTRIBUTE_DIRECTORY)=0 then
raise Exception.Create('File "'+ADirName+'" is not a directory.');
len := Length(ADirName);
if (PChar(ADirName)+len-1)^='\' then
sDirName := Copy(ADirName,1,len-1)
else
sDirName := ADirName;
if (PChar(ADirForLinks)+Length(ADirForLinks)-1)^<>'\' then
sDirForLinks := ADirForLinks
else
sDirForLinks := Copy(ADirForLinks,1,Length(ADirForLinks)-1);
_CreateHardlinksForSubDirectory(sDirName,sDirForLinks,options);
end;
//-------------------------------------------------------------
procedure CreateHardlinksInDirectory( const AFileName, ADirForLinks: String; options: TOptions );
var
dwAttributes: DWORD;
len : Integer;
sFileName, sDirForLinks, sLinkName : String;
aFileSource : Array[0..MAX_PATH] of WChar;
begin
dwAttributes := Windows.GetFileAttributes(PChar(AFileName));
if dwAttributes=FILE_DOES_NOT_EXIST then
raise Exception.Create('File or directory "'+AFileName+'" does not exist.');
if (dwAttributes and FILE_ATTRIBUTE_DIRECTORY)=0 then
begin
sLinkName := ADirForLinks+'\'+SysUtils.ExpandFileName(AFileName);
dwAttributes := Windows.GetFileAttributes(PChar(sLinkName));
if dwAttributes<>FILE_DOES_NOT_EXIST then
begin
if not(optOverwrite in options) then
raise Exception.Create('File "'+sLinkName+'" already exists.');
if (dwAttributes and FILE_ATTRIBUTE_DIRECTORY)<>0 then
raise Exception.Create('Cannot overwrite directory "'+AFileName+'".');
end;
StringToWidechar( AFileName, aFileSource, MAX_PATH );
_CreateHardlink( AFileName, aFileSource, sLinkName,
optOverwrite in options );
end
else
begin
len := Length(AFileName);
if (PChar(AFileName)+len-1)^='\' then
sFileName := Copy(AFileName,1,len-1)
else
sFileName := AFileName;
if (PChar(ADirForLinks)+Length(ADirForLinks)-1)^<>'\' then
sDirForLinks := ADirForLinks
else
sDirForLinks := Copy(ADirForLinks,1,Length(ADirForLinks)-1);
_CreateHardlinksForSubDirectory(sFileName,sDirForLinks,options);
end;
end;
//-------------------------------------------------------------
procedure DeleteDirectoryContent( const ADirName: String );
type
PDirRef = ^TDirRef;
PPDirRef = ^PDirRef;
TDirRef = record
Next : PDirRef;
DirName : String;
end;
var
h: THandle;
sFileName : String;
pSubDirs : PDirRef;
ppLast : PPDirRef;
pDir : PDirRef;
rFindData: TWin32FindData;
begin
pSubDirs := nil;
ppLast := @pSubDirs;
h := Windows.FindFirstFile( PChar(ADirName+'\*'), rFindData );
if h=INVALID_HANDLE_VALUE then Exit;
try
try
repeat
if (rFindData.cFileName[0]='.') and
( (rFindData.cFileName[1]=#0) or ((rFindData.cFileName[1]='.') and
(rFindData.cFileName[2]=#0))) then Continue;
sFileName := ADirName+'\'+rFindData.cFileName;
if (rFindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)<>0 then
begin
New(pDir);
with pDir^ do
begin
Next := nil;
DirName := sFileName;
end;
ppLast^ := pDir;
ppLast := @pDir^.Next;
end
else if not DeleteFile(sFileName) then
raise Exception.Create('Cannot delete file "'+sFileName+'".');
until not Windows.FindNextFile(h,rFindData);
finally
Windows.FindClose(h);
end;
if pSubDirs<>nil then
begin
repeat
pDir := pSubDirs;
pSubDirs := pDir^.Next;
sFileName := pDir^.DirName;
Dispose(pDir);
DeleteDirectoryContent(sFileName);
if not RemoveDir(sFileName) then
raise Exception.Create('Cannot delete directory "'+sFileName+'".');
until pSubDirs=nil;
end;
except
while pSubDirs<>nil do
begin
pDir := pSubDirs;
pSubDirs := pDir^.Next;
Dispose(pDir);
end;
raise;
end;
end;
//-------------------------------------------------------------
const
FILE_DEVICE_FILE_SYSTEM = $0009;
// Define the method codes for how buffers are passed for I/O and FS controls
METHOD_BUFFERED = 0;
METHOD_IN_DIRECT = 1;
METHOD_OUT_DIRECT = 2;
METHOD_NEITHER = 3;
// Define the access check value for any access
FILE_ANY_ACCESS = 0;
FILE_READ_DATA = 1;
FILE_WRITE_DATA = 2;
FSCTL_SET_REPARSE_POINT = (FILE_DEVICE_FILE_SYSTEM shl 16) or
(FILE_ANY_ACCESS shl 14) or (41 shl 2) or (METHOD_BUFFERED);
FSCTL_GET_REPARSE_POINT = (FILE_DEVICE_FILE_SYSTEM shl 16) or
(FILE_ANY_ACCESS shl 14) or (42 shl 2) or (METHOD_BUFFERED);
FSCTL_DELETE_REPARSE_POINT = (FILE_DEVICE_FILE_SYSTEM shl 16) or
(FILE_ANY_ACCESS shl 14) or (43 shl 2) or (METHOD_BUFFERED);
FILE_FLAG_OPEN_REPARSE_POINT = $00200000;
FILE_ATTRIBUTE_REPARSE_POINT = $00000400;
IO_REPARSE_TAG_MOUNT_POINT = $A0000003;
REPARSE_MOUNTPOINT_HEADER_SIZE = 8;
type
REPARSE_MOUNTPOINT_DATA_BUFFER = packed record
ReparseTag : DWORD;
ReparseDataLength : DWORD;
Reserved : Word;
ReparseTargetLength : Word;
ReparseTargetMaximumLength : Word;
Reserved1 : Word;
ReparseTarget : Array [0..0] of WChar;
end;
TReparseMountpointDataBuffer = REPARSE_MOUNTPOINT_DATA_BUFFER;
PReparseMountpointDataBuffer = ^TReparseMountpointDataBuffer;
//-------------------------------------------------------------
function CreateSymlink( ATargetName, ALinkName: String; const options: TOptions ): Boolean;
const
pwcNativeFileNamePrefix : PWideChar = '\??\';
nNativeFileNamePrefixWCharLength = 4;
nNativeFileNamePrefixByteLength = nNativeFileNamePrefixWCharLength*2;
var
hLink : THandle;
pReparseInfo : PReparseMountpointDataBuffer;
len, size : Integer;
pwcLinkFileName : PWideChar;
pwcTargetNativeFileName : PWideChar;
pwcTargetFileName : PWideChar;
pwc : PWideChar;
pc : PChar;
dwBytesReturned : DWORD;
dwAttributes : DWORD;
bDirectoryCreated : Boolean;
aTargetFullName : Array [0..MAX_PATH] of Char;
begin
Result := False;
pReparseInfo := nil;
hLink := INVALID_HANDLE_VALUE;
bDirectoryCreated := False;
len := Length(ALinkName);
if ((PChar(ALinkName)+len-1)^='\') and ((PChar(ALinkName)+len-2)^<>':') then
begin
Dec(len);
SetLength(ALinkName,len);
end;
System.GetMem( pwcLinkFileName, len+len+2 );
try
pwcLinkFileName[
Windows.MultiByteToWideChar(0,0,PChar(ALinkName),len,wcLinkFileName,len)
] := #0;
dwAttributes := Windows.getFileAttributesW( pwcLinkFileName );
if dwAttributes<>FILE_DOES_NOT_EXIST then
begin
if not(optOverwrite in options) then
begin
if (dwAttributes and FILE_ATTRIBUTE_DIRECTORY)=0 then
raise Exception.Create('The file "'+ALinkName+'" already exists');
if not isDirectoryEmpty(ALinkName) then
raise Exception.Create(
'The directory "'+ALinkName+'" already exists and is not empty');
dwAttributes := FILE_DOES_NOT_EXIST;
end
else if ((dwAttributes and FILE_ATTRIBUTE_DIRECTORY)=0) then
begin
if not DeleteFile(ALinkName) then
raise Exception.Create('Cannot overwrite file "'+ALinkName+'"');
dwAttributes := FILE_DOES_NOT_EXIST;
end
else if (dwAttributes and FILE_ATTRIBUTE_REPARSE_POINT)
<>FILE_ATTRIBUTE_REPARSE_POINT then
if not isDirectoryEmpty(ALinkName) then
begin
if not(optDirectory in options) then
raise Exception.Create('Cannot overwrite non-empty directory "'
+ALinkName+'"');
DeleteDirectoryContent(ALinkName);
end;
end;
if dwAttributes=FILE_DOES_NOT_EXIST then
begin
Windows.CreateDirectoryW( pwcLinkFileName, nil );
bDirectoryCreated := True;
end;
try
hLink := Windows.CreateFileW( pwcLinkFileName, GENERIC_WRITE, 0, nil,
OPEN_EXISTING,
FILE_FLAG_OPEN_REPARSE_POINT or FILE_FLAG_BACKUP_SEMANTICS, 0 );
if hLink=INVALID_HANDLE_VALUE then RaiseLastOSError;
len := Length(ATargetName);
if ((PChar(ATargetName)+len-1)^='\')
and ((PChar(ATargetName)+len-2)^<>':') then
begin
Dec(len);
SetLength(ATargetName,len);
end;
len := Windows.GetFullPathName( PChar(ATargetName), MAX_PATH,
aTargetFullName, pc );
size := len+len+2
+nNativeFileNamePrefixByteLength+REPARSE_MOUNTPOINT_HEADER_SIZE+12;
System.GetMem( pReparseInfo, size );
FillChar( pReparseInfo^, size, #0 );
pwcTargetNativeFileName := @pReparseInfo^.ReparseTarget;
System.Move( pwcNativeFileNamePrefix^, pwcTargetNativeFileName^,
nNativeFileNamePrefixByteLength+2 );
pwcTargetFileName := pwcTargetNativeFileName +
nNativeFileNamePrefixWCharLength;
pwc := pwcTargetFileName + Windows.MultiByteToWideChar(0,0,
aTargetFullName, len, pwcTargetFileName,len);
pwc^ := #0;
with pReparseInfo^ do
begin
ReparseTag := IO_REPARSE_TAG_MOUNT_POINT;
ReparseTargetLength := PChar(pwc)-PChar(pwcTargetNativeFileName);
ReparseTargetMaximumLength := ReparseTargetLength+2;
ReparseDataLength := ReparseTargetLength + 12;
end;
dwBytesReturned := 0;
if not DeviceIoControl( hLink, FSCTL_SET_REPARSE_POINT, pReparseInfo,
pReparseInfo^.ReparseDataLength + REPARSE_MOUNTPOINT_HEADER_SIZE,
nil, 0, dwBytesReturned, nil ) then RaiseLastOSError;
except
if bDirectoryCreated then RemoveDirectoryW( pwcLinkFileName );
raise;
end;
Result := true;
finally
if hLink<>INVALID_HANDLE_VALUE then Windows.CloseHandle(hLink);
if pwcLinkFileName<>nil then System.FreeMem(pwcLinkFileName);
if pReparseInfo<>nil then System.FreeMem(pReparseInfo);
end;
end;
//-------------------------------------------------------------
procedure Help;
begin
WriteLn;
WriteLn('Create link(s) on NTFS.');
WriteLn;
WriteLn('Usage:');
WriteLn;
WriteLn('To create hardlink(s) (works only for files):');
WriteLn('xlink [-fr] <existed_file> <link_name>');
WriteLn;
WriteLn('To create symbolic link (works on Windows 2k/XP for directories only):');
WriteLn('xlink -s[f|F] <existed_directory> <link_name>');
WriteLn;
WriteLn('Options:');
WriteLn('-f Overwrite file with name <link_name> if it exists.');
WriteLn('-F Overwrite file/directory with name <link_name> if it exists.');
WriteLn('-r Recursive.');
WriteLn;
WriteLn('(c) 2002 Alex Konshin');
Halt;
end;
//-------------------------------------------------------------
procedure Execute;
var
iArg : Integer;
sArg : String;
ptr : PChar;
options : TOptions;
sExistedFileName : String;
sLink : String;
dwAttrs : DWORD;
begin
iArg := 1;
repeat
sArg := ParamStr(iArg);
if sArg='' then Help; if PChar(sArg)^<>'-' then Break;
ptr := PChar(sArg)+1;
while ptr^<>#0 do
begin
case ptr^ of
's','S': Include( options, optSymbolicLink );
'h','H': Help;
'F': options := options + [optOverwrite,optDirectory];
'f': Include( options, optOverwrite );
'r','R': Include( options, optRecursive );
'd','D': Include( options, optDirectory );
else
WriteLn('Error: Invalid option ''-',ptr^,'''');
Exit;
end;
Inc(ptr);
end;
Inc(iArg);
until iArg<=ParamCount;
if ParamCount<=iArg then Help;
if ParamCount-iArg>1 then Include( options, optDirectory );
if optSymbolicLink in options then
begin
sLink := ParamStr(ParamCount);
repeat
sExistedFileName := ParamStr(iArg);
if not CreateSymlink( sExistedFileName, sLink, options ) then
WriteLn( 'The symbolic link creation failed.' );
Inc(iArg);
until iArg>=ParamCount;
end
else if (options*[optRecursive,optDirectory])<>[] then
begin
sLink := ParamStr(ParamCount);
repeat
sExistedFileName := ParamStr(iArg);
CreateHardlinksInDirectory( sExistedFileName, sLink, options );
Inc(iArg);
until iArg>=ParamCount;
end
else
begin
sExistedFileName := ParamStr(iArg);
sLink := ParamStr(ParamCount);
dwAttrs := GetFileAttributes( PChar(sExistedFileName) );
if dwAttrs=FILE_DOES_NOT_EXIST then
begin
writeln('Error: The source file does not exist');
Exit;
end;
if (dwAttrs and FILE_ATTRIBUTE_DIRECTORY)<>0 then
begin
writeln('Error: Cannot create hardlink for directory');
Exit;
end;
CreateHardlink( sExistedFileName, sLink, options );
end;
end;
//=============================================================
begin
if ParamCount<2 then Help;
try
Execute;
except
on E:Exception do
begin
WriteLn(E.ClassName+': '+E.Message);
end;
end;
end.