cp.vbs

'# Perform dir /a c:\users > c:\dir.txt
'# place this script file in c:\ too
'# double click to run it
'# run resulting script.bat from recovery mode
repprefix = " Directory of " ' Modify to your language
sourcepath = "C:\Users.bak"
targetpath = "C:\Users"
altsourcepath = "D:\Users.bak"
alttargetpath = "D:\Users"

inname = "dir.txt"
outname = "script.bat"
juncname = "<JUNCTION>"  '//After copying from web, replace [] with angle brackets!!!
linkname = "<SYMLINKD>"  '//After copying from web, replace [] with angle brackets!!!

set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

' construct batch commands for saving rights, then link, the recreating rights
Function GetCommand(curroot, line, typ, keyword)
	' first need to get source and target
	pos = Instr(line, keyword) + Len(keyword)

	tuple = Trim(Mid(line, pos))
	arr = Split(tuple, "[")

	oldtarget = Replace(arr(1), "]", "")
	oldlink = curroot & "\" & Trim(arr(0))

	' need to determine if we are pointing back to old disk
	newlink = replace(oldlink, sourcepath, targetpath)
	if(Instr(oldtarget, sourcepath)) then
		newtarget = Replace(oldtarget, sourcepath, targetpath)
	else
		newtarget = oldtarget ' still pointing to original target
	end if

	' comment
	out = "echo " & newlink & " --- " & newtarget & vbCrLf
	' save permissions
	out = out & "icacls """ & replace(oldlink, sourcepath, altsourcepath) & """ /L /save " & alttargetpath & "\permissions.txt" & vbCrLf

	' create link
	newlink = replace(newlink, targetpath, alttargetpath)
	if typ = "junction" then
		out = out & "mklink /j """ & newlink & """ """ & newtarget & """" & vbCrLf
	else ' typ = "symlink"
		out = out & "mklink /d """ & newlink & """ """ & newtarget & """" & vbCrLf
	end if

	'set hidden attribute
    Set objCmdExec = objshell.exec("attrib """ & oldlink & """ /L")
    attr = objCmdExec.StdOut.ReadAll
	
	out = out & "attrib"
	for i = 1 to 9
		a = trim(mid(attr, i, 1))
		if a <> "" then
			out = out & " +" & a
		end if
	next
	
	out = out & " """ & newlink & """ /L" & vbCrLf

	' apply permissions
	shortlink = Left(newlink, InstrRev(newlink, "\") - 1) 'icacls works strangely - non-orthogonal for restore
	out = out & "icacls """ & shortlink & """ /L /restore " & alttargetpath & "\permissions.txt" & vbCrLf
	
	GetCommand = out & vbCrLf
End Function

Sub WriteToFile(file, text)
	ForWriting = 2
	Create = true
	set outfile = fso.OpenTextFile(file, ForWriting, Create)
	Call outfile.Write(text)
	Call outfile.Close()
End Sub

outtext = "ROBOCOPY " & altsourcepath & " " & alttargetpath & " /E /COPYALL /XJ" & vbCrLf & vbCrLf

set intext = fso.OpenTextFile(inname)
while not intext.AtEndOfStream
	line = intext.ReadLine()
	if Instr(line, repprefix) then
		curroot = Replace(line, repprefix, "")
	elseif Instr(line, juncname) then
		outtext = outtext & GetCommand(curroot, line, "junction", juncname)
	elseif Instr(line, linkname) then
		outtext = outtext & GetCommand(curroot, line, "symlink", linkname)
	end if
Wend

outtext = outtext & "icacls " & altsourcepath & " /L /save " & alttargetpath & "\permissions.txt" & vbCrLf
' outtext = outtext & "ren " & altsourcepath & " _" & vbCrLf
' outtext = outtext & "mklink /j " & altsourcepath & " " & targetpath & vbCrLf
outtext = outtext & "icacls " & alttargetpath & " /L /restore " & alttargetpath & "\permissions.txt"

Call intext.Close()

Call WriteToFile(outname, outtext)

MsgBox("Done writing to " & outname)