Dim WshSHell,FSO
On Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
InsPath = FSO.GetSpecialFolder(1)
InsFullName = FSO.BuildPath(InsPath ,FileName)
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:fty1995@163.com"
InsTitle="快速定位文件夹"
InsAnswer="快速定位文件夹"
RegPath1="HKEY_CLASSES_ROOT\CLSID\{208D2C60-3AEA-1069-A2D7-08002B30309D}\shell\QuickTo_Folder\"
RegValue1="定位文件夹(&W)"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\CLSID\{208D2C60-3AEA-1069-A2D7-08002B30309D}\shell\QuickTo_Folder\command\"
RegValue2="wscript.exe "&InsFullName
RegForm2="REG_SZ"
IF FileFullName <> InsFullName then
intAnswer = MsgBox("【是】将“"+ InsAnswer +"”加入到网上邻居右键菜单,"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从网上邻居右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - "+ Copyright)
If intAnswer = vbYes Then
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWrite RegPath2,RegValue2,RegForm2
FSO.GetFile(FileFullName).Copy(InsFullName)
WshSHell.popup _
"添加脚本文件:"+chr(10)+InsFullName+chr(10)+chr(10)+ _
"添加注册表项:"+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "安装成功 - "+ InsTitle +" - "+ Copyright, 0 + 64
end if
If intAnswer = vbNo Then
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
FSO.DeleteFile InsFullName
WshSHell.popup _
"删除脚本文件:"+chr(10)+InsFullName+chr(10)+chr(10)+ _
"删除注册表项:"+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载成功 - "+ InsTitle +" - "+ Copyright, 0 + 64
End If
If intAnswer = vbCancel Then
end if
ELSE
FPathStr=UCase(CreateObject("htmlfile").parentWindow.clipboardData.getData("text"))
Do
Check = True
FPathStr = Trim(FPathStr)
FPathStr=Replace(FPathStr,chr(10),"")
FPathStr=Replace(FPathStr,chr(13),"")
FPathStr=Replace(FPathStr,"\\","\")
FPathArr=split(FPathStr,"\")
n=0
FPathTest=""
if 64 < ASC(Left(FPathStr,1)) < 91 and mid(FPathStr,2,1)=":" and mid(FPathStr,3,1)="\" then
FOR i=1 To UBound(FPathArr)
FPathTest = FSO.BuildPath(FPathTest,FPathArr(i))
FPathi=FSO.BuildPath(FPathArr(0)&"\",FPathTest)
If (FSO.FolderExists(FPathi)) Then
n=int(i)
FPath=FPathi
else
n=int(i-1)
Exit For
end if
NEXT
if n < 1 then
FolderPath=Left(FPathi,2)
else
FolderPath=FPath
end if
else
Check = False
FolderPath=Inputbox(vbcrlf & "由于剪贴板中的路径无效," & vbcrlf & vbcrlf & "请手工输入你要去的路径:","输入文件夹路径-快速定位文件夹",FPathStr)
end if
If FolderPath=False Then WScript.Quit
FPathStr = UCase(FolderPath)
Loop Until Check = True
WshSHell.Run("""" & FolderPath & """")
End If
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0) |
|