' Hardlinks.vbs

' 示范 NTFS 卷上的硬链接

' --------------------------------------------------------

Option Explicit

' 一些常量

Const L_NoHardLinkCreated = "Unable to create hard link"

Const L_EnterTarget = "Enter the file name to hard-link to"

Const L_HardLinks = "Creating hard link"

Const L_EnterHardLink = "Name of the hard link you want to create"

Const L_CannotCreate = "Make sure that both files are on the same volume and the volume is NTFS"

Const L_NotExist = "Sorry, the file doesn't exist"

Const L_SameName = "Target file and hard link cannot have the same name"

' 确定要（硬）链接的现有文件

dim sTargetFile

if WScript.Arguments.Count >0 then

   sTargetFile = WScript.Arguments(0)

else

   sTargetFile = InputBox(L_EnterTarget, L_HardLinks, "")

   if sTargetFile = "" then WScript.Quit

end if

' 该文件存在吗？

dim fso

set fso = CreateObject("Scripting.FileSystemObject")  

if Not fso.FileExists(sTargetFile) then

   MsgBox L_NotExist

   WScript.Quit

end if

' 主循环

while true

   QueryForHardLink sTargetFile

wend

' 关闭

WScript.Quit

' /

' // Helper 函数

' 创建硬链接

'------------------------------------------------------------

function QueryForHardLink(sTargetFile)

   ' 如果在命令行上指定了硬链接名，则提取它

   dim sHardLinkName

   if WScript.Arguments.Count >1 then

      sHardLinkName = WScript.Arguments(1)

   else

      dim buf

      buf = L_EnterHardLink & " for" & vbCrLf & sTargetFile

      sHardLinkName = InputBox(buf, L_HardLinks, sTargetFile)

      if sHardLinkName = "" then WScript.Quit  

      if sHardLinkName = sTargetFile then

         MsgBox L_SameName

         exit function

      end if

   end if

   ' 验证两个文件均在同一个卷上，且

   ' 该卷是 NTFS

   if Not CanCreateHardLinks(sTargetFile, sHardLinkName) then

      MsgBox L_CannotCreate

      exit function

   end if

  

   ' 创建硬链接

   dim oHL

   set oHL = CreateObject("HardLink.Object.1")

   oHL.CreateNewHardLink sHardLinkName, sTargetFile

end function

' 验证两个文件均在同一个 NTFS 磁盘上

'------------------------------------------------------------

function CanCreateHardLinks(sTargetFile, sHardLinkName)

   CanCreateHardLinks = false

  

   dim fso

   set fso = CreateObject("Scripting.FileSystemObject")

  

   ' 同一个驱动器？

   dim d1, d2

   d1 = fso.GetDriveName(sTargetFile)

   d2 = fso.GetDriveName(sHardLinkName)

   if d1 <> d2 then exit function

   ' NTFS 驱动器？

   CanCreateHardLinks = IsNTFS(sTargetFile)

end function

' IsNTFS() — 验证文件的卷是否为 NTFS

' --------------------------------------------------------

function IsNTFS(sFileName)

   dim fso, drv

  

   IsNTFS = False

   set fso = CreateObject("Scripting.FileSystemObject")  

   set drv = fso.GetDrive(fso.GetDriveName(sFileName))

   set fso = Nothing

  

   if drv.FileSystem = "NTFS" then IsNTFS = True

end function