设为首页收藏本站
切换到宽版

 找回密码
 注册
搜索
批处理之家»论坛 › 其他脚本区 › VBS求助&讨论 › [已解决]“求恢复链接文件夹的快捷方式”备份已由版主写 ...
[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
12
返回列表 发新帖
楼主: zhangop9

[问题求助] [已解决]“求恢复链接文件夹的快捷方式”备份已由版主写好了,代码在15楼。

[复制链接]
zhangop9
 楼主| 发表于 2011-9-10 18:23:16 | 显示全部楼层
晚上，有时间再搞搞好不好，最好能分开备份，url一个文本，lnk一个文本，路径改到收藏夹"%HOMEPATH%\Favorites“，这样就有通用性了
回复

举报

Batcher
发表于 2011-9-10 19:22:38 | 显示全部楼层
回复 16# zhangop9


以后发帖求助，有什么需求最好在顶楼一次说完。
回复

举报

zhangop9
 楼主| 发表于 2011-9-10 20:59:53 | 显示全部楼层
本帖最后由 zhangop9 于 2011-9-10 21:08 编辑

不好意思，只是后来才想到这个方法能比较好的解决问题，以后想好再说，但是有时需求是慢慢才知道的，所以比较难搞一点，那个发在dos版的那个帖子可以删除的谢谢你的指正！
回复

举报

broly
发表于 2011-9-15 23:12:29 | 显示全部楼层
最后一次写，楼主自重，下不为例
  1. '备份部分

  3. Dim wsh,wshSysEnv,objLink,objUrl
  4. Dim objFSO,subFolders,subFolder,Folder,Files,File
  5. Dim strHOMEDRIVE,strHOMEPATH
  6. Dim strBackup,strLnkPath,strWorkingDirectory,strTargetPath

  8. Set wsh = CreateObject("WScript.Shell")
  9. Set wshSysEnv = wsh.Environment("Process")

  11. strHOMEDRIVE = wshSysEnv("HOMEDRIVE")
  12. strHOMEPATH = wshSysEnv("HOMEPATH")

  14. Set objFSO = CreateObject("Scripting.FileSystemObject")

  16. FindLinks(strHOMEDRIVE & strHOMEPATH & "\Favorites\链接")

  18. Set File = objFSO.CreateTextFile("BackUp_lnk.txt",True)
  19. File.Write strBackup
  20. File.Close

  22. strBackup = ""
  23. FindUrls(strHOMEDRIVE & strHOMEPATH & "\Favorites\链接")

  25. Set File = objFSO.CreateTextFile("BackUp_url.txt",True)
  26. File.Write strBackup
  27. File.Close

  29. Set wsh = Nothing
  30. Set wshSysEnv = Nothing
  31. Set objFSO = Nothing
  32. Set Folder = Nothing
  33. Set subFolders = Nothing
  34. Set Files = Nothing
  35. Set File = Nothing

  37. MsgBox "Backup Succeed!",,"TIPs"

  39. Sub FindLinks(strPath)
  40.   Set Folder = objFSO.GetFolder(strPath)
  41.   Set subFolders = Folder.subFolders
  42.   Set Files = Folder.Files
  43.   For Each File In Files
  44.         If LCase(objFSO.GetExtensionName(File.Path)) = "lnk" Then
  45.                 Set objLink = wsh.CreateShortcut(File.Path)
  46.                 strWorkingDirectory = objLink.WorkingDirectory
  47.                 strTargetPath = objLink.TargetPath
  48.                 strBackup = strBackup & _
  49.                         "LinkPath:" & File.Path & vbCrLf & _
  50.                         "LinkTargetPath:" & strTargetPath & vbCrLf & _
  51.                         "LinkWorkingDirectory:" & strWorkingDirectory _
  52.                         & vbCrLf & vbCrLf
  53.         End If
  54.   Next
  55.   For Each subFolder In subFolders
  56.       FindLinks(subFolder.Path)
  57.   Next
  58. End Sub

  60. Sub FindUrls(strPath)
  61.   Set Folder = objFSO.GetFolder(strPath)
  62.   Set subFolders = Folder.subFolders
  63.   Set Files = Folder.Files
  64.   For Each File In Files
  65.         If LCase(objFSO.GetExtensionName(File.Path)) = "url" Then
  66.                 Set objUrl = objFSO.OpenTextFile(File.Path,1)
  67.                                 strBackup = strBackup & _
  68.                                         objUrl.ReadAll & vbCrLf & _
  69.                                         "#" & File.Path & vbCrLf & vbCrLf
  70.                                 objUrl.Close
  71.         End If
  72.   Next
  73.   For Each subFolder In subFolders
  74.       FindUrls(subFolder.Path)
  75.   Next
  76. End Sub
复制代码
  1. '还原部分

  3. Dim wsh,objFSO,f,Folder,strTxtLine,ary,objLink,objUrl
  4. Dim strLnkPath,strWorkingDirectory,strTargetPath,strRestore

  6. set wsh = CreateObject("WScript.Shell")
  7. Set objFSO = CreateObject("Scripting.FileSystemObject")
  8. Set f = objFSO.OpenTextFile("BackUp_lnk.txt",1)

  10. While Not f.AtEndOfStream
  11.         strTxtLine = f.ReadLine
  12.         If strTxtLine <> "" Then
  13.                 ary = Split(strTxtLine,":",-1)
  14.                 ReDim Preserve ary(3)
  15.                 Select Case ary(0)
  16.                         Case "LinkPath"
  17.                                 strLnkPath = ary(1) & ":" & ary(2)
  18.                         Case "LinkTargetPath"
  19.                                 strTargetPath = ary(1) & ":" & ary(2)
  20.                         Case "LinkWorkingDirectory"
  21.                                 If ary(2) <> "" Then
  22.                                 strWorkingDirectory = ary(1) & ":" & ary(2)
  23.                             End If
  24.                                 CreateLnk strLnkPath,strTargetPath,strWorkingDirectory
  25.                 End Select
  26.         End If
  27. Wend

  29. f.Close

  31. Set f = objFSO.OpenTextFile("BackUp_url.txt",1)

  33. While Not f.AtEndOfStream
  34.         strTxtLine = f.ReadLine
  35.         If Left(strTxtLine,1)="#" Then
  36.                 Folder = Left(strLnkPath,InStrRev(strLnkPath,""))
  37.         If Not objFSO.FolderExists(Folder) Then
  38.                 objFSO.CreateFolder Folder
  39.         End If
  40.                 Set objUrl = objFSO.CreateTextFile(Right(strTxtLine,Len(strTxtLine)-1),True)
  41.                 objUrl.Write strRestore
  42.                 objUrl.Close
  43.         Else
  44.                 strRestore = strRestore & _
  45.                         strTxtLine & vbCrLf
  46.         End If
  47. Wend

  49. f.Close

  51. Set wsh = Nothing
  52. Set objFSO = Nothing
  53. Set f= Nothing
  54. Set objUrl = Nothing


  57. MsgBox "Restore Succeed!",Tips

  59. Sub CreateLnk(strLnkPath,strTargetPath,strWorkingDirectory)
  60.         Folder = Left(strLnkPath,InStrRev(strLnkPath,""))
  61.         If Not objFSO.FolderExists(Folder) Then
  62.                 objFSO.CreateFolder Folder
  63.         End If
  64.         Set objLink = wsh.CreateShortcut(strLnkPath)
  65.         objLink.TargetPath = strTargetPath
  66.         objLink.WorkingDirectory = strWorkingDirectory
  67.         objLink.Save
  68.         Set objLink = Nothing
  69. End Sub
复制代码

评分

参与人数 1技术 +1 收起 理由
wc726842270 + 1 学习了

查看全部评分

回复

举报

wc726842270
发表于 2011-9-15 23:48:39 | 显示全部楼层
规范性不错，可惜我今天早上才明白它的重要性，呵呵，又落后了
回复

举报

zhangop9
 楼主| 发表于 2011-9-16 11:27:57 | 显示全部楼层
19楼的代码“备份”没有问题，“还原”的代码有一点小问题，要先建目录才能还原。有一个备份文本为空的时候报错。
回复

举报

broly
发表于 2011-9-16 12:23:15 | 显示全部楼层
本帖最后由 broly 于 2011-9-16 19:18 编辑

还原部分（原来那个有地方顺序错了）
  1. '还原部分

  3. Dim wsh,objFSO,f,Folder,strTxtLine,ary,objLink,objUrl
  4. Dim strLnkPath,strWorkingDirectory,strTargetPath,strRestore

  6. set wsh = CreateObject("WScript.Shell")
  7. Set objFSO = CreateObject("Scripting.FileSystemObject")
  8. Set f = objFSO.OpenTextFile("BackUp_lnk.txt",1)

  10. While Not f.AtEndOfStream
  11.         strTxtLine = f.ReadLine
  12.         If strTxtLine <> "" Then
  13.                 ary = Split(strTxtLine,":",-1)
  14.                 ReDim Preserve ary(3)
  15.                 Select Case ary(0)
  16.                         Case "LinkPath"
  17.                                 strLnkPath = ary(1) & ":" & ary(2)
  18.                         Case "LinkTargetPath"
  19.                                 strTargetPath = ary(1) & ":" & ary(2)
  20.                         Case "LinkWorkingDirectory"
  21.                             If ary(2) <> "" Then
  22.                                 strWorkingDirectory = ary(1) & ":" & ary(2)
  23.                             End If
  24.                                 CreateLnk strLnkPath,strTargetPath,strWorkingDirectory
  25.                 End Select
  26.         End If
  27. Wend

  29. f.Close

  31. Set f = objFSO.OpenTextFile("BackUp_url.txt",1)

  33. While Not f.AtEndOfStream
  34.         strTxtLine = f.ReadLine
  35.         Folder = Left(strLnkPath,InStrRev(strLnkPath,""))
  36.         If Not objFSO.FolderExists(Folder) Then
  37.             objFSO.CreateFolder Folder
  38.         End If
  39.         If Left(strTxtLine,1)="#" Then
  40.                 Set objUrl = objFSO.CreateTextFile(Right(strTxtLine,Len(strTxtLine)-1),True)
  41.                 objUrl.Write strRestore
  42.                 objUrl.Close
  43.                 strRestore = ""
  44.         Else
  45.                 strRestore = strRestore & _
  46.                         strTxtLine & vbCrLf
  47.         End If
  48. Wend

  50. f.Close

  52. Set wsh = Nothing
  53. Set objFSO = Nothing
  54. Set f= Nothing
  55. Set objUrl = Nothing


  58. MsgBox "Restore Succeed!",Tips

  60. Sub CreateLnk(strLnkPath,strTargetPath,strWorkingDirectory)
  61.         Folder = Left(strLnkPath,InStrRev(strLnkPath,""))
  62.         If Not objFSO.FolderExists(Folder) Then
  63.                 objFSO.CreateFolder Folder
  64.         End If
  65.         Set objLink = wsh.CreateShortcut(strLnkPath)
  66.         objLink.TargetPath = strTargetPath
  67.         objLink.WorkingDirectory = strWorkingDirectory
  68.         objLink.Save
  69.         Set objLink = Nothing
  70. End Sub
复制代码
回复

举报

zhangop9
 楼主| 发表于 2011-9-16 19:00:38 | 显示全部楼层
lnk还原没有问题，url还原后都是打开一个网站的，就一个网站
回复

举报

broly
发表于 2011-9-16 19:19:05 | 显示全部楼层
回复 23# zhangop9


    sorry,已修正
回复

举报

zhangop9
 楼主| 发表于 2011-9-16 19:29:14 | 显示全部楼层
本帖最后由 zhangop9 于 2011-9-16 23:26 编辑

回复 24# broly
我的 链接文件夹下还有下一级目录，还原时还要新建目录结构如：选用软件、系统更新，不然就报错很不方便！！！！

LinkPath:\Personal\\Favorites\链接\系统更新\9.字体路径.bat.lnk
LinkTargetPath:D:\Personal\setup\字体路径.bat
LinkWorkingDirectory:D:\Personal\Adobe Reader V8\AdobeAcrobatReader

LinkPath:D:\Personal\Favorites\链接\选用软件\Foxit PDF Creator.lnk
LinkTargetPath:D:\Personal\pdf\Foxit PDF Creator 3.0.1.0109 x86\!)绿化.exe
LinkWorkingDirectory:D:\Personal\pdf\Foxit PDF Creator 3.0.1.0109 x86

LinkPath:D:\Personal\Favorites\链接\选用软件\开机映射网络磁盘批处理.lnk.lnk
LinkTargetPath:D:\Personal\自动登录脚本\自动登录网络共享盘\开机映射网络磁盘批处理.bat
LinkWorkingDirectory:D:\Personal\自动登录脚本\自动登录网络共享盘

LinkPath:D:\Personal\Favorites\链接\选用软件\快速定位注册表.vbs.lnk
LinkTargetPath:D:\Personal\自动登录脚本\安装脚本\快速定位注册表.vbs
LinkWorkingDirectory:D:\Personal\校时\网络校时
回复

举报

zhangop9
 楼主| 发表于 2011-9-16 19:32:21 | 显示全部楼层
本帖最后由 zhangop9 于 2011-9-16 23:25 编辑

可以用了，谢谢，目录想想办法自己搞吧
回复

举报

wc726842270
发表于 2011-9-23 11:59:53 | 显示全部楼层
其实，这个也可以用P来完成。当然有用WINRAR了，这方面的帮助，还是“百度或GOOGLE”一下比较好
关键字：WINRAR管理清除桌面文件或图标（绝对路径没有改变的情况下）
回复

举报

12
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|小黑屋|批处理之家 ( 渝ICP备10000708号 )

GMT+8, 2026-3-16 23:16 , Processed in 0.022344 second(s), 8 queries , File On.

Powered by Discuz! X3.5

© 2001-2026 Discuz! Team.

快速回复 返回顶部 返回列表