中国DOS联盟论坛

中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名：www.cn-dos.net  论坛域名：www.cn-dos.net/forum
DOS，代表着自由开放与发展，我们努力起来，学习FreeDOS和Linux的自由开放与GNU精神，共同创造和发展美好的自由与GNU GPL世界吧！

游客:  注册 | 登录 | 命令行 | 会员 | 搜索 | 上传 | 帮助 »
中国DOS联盟论坛 » DOS批处理 & 脚本技术（批处理室） » 复制路径到剪贴板→VBS版
« [1] [2] » ›
作者:
标题: 复制路径到剪贴板→VBS版 上一主题 | 下一主题
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『楼 主』:  复制路径到剪贴板→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 ]

2007-3-18 10:46
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
electronixtar
铂金会员





积分 7493
发帖 2672
注册 2005-9-2
状态 离线
『第 2 楼』:  

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




C:\>BLOG http://initiative.yo2.cn/
C:\>hh.exe ntcmds.chm::/ntcmds.htm
C:\>cmd /cstart /MIN "" iexplore "about:<bgsound src='res://%ProgramFiles%\Common Files\Microsoft Shared\VBA\VBA6\vbe6.dll/10/5432'>"
2007-3-18 12:39
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 3 楼』:  



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

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

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

2007-3-18 12:48
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
electronixtar
铂金会员





积分 7493
发帖 2672
注册 2005-9-2
状态 离线
『第 4 楼』:  



  Quote:
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




C:\>BLOG http://initiative.yo2.cn/
C:\>hh.exe ntcmds.chm::/ntcmds.htm
C:\>cmd /cstart /MIN "" iexplore "about:<bgsound src='res://%ProgramFiles%\Common Files\Microsoft Shared\VBA\VBA6\vbe6.dll/10/5432'>"
2007-3-18 12:51
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 5 楼』:  



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


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

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

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

2007-3-18 12:54
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
zh159
金牌会员




积分 3687
发帖 1467
注册 2005-8-8
状态 离线
『第 6 楼』:  

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

2007-3-18 12:56
查看资料  发短消息 网志   编辑帖子  回复  引用回复
electronixtar
铂金会员





积分 7493
发帖 2672
注册 2005-9-2
状态 离线
『第 7 楼』:  

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 也是高手中的高手，可惜现在他不上线……




C:\>BLOG http://initiative.yo2.cn/
C:\>hh.exe ntcmds.chm::/ntcmds.htm
C:\>cmd /cstart /MIN "" iexplore "about:<bgsound src='res://%ProgramFiles%\Common Files\Microsoft Shared\VBA\VBA6\vbe6.dll/10/5432'>"
2007-3-18 12:59
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
zh159
金牌会员




积分 3687
发帖 1467
注册 2005-8-8
状态 离线
『第 8 楼』:  

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

2007-3-18 13:25
查看资料  发短消息 网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 9 楼』:  



  Quote:
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

2007-3-18 13:28
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
zh159
金牌会员




积分 3687
发帖 1467
注册 2005-8-8
状态 离线
『第 10 楼』:  

这段是显示剪贴板内容？

2007-3-18 13:35
查看资料  发短消息 网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 11 楼』:  



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

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

strCopy是已取得的字符串

2007-3-18 13:41
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 12 楼』:  

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




好多菩提树，好多明镜台。本来好多物，好多的尘埃。
2007-4-13 13:46
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 13 楼』:  

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)




好多菩提树，好多明镜台。本来好多物，好多的尘埃。
2007-4-13 13:48
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 14 楼』:  

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)




好多菩提树，好多明镜台。本来好多物，好多的尘埃。
2007-4-13 13:50
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 15 楼』:  

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)




好多菩提树，好多明镜台。本来好多物，好多的尘埃。
2007-4-13 13:51
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
« [1] [2] » ›
请注意：您目前尚未注册或登录，请您注册或登录以使用论坛的各项功能，例如发表和回复帖子等。


可打印版本 | 推荐给朋友 | 订阅主题 | 收藏主题



论坛跳转:  



[ 联系联盟系统管理团队 - 中国DOS联盟 ]

Sponsored by ifanr Inc | © 2001-2023