偷梁换柱：用脚本实现共享文件夹路径的转换

有同事来找我写个脚本，将公司现有的共享文件夹移到同一个驱动器上的不同目录上，以方便即将进行的向SAN环境的迁移。

原来支持文件服务器是N年前的事了......但同事的面子咱还得给不是？谁叫咱喜欢捣鼓脚本呢，于是又再作冯妇了......

本来呢，手工改路径是标准做法。但很多时候，“标准”就意味着效率不高，况且有几百个共享文件夹，一个个改过去，人都傻掉了。这种机械化的工作很自然就会想起由电脑来代劳。

其实这种“自然”的想法，也是在工作中逐渐形成的。如果不知道有脚本这东西，就要花费很多时间在做这种重复劳动。VBA也是一个例子，多少人不知道有捷径可走，每天在一个EXCEL时重复同样的工作，久而久之就成为工作的奴隶。叹哉。

说了不少废话，现在言归正传。这个脚本的思路是：

1. 移动共享文件夹到新路径；

Function MoveFolder(strShare, strSource, strTarget)
On Error Resume Next

Set objFSO = CreateObject('Scripting.FileSystemObject')
    If Not objFSO.FolderExists(strTarget) Then
        arrItem = split(strTarget,'/')
        'strCurrentFolder = arrItem(0)
        i = 0
        For each strItem in arrItem
            strCurrentFolder = strCurrentFolder & arrItem(i) & '/'            
            If i > 0 Then
                If (StrComp(strShare,arrItem(i)) <>0) And (Not objFSO.FolderExists(strCurrentFolder)) Then
                    Set objNewFolder = objFSO.CreateFolder(strCurrentFolder)
                End If
            End If
            i = i + 1
        Next
        'Set objFolder = objFSO.CreateFolder(strTarget)
    End If
    objFSO.MoveFolder strSource , strTarget   
    If Err.Number <> 0 Then
        MoveFolder = Now & ': ' & Err.Description
        Err.Clear
    Else
        MoveFolder = Now & ': Folder ' & strSource & ' is moved to ' & strTarget & ' successfully.'
    End If
End Function

上述函数实现文件夹的移动，如果新文件夹不存在则创建之。

2. 更改注册表的信息以指向新路径。

Function ChangeSharePath(strShare, strPath)
On Error Resume Next
    Const HKEY_LOCAL_MACHINE = &H80000002

strComputer = '.'

Set oReg=GetObject('winmgmts:{impersonationLevel=impersonate}!//' & _
    strComputer & '/root/default:StdRegProv')
    strKeyPath = 'SYSTEM/CurrentControlSet/Services/LanmanServer/Shares'
    strValueName = strShare
    oReg.GetMultiStringValue HKEY_LOCAL_MACHINE,strKeyPath, _
    strValueName,arrValues
  'Modify share folder to refer to new path
  arrValues(2) = 'Path=' & strPath
  'Update registry
  oReg.SetMultiStringValue HKEY_LOCAL_MACHINE,strKeyPath, _
    strValueName,arrValues
    If Err.Number <> 0 Then
        ChangeSharePath = Now & ': ' & Err.Description
        Err.Clear
    Else
        ChangeSharePath = Now & ': ' & 'Registry value ' & strShare & ' is modified successfully.'
    End If
End Function

上述函数实现注册表信息的更改。当然，要重启电脑才能生效。