[已解决]“求恢复链接文件夹的快捷方式”备份已由版主写好了,代码在15楼。 - VBS求助&讨论 - 批处理之家 BAT,CMD,批处理,PowerShell,VBS,DOS

Rank: 12

帖子: 14981
积分: 46194
技术: 859
捐助: 745
注册时间: 2008-6-9

17楼

发表于 2011-9-10 19:22 | 只看该作者

回复 16# zhangop9

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

我帮忙写的代码不需要付钱。如果一定要给，请在微信群或QQ群发给大家吧。
【微信公众号、微信群、QQ群】http://bbs.bathome.net/thread-3473-1-1.html
【支持批处理之家，加入VIP会员！】http://bbs.bathome.net/thread-67716-1-1.html

TOP

zhangop9

二级士官

Rank: 2

帖子: 119
积分: 169
技术: 1
捐助: 0
注册时间: 2010-12-16

18楼

发表于 2011-9-10 20:59 | 只看该作者

本帖最后由 zhangop9 于 2011-9-10 21:08 编辑

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

TOP

broly

版主

Rank: 7 Rank: 7 Rank: 7

帖子: 881
积分: 2103
技术: 95
捐助: 55
注册时间: 2010-5-23

19楼

发表于 2011-9-15 23:12 | 只看该作者

最后一次写，楼主自重，下不为例

 '备份部分
 
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 SubCOPY

 '还原部分
 
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 SubCOPY

1 评分人数

wc726842270: 学习了技术 + 1

---学无止境---

TOP

wc726842270

大校

Rank: 7 Rank: 7 Rank: 7

帖子: 1107
积分: 4218
技术: 37
捐助: 0
注册时间: 2010-6-8

20楼

发表于 2011-9-15 23:48 | 只看该作者

规范性不错，可惜我今天早上才明白它的重要性，呵呵，又落后了

枫中残雪：风停了，我的心却在动，让我心中的寒意走向远方

TOP

zhangop9

二级士官

Rank: 2

帖子: 119
积分: 169
技术: 1
捐助: 0
注册时间: 2010-12-16

21楼

发表于 2011-9-16 11:27 | 只看该作者

19楼的代码“备份”没有问题，“还原”的代码有一点小问题，要先建目录才能还原。有一个备份文本为空的时候报错。

TOP

broly

版主

Rank: 7 Rank: 7 Rank: 7

帖子: 881
积分: 2103
技术: 95
捐助: 55
注册时间: 2010-5-23

22楼

发表于 2011-9-16 12:23 | 只看该作者

本帖最后由 broly 于 2011-9-16 19:18 编辑

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

 '还原部分
 
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
        Folder = Left(strLnkPath,InStrRev(strLnkPath,"\"))
        If Not objFSO.FolderExists(Folder) Then
            objFSO.CreateFolder Folder
        End If
        If Left(strTxtLine,1)="#" Then
                Set objUrl = objFSO.CreateTextFile(Right(strTxtLine,Len(strTxtLine)-1),True)
                objUrl.Write strRestore
                objUrl.Close
                strRestore = ""
        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 SubCOPY

---学无止境---

TOP

zhangop9

二级士官

Rank: 2

帖子: 119
积分: 169
技术: 1
捐助: 0
注册时间: 2010-12-16

23楼

发表于 2011-9-16 19:00 | 只看该作者

lnk还原没有问题，url还原后都是打开一个网站的，就一个网站

TOP

broly

版主

Rank: 7 Rank: 7 Rank: 7

帖子: 881
积分: 2103
技术: 95
捐助: 55
注册时间: 2010-5-23

24楼

发表于 2011-9-16 19:19 | 只看该作者

回复 23# zhangop9

sorry,已修正

---学无止境---

TOP

zhangop9

二级士官

Rank: 2

帖子: 119
积分: 169
技术: 1
捐助: 0
注册时间: 2010-12-16

25楼

发表于 2011-9-16 19:29 | 只看该作者

本帖最后由 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\校时\网络校时

TOP

zhangop9

二级士官

Rank: 2

帖子: 119
积分: 169
技术: 1
捐助: 0
注册时间: 2010-12-16

26楼

发表于 2011-9-16 19:32 | 只看该作者

本帖最后由 zhangop9 于 2011-9-16 23:25 编辑

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

TOP

wc726842270

大校

Rank: 7 Rank: 7 Rank: 7

帖子: 1107
积分: 4218
技术: 37
捐助: 0
注册时间: 2010-6-8

27楼

发表于 2011-9-23 11:59 | 只看该作者

其实，这个也可以用P来完成。当然有用WINRAR了，这方面的帮助，还是“百度或GOOGLE”一下比较好
关键字：WINRAR管理清除桌面文件或图标（绝对路径没有改变的情况下）

枫中残雪：风停了，我的心却在动，让我心中的寒意走向远方

TOP

[新手上路]批处理新手入门导读	[视频教程]批处理基础视频教程	[视频教程]VBS基础视频教程	[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动	[批处理精品]CMD命令50条不能说的秘密	[在线下载]第三方命令行工具	[在线帮助]VBScript / JScript 在线参考

[收藏此主题] [关注此主题的新回复]

[通过 QQ、MSN 分享给朋友]

设置关闭

开启【页面动态效果 + 卡片式布局】
关闭【页面动态效果 + 卡片式布局】

开启【代码高亮】
关闭【代码高亮】

代码高亮主题【亮】
代码高亮主题【暗】


	设置关闭开启【页面动态效果 + 卡片式布局】关闭【页面动态效果 + 卡片式布局】开启【代码高亮】关闭【代码高亮】代码高亮主题【亮】代码高亮主题【暗】

[收藏此主题] [关注此主题的新回复]

[通过 QQ、MSN 分享给朋友]

设置 关闭

开启 【页面动态效果 + 卡片式布局】 关闭 【页面动态效果 + 卡片式布局】 开启 【代码高亮】关闭 【代码高亮】代码高亮主题 【亮】代码高亮主题 【暗】

设置关闭

开启【页面动态效果 + 卡片式布局】
关闭【页面动态效果 + 卡片式布局】

开启【代码高亮】
关闭【代码高亮】

代码高亮主题【亮】
代码高亮主题【暗】