复制路径到剪贴板→VBS版 - DOS批处理 & 脚本技术（批处理室） - 中国DOS联盟论坛

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="PathCopyEx.dll"
OtherFilePath=FSO.GetSpecialFolder(1)
TemFileName = "PathCopyEx.reg"
TemFilePath = FSO.GetSpecialFolder(1)
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:fty1995@163.com"
InsTitle="复制路径到剪贴板-DLL版"
InsAnswer="复制路径到剪贴板"
RegPath1="HKEY_CLASSES_ROOT\*\shellex\ContextMenuHandlers\PathCopyMenu\"
RegPath2="HKEY_CLASSES_ROOT\Directory\shellex\ContextMenuHandlers\PathCopyMenu\"
IF FileFullName <> InsFullName then
intAnswer = MsgBox("【是】将“"+ InsAnswer +"”加入到右键菜单，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - "+ Copyright)
If intAnswer = vbYes Then
If (FSO.FileExists(FSO.BuildPath(OtherFilePath,OtherFileName))) Then
WshSHell.Run ("regsvr32 /s " & FSO.BuildPath(OtherFilePath,OtherFileName)), vbHide
Else
If (FSO.FileExists(FSO.BuildPath(FilePath,"PathCopyEx.llkj"))) Then
FSO.GetFile(FSO.BuildPath(FilePath,"PathCopyEx.llkj")).Copy(FSO.BuildPath(OtherFilePath,OtherFileName))
else
Call alltovbs
end if
WScript.Sleep 2000
WshSHell.Run ("regsvr32 /s " & FSO.BuildPath(OtherFilePath,OtherFileName)), vbHide
end if
WshSHell.popup _
"添加动态链接："+chr(10)+FSO.BuildPath(OtherFilePath,OtherFileName)+chr(10)+chr(10)+ _
"添加注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+chr(34)+ RegPath2 +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.Run ("regsvr32 /u /s " & FSO.BuildPath(OtherFilePath,OtherFileName)), vbHide
FSO.DeleteFile FSO.BuildPath(OtherFilePath,OtherFileName)
If (FSO.FileExists(FSO.BuildPath(OtherFilePath,OtherFileName))) Then
WshSHell.popup +chr(10)+ _
"链接库文件 "&FSO.BuildPath(OtherFilePath,OtherFileName)&" 正被系统占用，" + chr(10)+chr(10)+ _
"现在尝试重启Explorer后再删除。" + _
chr(10)+chr(10) & CloseTime & " 秒后本窗口自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C)  " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载过程 - "+ InsTitle +" - "+ Copyright, 0 + 64
If WinVer("OS") <> "Windows_NT" Then
WshSHell.Run ("RUNDLL32 SHELL32.DLL,SHExitWindowsEx -1"), vbHide
WScript.Sleep 3000
FSO.DeleteFile FSO.BuildPath(OtherFilePath,OtherFileName)
If (FSO.FileExists(FSO.BuildPath(OtherFilePath,OtherFileName))) Then''如重启explorer仍拒删，写入Wininit.ini下次启动时删除，用于winme
if (FSO.FileExists(FSO.BuildPath(FSO.GetSpecialFolder(0) ,"Wininit.ini"))) Then
Set OldFile = FSO.OpenTextFile(FSO.BuildPath(FSO.GetSpecialFolder(0) ,"Wininit.ini"), 8, True)
OldFile.WriteLine("")
OldFile.WriteLine("nul="&FSO.BuildPath(OtherFilePath,FSo.GetFile(FSO.BuildPath(OtherFilePath,OtherFileName)).ShortName))
OldFile.Close
else
Set NewFile = FSO.CreateTextFile(FSO.GetSpecialFolder(0) &"\Wininit.ini", True)
NewFile.WriteLine("[rename]")
NewFile.WriteLine("")
NewFile.WriteLine("nul="&FSO.BuildPath(OtherFilePath,FSo.GetFile(FSO.BuildPath(OtherFilePath,OtherFileName)).ShortName))
NewFile.Close
end if
if (FSO.FileExists(FSO.BuildPath(FSO.GetSpecialFolder(0) ,"winstart.bat"))) Then''如重启explorer仍拒删，写入winstart.bat下次启动时删除，用于win98
Set OldFile = FSO.OpenTextFile(FSO.BuildPath(FSO.GetSpecialFolder(0) ,"winstart.bat"), 8, True)
OldFile.WriteLine("")
OldFile.WriteLine("deltree /y "&FSO.BuildPath(OtherFilePath,FSo.GetFile(FSO.BuildPath(OtherFilePath,OtherFileName)).ShortName))
OldFile.WriteLine("@ del %0")
OldFile.Close
else
Set NewFile = FSO.CreateTextFile(FSO.GetSpecialFolder(0) &"\winstart.bat", True)
NewFile.WriteLine("@echo off")
NewFile.WriteLine("")
NewFile.WriteLine("deltree /y "&FSO.BuildPath(OtherFilePath,FSo.GetFile(FSO.BuildPath(OtherFilePath,OtherFileName)).ShortName))
NewFile.WriteLine("@ del %0")
NewFile.Close
end if
else
Call delok
end if
else
For Each Process in GetObject("winmgmts:"). _
ExecQuery ("select * from Win32_Process where name='explorer.exe'")
Process.terminate(0)
Next
WScript.Sleep 3000
FSO.DeleteFile FSO.BuildPath(OtherFilePath,OtherFileName)
WScript.Sleep 3000
for each ps in getobject _
("winmgmts:\\.\root\cimv2:win32_process").instances_
if LCase(ps.name)="explorer.exe" then
expl="yes"
exit for
else
expl="no"
end if
next
if expl="no" then
WshSHell.Run ("explorer.exe")
end if
If (FSO.FileExists(FSO.BuildPath(OtherFilePath,OtherFileName))) Then''如重启explorer仍拒删，写入注册表下次启动时删除，用于winxp
Set NewRegFile = FSO.CreateTextFile(FSO.BuildPath(TemFilePath ,TemFileName), True)
NewRegFile.WriteLine("Windows Registry Editor Version 5.00")
NewRegFile.WriteLine("")
NewRegFile.WriteLine("[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager]")
NewRegFile.WriteLine(chr(34)&"PendingFileRenameOperations"&chr(34)&"=hex(7):5c,00,3f,00,3f,00,5c,00,43,00,3a,00,5c,00,\")
NewRegFile.WriteLine("  57,00,49,00,4e,00,44,00,4f,00,57,00,53,00,5c,00,73,00,79,00,73,00,74,00,65,\")
NewRegFile.WriteLine("  00,6d,00,33,00,32,00,5c,00,50,00,61,00,74,00,68,00,43,00,6f,00,70,00,79,00,\")
NewRegFile.WriteLine("  45,00,78,00,2e,00,64,00,6c,00,6c,00,00,00,00,00")
NewRegFile.Close''可以用WMI创建多字符串值
WshSHell.Run ("regedit.exe /s "&FSO.BuildPath(TemFilePath ,TemFileName)), vbHide
else
Call delok
end if
end if
If (FSO.FileExists(FSO.BuildPath(OtherFilePath,OtherFileName))) Then
WshSHell.popup +chr(10)+ _
"链接库文件 "&FSO.BuildPath(OtherFilePath,OtherFileName)&" 正被系统占用，" + chr(10)+chr(10)+ _
"只能在系统重启后被删除。" + _
chr(10)+chr(10) & CloseTime & " 秒后本窗口自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C)  " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载成功 - "+ InsTitle +" - "+ Copyright, 0 + 64
end if
Else
Call delok
end if
End If
      If intAnswer = vbCancel Then
end if
End IF
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)
Sub delok()
WshSHell.popup _
"删除动态链接："+chr(10)+FSO.BuildPath(OtherFilePath,OtherFileName)+chr(10)+chr(10)+ _
"删除注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+chr(34)+ RegPath2 +chr(34)+chr(10) & chr(10) + _
chr(10)+chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C)  " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载成功 - "+ InsTitle +" - "+ Copyright, 0 + 64
End Sub
sub alltovbs()
'自生成PathCopyEx.Dll
end sub