最后一次写,楼主自重,下不为例- '备份部分
-
- Dim wsh,wshSysEnv,objLink,objUrl
- Dim objFSO,subFolders,subFolder,Folder,Files,File
- Dim strHOMEDRIVE,strHOMEPATH
- Dim strBackup,strLnkPath,strWorkingDirectory,strTargetPath
-
- Set wsh = CreateObject("WScript.Shell")
- Set wshSysEnv = wsh.Environment("Process")
-
- strHOMEDRIVE = wshSysEnv("HOMEDRIVE")
- strHOMEPATH = wshSysEnv("HOMEPATH")
-
- Set objFSO = CreateObject("Scripting.FileSystemObject")
-
- FindLinks(strHOMEDRIVE & strHOMEPATH & "\Favorites\链接")
-
- Set File = objFSO.CreateTextFile("BackUp_lnk.txt",True)
- File.Write strBackup
- File.Close
-
- strBackup = ""
- FindUrls(strHOMEDRIVE & strHOMEPATH & "\Favorites\链接")
-
- Set File = objFSO.CreateTextFile("BackUp_url.txt",True)
- File.Write strBackup
- File.Close
-
- Set wsh = Nothing
- Set wshSysEnv = Nothing
- Set objFSO = Nothing
- Set Folder = Nothing
- Set subFolders = Nothing
- Set Files = Nothing
- Set File = Nothing
-
- MsgBox "Backup Succeed!",,"TIPs"
-
- Sub FindLinks(strPath)
- Set Folder = objFSO.GetFolder(strPath)
- Set subFolders = Folder.subFolders
- Set Files = Folder.Files
- For Each File In Files
- If LCase(objFSO.GetExtensionName(File.Path)) = "lnk" Then
- Set objLink = wsh.CreateShortcut(File.Path)
- strWorkingDirectory = objLink.WorkingDirectory
- strTargetPath = objLink.TargetPath
- strBackup = strBackup & _
- "LinkPath:" & File.Path & vbCrLf & _
- "LinkTargetPath:" & strTargetPath & vbCrLf & _
- "LinkWorkingDirectory:" & strWorkingDirectory _
- & vbCrLf & vbCrLf
- End If
- Next
- For Each subFolder In subFolders
- FindLinks(subFolder.Path)
- Next
- End Sub
-
- Sub FindUrls(strPath)
- Set Folder = objFSO.GetFolder(strPath)
- Set subFolders = Folder.subFolders
- Set Files = Folder.Files
- For Each File In Files
- If LCase(objFSO.GetExtensionName(File.Path)) = "url" Then
- Set objUrl = objFSO.OpenTextFile(File.Path,1)
- strBackup = strBackup & _
- objUrl.ReadAll & vbCrLf & _
- "#" & File.Path & vbCrLf & vbCrLf
- objUrl.Close
- End If
- Next
- For Each subFolder In subFolders
- FindUrls(subFolder.Path)
- Next
- End Sub
复制代码
- '还原部分
-
- Dim wsh,objFSO,f,Folder,strTxtLine,ary,objLink,objUrl
- Dim strLnkPath,strWorkingDirectory,strTargetPath,strRestore
-
- set wsh = CreateObject("WScript.Shell")
- Set objFSO = CreateObject("Scripting.FileSystemObject")
- Set f = objFSO.OpenTextFile("BackUp_lnk.txt",1)
-
- While Not f.AtEndOfStream
- strTxtLine = f.ReadLine
- If strTxtLine <> "" Then
- ary = Split(strTxtLine,":",-1)
- ReDim Preserve ary(3)
- Select Case ary(0)
- Case "LinkPath"
- strLnkPath = ary(1) & ":" & ary(2)
- Case "LinkTargetPath"
- strTargetPath = ary(1) & ":" & ary(2)
- Case "LinkWorkingDirectory"
- If ary(2) <> "" Then
- strWorkingDirectory = ary(1) & ":" & ary(2)
- End If
- CreateLnk strLnkPath,strTargetPath,strWorkingDirectory
- End Select
- End If
- Wend
-
- f.Close
-
- Set f = objFSO.OpenTextFile("BackUp_url.txt",1)
-
- While Not f.AtEndOfStream
- strTxtLine = f.ReadLine
- If Left(strTxtLine,1)="#" Then
- Folder = Left(strLnkPath,InStrRev(strLnkPath,"\"))
- If Not objFSO.FolderExists(Folder) Then
- objFSO.CreateFolder Folder
- End If
- Set objUrl = objFSO.CreateTextFile(Right(strTxtLine,Len(strTxtLine)-1),True)
- objUrl.Write strRestore
- objUrl.Close
- Else
- strRestore = strRestore & _
- strTxtLine & vbCrLf
- End If
- Wend
-
- f.Close
-
- Set wsh = Nothing
- Set objFSO = Nothing
- Set f= Nothing
- Set objUrl = Nothing
-
-
- MsgBox "Restore Succeed!",Tips
-
- Sub CreateLnk(strLnkPath,strTargetPath,strWorkingDirectory)
- Folder = Left(strLnkPath,InStrRev(strLnkPath,"\"))
- If Not objFSO.FolderExists(Folder) Then
- objFSO.CreateFolder Folder
- End If
- Set objLink = wsh.CreateShortcut(strLnkPath)
- objLink.TargetPath = strTargetPath
- objLink.WorkingDirectory = strWorkingDirectory
- objLink.Save
- Set objLink = Nothing
- End Sub
复制代码
|