复制路径到剪贴板→VBS版 - 中国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("")
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("")
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

第16楼　baomaboy	发表于 2007-04-13 14:02
银牌会员　发帖 554　积分 1,513
DLL版 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("") 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("") 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