示范NTFS 卷上的硬链接

' 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