Winclip版
Dim WshSHell,FSO
On Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WinVer = WshSHell.Environment("Process")
Set Args = WScript.Arguments
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)
InsPath = FSO.GetSpecialFolder(1)
InsFullName = FSO.BuildPath(InsPath ,FileName)
LnkPathNT = WshSHell.SpecialFolders(2)
LnkPath9X = WshSHell.SpecialFolders(14)
LnkPathAll = WshSHell.SpecialFolders("StartMenu")
OtherFileName="winclip.exe"
OtherFilePath=FSO.GetSpecialFolder(1)
TemFileName="无标题"
TemFilePath=FSO.GetSpecialFolder(2)
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:fty1995@163.com"
InsTitle="复制路径到剪贴板-Winclip版"
InsAnswer="复制路径到剪贴板"
RegPath1="HKEY_CLASSES_ROOT\*\shell\PathCopyEx_Winclip\"
RegValue1="复制路径到剪贴板"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\*\shell\PathCopyEx_Winclip\command\"
RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34)
RegForm2="REG_SZ"
RegPath3="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_Winclip\"
RegValue3="复制路径到剪贴板"
RegForm3="REG_SZ"
RegPath4="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_Winclip\command\"
RegValue4="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34)
RegForm4="REG_SZ"
RegPath9="HKEY_CLASSES_ROOT\Drive\shell\"
RegPath10="HKEY_CLASSES_ROOT\Directory\shell\"
RegValue13="open"
WshSHell.RegWrite RegPath9,RegValue13,RegForm1
WshSHell.RegWrite RegPath10,RegValue13,RegForm1
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
WshSHell.RegWrite RegPath3,RegValue3,RegForm3
WshSHell.RegWrite RegPath4,RegValue4,RegForm4
FSO.GetFile(FileFullName).Copy(InsFullName)
If (FSO.FileExists(FSO.BuildPath(FilePath,"winclip.llkj"))) Then
FSO.GetFile(FSO.BuildPath(FilePath,"winclip.llkj")).Copy(FSO.BuildPath(OtherFilePath,OtherFileName))
else
Call alltovbs
end if
FSO.GetFile(FSO.BuildPath(FilePath,"winclip.llkj")).Copy(FSO.BuildPath(OtherFilePath,OtherFileName))
WshSHell.popup _
"添加脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"添加执行文件："+chr(10)+FSO.BuildPath(OtherFilePath,OtherFileName)+chr(10)+chr(10)+ _
"添加注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+chr(34)+ RegPath3 +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 RegPath4
WshSHell.RegDelete RegPath3
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
FSO.DeleteFile InsFullName
FSO.DeleteFile FSO.BuildPath(OtherFilePath,OtherFileName)
WshSHell.popup _
"删除脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"删除执行文件："+chr(10)+FSO.BuildPath(OtherFilePath,OtherFileName)+chr(10)+chr(10)+ _
"删除注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+chr(34)+ RegPath3 +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
If (FSO.FileExists(FSO.BuildPath(OtherFilePath,OtherFileName))) Then
Set TempFile = FSO.CreateTextFile(FSO.BuildPath(TemFilePath ,TemFileName), True)
TempFile.WriteLine(Args(0))
TempFile.Close
WshSHell.Run (FSO.BuildPath(OtherFilePath,OtherFileName) & " -c " & FSO.BuildPath(TemFilePath ,TemFileName)), vbHide
else
WshSHell.popup +chr(10)+ _
"操作失败了!" +chr(10)+chr(10)+ _
"您的系统丢失文件 “Winclip.exe” ，因此您的操作请求未能成功。" + chr(10)+chr(10)+ _
"对此我们感到非常抱歉，重新执行安装程序可能会解决此问题。" + _
chr(10)+chr(10) & CloseTime & " 秒后本窗口自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "操作失败 - "+ InsTitle +" - "+ Copyright, 0 + 48
End If
End IF
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)
sub alltovbs()
'自生成Winclip.exe
end sub
