『第
6 楼』:
如果感觉上面的不大适合脚本使用
那么试试下面的vbs脚本吧
其中也包含了分析具体路径的正则表达式方法
速度上不及上面的二进制工具
加 /U 参数可以卸载新加的菜单项
Option Explicit
On Error Resume Next
Dim FSO, WS, ASO, objIE, WorkScript, TargetFileName
Const adTypeText = 2
Const DlgTitle = "By Shilyx 2007.4.8 oversleep@163.com"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WS = WScript.CreateObject("WScript.Shell")
Set ASO = CreateObject("ADODB.Stream")
WorkScript = WS.ExpandEnvironmentStrings("%WinDir%") & "\system32\GetSCPath.vbs"
If WScript.Arguments.Count = 0 Then
FSO.CopyFile WScript.ScriptFullName, WorkScript, True
WS.RegWrite "HKCR\LnkFile\Shell\FindTarget\", "复制路径到剪贴板(&C)"
WS.RegWrite "HKCR\LnkFile\Shell\FindTarget\Command\", "WScript " & WorkScript & " /C" & " ""%1""", "REG_SZ"
WS.RegWrite "HKCR\LnkFile\Shell\ShowTarget\", "查找目标(&F)"
WS.RegWrite "HKCR\LnkFile\Shell\ShowTarget\Command\", "WScript " & WorkScript & " /F" & " ""%1""", "REG_SZ"
MsgBox "快捷方式快捷管理脚本安装成功", vbOKOnly + vbInformation, DlgTitle
WScript.Quit
End If
If LCase(WScript.Arguments(0)) = "/u" Then
If FSO.FileExists(WorkScript) Then FSO.DeleteFile(WorkScript)
WS.RegDelete "HKCR\LnkFile\Shell\FindTarget\Command\"
WS.RegDelete "HKCR\LnkFile\Shell\FindTarget\"
WS.RegDelete "HKCR\LnkFile\Shell\ShowTarget\Command\"
WS.RegDelete "HKCR\LnkFile\Shell\ShowTarget\"
MsgBox "快捷方式快捷管理脚本卸载成功", vbOKOnly + vbInformation, DlgTitle
WScript.Quit
End If
If Not FSO.FileExists(WScript.Arguments(1)) Then
MsgBox "找不到指定的文件", vbOKOnly + vbExclamation, DlgTitle
Wscript.Quit
End If
If LCase(Right(WScript.Arguments(1), 4)) <> ".lnk" Then
MsgBox "指定快捷方式文件不合法", vbOKOnly + vbCritical, DlgTitle
Wscript.Quit
End If
TargetFileName = RegExpTest("[c-z]:(\\[^||]*)*\.exe", GetVisualText(WScript.Arguments(1)))
If TargetFileName = "" Then
MsgBox "在此快捷方式中没有找到可能的Exe文件指向", vbCritical, DlgTitle
WScript.Quit
End if
If WScript.Arguments(0) = "/C" Then
CopyToClipBoard TargetFileName
MsgBox "已复制到剪贴板" & vbCrLf & vbCrLf & TargetFileName, vbInformation, DlgTitle
ElseIf WScript.Arguments(0) = "/F" Then
If FSO.FileExists(TargetFileName) Then WS.Run "Explorer /n,/Select,""" & TargetFileName & """"
End If
Function RegExpTest(patrn, strng)
Dim regEx, Match, Matches
Set regEx = New RegExp
regEx.Pattern = patrn
regEx.IgnoreCase = True
regEx.Global = False
Set Matches = regEx.Execute(strng)
For Each Match in Matches
RegExpTest = Match.Value
Next
End Function
Function GetVisualText(FileName)
Dim ch
ASO.Type = adTypeText
ASO.Open
ASO.LoadFromFile FileName
ASO.Position = 0
ASO.CharSet = "GB2312"
GetVisualText = ""
Do While Not aso.EOS
ch = ASO.ReadText(1)
If ((Asc(ch) > 31) And (Asc(ch) < 127)) Or Asc(ch) < 0 Then
GetVisualText = GetVisualText + Chr(Asc(ch))
Else
GetVisualText = GetVisualText + "|"
End If
Loop
ASO.Close
End Function
Sub CopyToClipBoard(Text)
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.Document.ParentWindow.ClipboardData.SetData "text", Text 'GetData可以获得内容
objIE.Quit
End Sub
|
