复制路径到剪贴板→VBS版 - 中国DOS联盟论坛

忘了是从哪得到的PathCopyEx.DLL文件，注册后会在右键菜单中多出一项“复制路径到剪贴板”，日常路径复制操作中确实方便快捷了很多，后来我仿制了功能相同的其它4个版本的“复制路径到到剪贴板”。

①PathCopyEx_DLL原版，只要注册了PathCopyEx.DLL，右键菜单就会出现。
http://zhenlove.com.cn/cndos/fileup/files/PathCopyEx_DLL.rar

②PathCopyEx_Excel.rar，仿制版，缺点是需要EXCEL支持。
http://zhenlove.com.cn/cndos/fileup/files/PathCopyEx_Excel.rar

③PathCopyEx_IE.rar，仿制版，缺点是需要IE支持。
http://zhenlove.com.cn/cndos/fileup/files/PathCopyEx_IE.rar

④PathCopyEx_Notepad.rar，仿制版，优点是无需另外安装支持程序，只需要有记事本功能和wscript这都是系统自带且默认安装的。缺点是操作过程中有记事本窗口闪过。
http://zhenlove.com.cn/cndos/fileup/files/PathCopyEx_Notepad.rar

⑤PathCopyEx_Winclip.rar，仿制版，缺点是需要第三方Winclip的支持。
http://zhenlove.com.cn/cndos/fileup/files/PathCopyEx_Winclip.rar

[ Last edited by baomaboy on 2007-3-18 at 10:50 AM ]

还是IE版最爽。偶一直用。

Originally posted by electronixtar at 2007-3-18 12:39:
还是IE版最爽。偶一直用。

electronixtar兄用IE版不知遇到过这种情况没，

我安装了Maxthon且是默认的，当我开着Maxthon窗口时再运行IE版的复制路径就会打开一个Maxthon的空白页窗口（about:blank），运行一次开一个，真是让人郁闷。

Originally posted by baomaboy at 2007-3-18 12:48:

electronixtar兄用IE版不知遇到过这种情况没，

我安装了Maxthon且是默认的，当我开着Maxthon窗口时再运行IE版的复制路径就会打开一个Maxthon的空白页窗口（about:blank），运行一次开一个，真是让人郁闷。

当然遇到啦。解决方法：
1. 改MT的配置文件。

2. 用其他的object。不过目前还暂时没有成熟方法。兄有兴趣可以论坛全文搜索 htmlfile 和 about:blank

Originally posted by electronixtar at 2007-3-18 12:51:

当然遇到啦。解决方法：
1. 改MT的配置文件。

2. 用其他的object。不过目前还暂时没有成熟方法。兄有兴趣可以论坛全文搜索 htmlfile 和 about:blank

原来早有解决办法了谢谢兄了

我下不了文件，贴个IE版的我看看

http://www.cn-dos.net/forum/viewthread.php?tid=24064

http://www.cn-dos.net/forum/viewthread.php?tid=22649

http://www.cn-dos.net/forum/viewthread.php?tid=20933

另外你可以加这个群哈，34021244，里面全是及其牛X的人物，其中9527的WMI和 ADSI 达到了高深莫测的地步，要多多向他学习 vbs。9527 和当年的 kevin1986 都是相当的猛啊。论坛里的前版主 3742668 也是高手中的高手，可惜现在他不上线……

electronixtar兄，我这里下不了上传系统的文件，贴个IE版的我看看

Originally posted by zh159 at 2007-3-18 13:25:
electronixtar兄，我这里下不了上传系统的文件，贴个IE版的我看看

Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
str = objIE.document.parentwindow.clipboardData.GetData("text")
WScript.Echo str

这段是显示剪贴板内容？

Originally posted by zh159 at 2007-3-18 13:35:
这段是显示剪贴板内容？

objIE.document.parentwindow.clipboardData.SetData "text", strCopy

strCopy是已取得的字符串

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

Notepa版


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="复制路径到剪贴板-Notepad版"
InsAnswer="复制路径到剪贴板"
RegPath1="HKEY_CLASSES_ROOT\*\shell\PathCopyEx_Notepad\"
RegValue1="复制路径到剪贴板"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\*\shell\PathCopyEx_Notepad\command\"
RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34)
RegForm2="REG_SZ"
RegPath3="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_Notepad\"
RegValue3="复制路径到剪贴板"
RegForm3="REG_SZ"
RegPath4="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_Notepad\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)
WshSHell.popup _
"添加脚本文件："+chr(10)+InsFullName+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
WshSHell.popup _
"删除脚本文件："+chr(10)+InsFullName+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(FSO.GetSpecialFolder(0) ,"Notepad.exe"))) or (FSO.FileExists(FSO.BuildPath(FSO.GetSpecialFolder(0) ,"Notepad.exe"))) Then
Set TempFile = FSO.CreateTextFile(FSO.BuildPath(TemFilePath ,TemFileName), True)
TempFile.WriteLine(Args(0))
TempFile.Close
WshSHell.Run ("Notepad.exe " & FSO.BuildPath(TemFilePath ,TemFileName))
WScript.Sleep 230
If WshSHell.AppActivate(TemFileName & " - 记事本") = True Then
WshSHell.Sendkeys "^{a}^{c}"
WshSHell.Sendkeys "%FX"
else
WshSHell.AppActivate(TemFileName & " - 记事本")
WScript.Sleep 200
WshSHell.Sendkeys "^{a}^{c}"
WshSHell.Sendkeys "%FX"
End If
Else
WshSHell.popup +chr(10)+ _
"操作失败了!" +chr(10)+chr(10)+ _
"您的系统没有安装 Notepad ，因此您的操作请求未能成功！" + 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)

IE版


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="复制路径到剪贴板-IE版"
InsAnswer="复制路径到剪贴板"
RegPath1="HKEY_CLASSES_ROOT\*\shell\PathCopyEx_IE\"
RegValue1="复制路径到剪贴板"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\*\shell\PathCopyEx_IE\command\"
RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34)
RegForm2="REG_SZ"
RegPath3="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_IE\"
RegValue3="复制路径到剪贴板"
RegForm3="REG_SZ"
RegPath4="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_IE\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)
WshSHell.popup _
"添加脚本文件："+chr(10)+InsFullName+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
WshSHell.popup _
"删除脚本文件："+chr(10)+InsFullName+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
Dim objIE
Set objIE = WScript.CreateObject("InternetExplorer.Application")
if objIE is Nothing then
WshSHell.popup +chr(10)+ _
"操作失败了!" +chr(10)+chr(10)+ _
"检测到您的系统没有安装 InternetExplorer ，因此您的操作请求未能成功！" + _
chr(10)+chr(10) & CloseTime & " 秒后本窗口自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C)  " + Copyright +"   " & QQ &"   " + Email _
, CloseTime, "操作失败 - "+ InsTitle +" - "+ Copyright, 0 + 48
else
objIE.Visible = False
strCopy = Args(0)
objIE.Navigate("about:blank") 
objIE.document.parentwindow.clipboardData.SetData "text", strCopy
Set objIE = Nothing
end if
End IF
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)

Excel版


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="复制路径到剪贴板-Excel版"
InsAnswer="复制路径到剪贴板"
RegPath1="HKEY_CLASSES_ROOT\*\shell\PathCopyEx_Excel\"
RegValue1="复制路径到剪贴板"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\*\shell\PathCopyEx_Excel\command\"
RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34)
RegForm2="REG_SZ"
RegPath3="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_Excel\"
RegValue3="复制路径到剪贴板"
RegForm3="REG_SZ"
RegPath4="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_Excel\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)
WshSHell.popup _
"添加脚本文件："+chr(10)+InsFullName+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
WshSHell.popup _
"删除脚本文件："+chr(10)+InsFullName+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
Dim objXL
Set objXL = WScript.CreateObject("Excel.Application")
if objXL is Nothing then
WshSHell.popup +chr(10)+ _
"操作失败了!" +chr(10)+chr(10)+ _
"检测到您的系统没有安装 Excel ，因此您的操作请求未能成功！" + _
chr(10)+chr(10) & CloseTime & " 秒后本窗口自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C)  " + Copyright +"   " & QQ &"   " + Email _
, CloseTime, "操作失败 - "+ InsTitle +" - "+ Copyright, 0 + 48
else
objXL.Visible = False
objXL.CutCopyMode = False
objXL.WorkBooks.Add
objXL.Range("A1").Value = Args(0)
objXL.Range("A1").Select
objXL.Range("A1").copy
objXL.DisplayAlerts = False
objXL.WorkBooks.Close
objXL.Quit
objXL.DisplayAlerts = True
Set objXL = Nothing
end if
End IF
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)

第1楼　baomaboy	发表于 2007-03-18 10:46
银牌会员　发帖 554　积分 1,513
复制路径到剪贴板→VBS版忘了是从哪得到的PathCopyEx.DLL文件，注册后会在右键菜单中多出一项“复制路径到剪贴板”，日常路径复制操作中确实方便快捷了很多，后来我仿制了功能相同的其它4个版本的“复制路径到到剪贴板”。 ①PathCopyEx_DLL原版，只要注册了PathCopyEx.DLL，右键菜单就会出现。 http://zhenlove.com.cn/cndos/fileup/files/PathCopyEx_DLL.rar ②PathCopyEx_Excel.rar，仿制版，缺点是需要EXCEL支持。 http://zhenlove.com.cn/cndos/fileup/files/PathCopyEx_Excel.rar ③PathCopyEx_IE.rar，仿制版，缺点是需要IE支持。 http://zhenlove.com.cn/cndos/fileup/files/PathCopyEx_IE.rar ④PathCopyEx_Notepad.rar，仿制版，优点是无需另外安装支持程序，只需要有记事本功能和wscript这都是系统自带且默认安装的。缺点是操作过程中有记事本窗口闪过。 http://zhenlove.com.cn/cndos/fileup/files/PathCopyEx_Notepad.rar ⑤PathCopyEx_Winclip.rar，仿制版，缺点是需要第三方Winclip的支持。 http://zhenlove.com.cn/cndos/fileup/files/PathCopyEx_Winclip.rar [ Last edited by baomaboy on 2007-3-18 at 10:50 AM ]

第2楼　electronixtar	发表于 2007-03-18 12:39
铂金会员　发帖 2,672　积分 7,493
还是IE版最爽。偶一直用。

第3楼　baomaboy	发表于 2007-03-18 12:48
银牌会员　发帖 554　积分 1,513
Originally posted by electronixtar at 2007-3-18 12:39: 还是IE版最爽。偶一直用。 electronixtar兄用IE版不知遇到过这种情况没，我安装了Maxthon且是默认的，当我开着Maxthon窗口时再运行IE版的复制路径就会打开一个Maxthon的空白页窗口（about:blank），运行一次开一个，真是让人郁闷。

第4楼　electronixtar	发表于 2007-03-18 12:51
铂金会员　发帖 2,672　积分 7,493
Originally posted by baomaboy at 2007-3-18 12:48: electronixtar兄用IE版不知遇到过这种情况没，我安装了Maxthon且是默认的，当我开着Maxthon窗口时再运行IE版的复制路径就会打开一个Maxthon的空白页窗口（about:blank），运行一次开一个，真是让人郁闷。当然遇到啦。解决方法： 1. 改MT的配置文件。 2. 用其他的object。不过目前还暂时没有成熟方法。兄有兴趣可以论坛全文搜索 htmlfile 和 about:blank

第5楼　baomaboy	发表于 2007-03-18 12:54
银牌会员　发帖 554　积分 1,513
Originally posted by electronixtar at 2007-3-18 12:51: 当然遇到啦。解决方法： 1. 改MT的配置文件。 2. 用其他的object。不过目前还暂时没有成熟方法。兄有兴趣可以论坛全文搜索 htmlfile 和 about:blank 原来早有解决办法了谢谢兄了

第6楼　zh159	发表于 2007-03-18 12:56
金牌会员　发帖 1,467　积分 3,687
我下不了文件，贴个IE版的我看看

第7楼　electronixtar	发表于 2007-03-18 12:59
铂金会员　发帖 2,672　积分 7,493
http://www.cn-dos.net/forum/viewthread.php?tid=24064 http://www.cn-dos.net/forum/viewthread.php?tid=22649 http://www.cn-dos.net/forum/viewthread.php?tid=20933 另外你可以加这个群哈，34021244，里面全是及其牛X的人物，其中9527的WMI和 ADSI 达到了高深莫测的地步，要多多向他学习 vbs。9527 和当年的 kevin1986 都是相当的猛啊。论坛里的前版主 3742668 也是高手中的高手，可惜现在他不上线……

第8楼　zh159	发表于 2007-03-18 13:25
金牌会员　发帖 1,467　积分 3,687
electronixtar兄，我这里下不了上传系统的文件，贴个IE版的我看看

第9楼　baomaboy	发表于 2007-03-18 13:28
银牌会员　发帖 554　积分 1,513
Originally posted by zh159 at 2007-3-18 13:25: electronixtar兄，我这里下不了上传系统的文件，贴个IE版的我看看 Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate("about:blank") str = objIE.document.parentwindow.clipboardData.GetData("text") WScript.Echo str

第10楼　zh159	发表于 2007-03-18 13:35
金牌会员　发帖 1,467　积分 3,687
这段是显示剪贴板内容？

第11楼　baomaboy	发表于 2007-03-18 13:41
银牌会员　发帖 554　积分 1,513
Originally posted by zh159 at 2007-3-18 13:35: 这段是显示剪贴板内容？ objIE.document.parentwindow.clipboardData.SetData "text", strCopy strCopy是已取得的字符串

第12楼　baomaboy	发表于 2007-04-13 13:46
银牌会员　发帖 554　积分 1,513
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

第13楼　baomaboy	发表于 2007-04-13 13:48
银牌会员　发帖 554　积分 1,513
Notepa版 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="复制路径到剪贴板-Notepad版" InsAnswer="复制路径到剪贴板" RegPath1="HKEY_CLASSES_ROOT\\shell\PathCopyEx_Notepad\" RegValue1="复制路径到剪贴板" RegForm1="REG_SZ" RegPath2="HKEY_CLASSES_ROOT\\shell\PathCopyEx_Notepad\command\" RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34) RegForm2="REG_SZ" RegPath3="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_Notepad\" RegValue3="复制路径到剪贴板" RegForm3="REG_SZ" RegPath4="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_Notepad\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) WshSHell.popup _ "添加脚本文件："+chr(10)+InsFullName+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 WshSHell.popup _ "删除脚本文件："+chr(10)+InsFullName+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(FSO.GetSpecialFolder(0) ,"Notepad.exe"))) or (FSO.FileExists(FSO.BuildPath(FSO.GetSpecialFolder(0) ,"Notepad.exe"))) Then Set TempFile = FSO.CreateTextFile(FSO.BuildPath(TemFilePath ,TemFileName), True) TempFile.WriteLine(Args(0)) TempFile.Close WshSHell.Run ("Notepad.exe " & FSO.BuildPath(TemFilePath ,TemFileName)) WScript.Sleep 230 If WshSHell.AppActivate(TemFileName & " - 记事本") = True Then WshSHell.Sendkeys "^{a}^{c}" WshSHell.Sendkeys "%FX" else WshSHell.AppActivate(TemFileName & " - 记事本") WScript.Sleep 200 WshSHell.Sendkeys "^{a}^{c}" WshSHell.Sendkeys "%FX" End If Else WshSHell.popup +chr(10)+ _ "操作失败了!" +chr(10)+chr(10)+ _ "您的系统没有安装 Notepad ，因此您的操作请求未能成功！" + 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)

第14楼　baomaboy	发表于 2007-04-13 13:50
银牌会员　发帖 554　积分 1,513
IE版 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="复制路径到剪贴板-IE版" InsAnswer="复制路径到剪贴板" RegPath1="HKEY_CLASSES_ROOT\\shell\PathCopyEx_IE\" RegValue1="复制路径到剪贴板" RegForm1="REG_SZ" RegPath2="HKEY_CLASSES_ROOT\\shell\PathCopyEx_IE\command\" RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34) RegForm2="REG_SZ" RegPath3="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_IE\" RegValue3="复制路径到剪贴板" RegForm3="REG_SZ" RegPath4="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_IE\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) WshSHell.popup _ "添加脚本文件："+chr(10)+InsFullName+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 WshSHell.popup _ "删除脚本文件："+chr(10)+InsFullName+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 Dim objIE Set objIE = WScript.CreateObject("InternetExplorer.Application") if objIE is Nothing then WshSHell.popup +chr(10)+ _ "操作失败了!" +chr(10)+chr(10)+ _ "检测到您的系统没有安装 InternetExplorer ，因此您的操作请求未能成功！" + _ chr(10)+chr(10) & CloseTime & " 秒后本窗口自动关闭!" +chr(10)+chr(10)+ _ chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _ , CloseTime, "操作失败 - "+ InsTitle +" - "+ Copyright, 0 + 48 else objIE.Visible = False strCopy = Args(0) objIE.Navigate("about:blank") objIE.document.parentwindow.clipboardData.SetData "text", strCopy Set objIE = Nothing end if End IF Set WshSHell = Nothing Set FSO = Nothing Set Args = Nothing WScript.Quit(0)

第15楼　baomaboy	发表于 2007-04-13 13:51
银牌会员　发帖 554　积分 1,513
Excel版 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="复制路径到剪贴板-Excel版" InsAnswer="复制路径到剪贴板" RegPath1="HKEY_CLASSES_ROOT\\shell\PathCopyEx_Excel\" RegValue1="复制路径到剪贴板" RegForm1="REG_SZ" RegPath2="HKEY_CLASSES_ROOT\\shell\PathCopyEx_Excel\command\" RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34) RegForm2="REG_SZ" RegPath3="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_Excel\" RegValue3="复制路径到剪贴板" RegForm3="REG_SZ" RegPath4="HKEY_CLASSES_ROOT\Directory\shell\PathCopyEx_Excel\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) WshSHell.popup _ "添加脚本文件："+chr(10)+InsFullName+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 WshSHell.popup _ "删除脚本文件："+chr(10)+InsFullName+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 Dim objXL Set objXL = WScript.CreateObject("Excel.Application") if objXL is Nothing then WshSHell.popup +chr(10)+ _ "操作失败了!" +chr(10)+chr(10)+ _ "检测到您的系统没有安装 Excel ，因此您的操作请求未能成功！" + _ chr(10)+chr(10) & CloseTime & " 秒后本窗口自动关闭!" +chr(10)+chr(10)+ _ chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _ , CloseTime, "操作失败 - "+ InsTitle +" - "+ Copyright, 0 + 48 else objXL.Visible = False objXL.CutCopyMode = False objXL.WorkBooks.Add objXL.Range("A1").Value = Args(0) objXL.Range("A1").Select objXL.Range("A1").copy objXL.DisplayAlerts = False objXL.WorkBooks.Close objXL.Quit objXL.DisplayAlerts = True Set objXL = Nothing end if End IF Set WshSHell = Nothing Set FSO = Nothing Set Args = Nothing WScript.Quit(0)