Создание hardlink и symbolic link

Советы » Ярлыки » Создание hardlink и symbolic link

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Создание 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..' ', '.']) 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('Can''t 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('Can''t 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('Can''t 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('Can''t 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('Can''t 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('Can''t 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('Can''t 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('Can''t 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('Can''t 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: Can''t 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

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com