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

Rank: 2

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

16楼 跳转到 »

发表于 2011-9-10 18:23 | 只看该作者

晚上，有时间再搞搞好不好，最好能分开备份，url一个文本，lnk一个文本，路径改到收藏夹"%HOMEPATH%\Favorites“，这样就有通用性了

Batcher

管理员

Rank: 12

帖子: 14935
积分: 46142
技术: 857
捐助: 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

Rank: 2

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

18楼

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

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

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

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 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
复制代码

1 评分人数

wc726842270: 学习了技术 + 1

---学无止境---

wc726842270

大校

Rank: 7 Rank: 7 Rank: 7

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

20楼

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

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

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

Rank: 2

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

21楼

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

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

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 Sub
复制代码

---学无止境---

Rank: 2

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

23楼

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

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

broly

版主

Rank: 7 Rank: 7 Rank: 7

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

24楼

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

回复 23# zhangop9

sorry,已修正

---学无止境---

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\校时\网络校时

Rank: 2

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

26楼

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

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

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

wc726842270

大校

Rank: 7 Rank: 7 Rank: 7

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

27楼

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

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

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