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

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

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

返回列表发帖

Rank: 7 Rank: 7 Rank: 7

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

1楼 跳转到 »

发表于 2011-9-8 00:38 | 显示全部帖子

'F:\GreenTools\系统工具\CloseMonitor.scr'
'#F:\GreenTools\TextTools\UltraEdit16\Uedit32.exe
'F:\GreenTools\VirtualTools\VMware7\vmware.exe"
'F:\GreenTools\Devtools\MyEclipse8\MyEclipse 8.x Latest\myeclipse.exe"
'F:\GreenTools\网络工具\comunication\QQ2010\Bin\QQ.exe"
'F:\GreenTools\网络工具\FlashXP3.6\flashfxp.exe"
'F:\GreenTools\通讯\G3 eWalk\G3 eWalk.exe"
'F:\GreenTools\Devtools\VC++6\Common\MSDev98\Bin\MSDEV.EXE"
'===================================================
'Option Explicit
Const ForReading = 1
Const isCrerateShortcut=1
'参数说明：1创建快捷方式；0删除快捷方式
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("添加常用应用程序到桌面图标.vbs", ForReading)
Do Until objTextFile.AtEndOfStream 
  Dim strNextLine
  Dim spIndex,program,path,pname,ShortcutName
  Dim WshShell
set WshShell = WScript.CreateObject("WScript.Shell") 
  '
  strNextLine = objTextFile.Readline
  strNextLine = Mid(strNextLine,2,Len(strNextLine))
  If(InStr(strNextLine,"=====")<>0) Then
   Exit Do
  End If
spIndex=InStr(strNextLine,"#")
If (spIndex=0) Then
part=split(strNextLine,"\")
program=strNextLine
pname=part(UBound(part))
path=Mid(strNextLine,1,InStr(strNextLine,pname)-1)
ShortcutName=Mid(pname,1,InStr(pname,".")-1)
'MsgBox ShortcutName
'下面是创建或删除快捷方式
strDesktop = WshShell.SpecialFolders("Desktop") 
If(isCrerateShortcut=1)Then '创建
set oShellLink = WshShell.CreateShortcut(strDesktop & "\" & ShortcutName & ".lnk") '快捷方式的名字 
oShellLink.TargetPath = program '快捷方式里的“目标” 
oShellLink.WindowStyle = 1 '快捷方式里的“运行方式”：参数1默认窗口激活，参数3最大化激活，参数7最小化
oShellLink.WorkingDirectory =path '快捷方式里的“起始位置”
oShellLink.Description = "该快捷方式由VBS添加" '快捷方式里的“备注” 
oShellLink.Save
ElseIf(isCrerateShortcut=0)Then'删除
objFSO.DeleteFile strDesktop & "\" & ShortcutName & ".lnk"
End If
End If
Loop
objTextFile.Close
复制代码

---学无止境---

Rank: 7 Rank: 7 Rank: 7

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

2楼

发表于 2011-9-8 00:39 | 显示全部帖子

你要实现些什么样的功能啊？请详细说明

---学无止境---

Rank: 7 Rank: 7 Rank: 7

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

3楼

发表于 2011-9-8 00:56 | 显示全部帖子

回复 5# zhangop9

以文本的形式备份？以后说明你的需求时最好把例子列举出来，帮助别人理解

---学无止境---

Rank: 7 Rank: 7 Rank: 7

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

4楼

发表于 2011-9-8 07:57 | 显示全部帖子

楼主，我投降，我不得不承认自己智商不够高，看不懂你想要表达什么。

---学无止境---

Rank: 7 Rank: 7 Rank: 7

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

5楼

发表于 2011-9-8 17:17 | 显示全部帖子

回复 9# zhangop9

里面的快捷方式的后缀是什么？.url？全是网址的快捷方式？你好给给我举个例子吧

---学无止境---

Rank: 7 Rank: 7 Rank: 7

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

6楼

发表于 2011-9-9 00:39 | 显示全部帖子

Dim wsh,wshSysEnv,objLink
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("LinkBackUp.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:" & strTargetPath _
			& vbCrLf & vbCrLf
	End If
  Next
  For Each subFolder In subFolders
      FindLinks(subFolder.Path)
  Next
End Sub
复制代码

---学无止境---

Rank: 7 Rank: 7 Rank: 7

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

7楼

发表于 2011-9-9 14:32 | 显示全部帖子

回复 13# zhangop9

晚上先

---学无止境---

Rank: 7 Rank: 7 Rank: 7

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

8楼

发表于 2011-9-9 22:27 | 显示全部帖子

备份部分（12楼代码有点错了，现在改回来）：

Dim wsh,wshSysEnv,objLink
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("LinkBackUp.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
复制代码

还原部分：

Dim wsh,objFSO,f,Folder,strTxtLine,ary,objLink
Dim strLnkPath,strWorkingDirectory,strTargetPath

set wsh = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set f = objFSO.OpenTextFile("LinkBackUp.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"
				strWorkingDirectory = ary(1) & ":" & ary(2)
				CreateLnk strLnkPath,strTargetPath,strWorkingDirectory
		End Select
	End If
Wend

f.Close

Set wsh = Nothing
Set objFSO = Nothing
Set f= 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: 7 Rank: 7 Rank: 7

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

9楼

发表于 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

---学无止境---

Rank: 7 Rank: 7 Rank: 7

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

10楼

发表于 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: 7 Rank: 7 Rank: 7

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

11楼

发表于 2011-9-16 19:19 | 显示全部帖子

回复 23# zhangop9

sorry,已修正

---学无止境---