中国DOS联盟论坛

中国DOS联盟

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

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

游客:  注册 | 登录 | 命令行 | 搜索 | 上传 | 帮助 »
中国DOS联盟论坛 » DOS批处理 & 脚本技术(批处理室) » 求3742668版主的SendTo+(VBS版).rar
English/Chinese Fix Translation
作者:
标题: 求3742668版主的SendTo+(VBS版).rar 上一主题 | 下一主题
ccwan
金牌会员




积分 2725
发帖 1160
注册 2006-9-23
来自 河北廊坊
状态 离线
『楼 主』:  求3742668版主的SendTo+(VBS版).rar 使用 LLM 解释/回答一下

各位,3742668版主的SendTo+(VBS版).rar链接好像无效了,相信大家都下了吧,请无私上传一下,谢谢。




三人行,必有吾师焉。 学然后知不足,教然后知困,然后能自强也。
2006-11-16 02:08
查看资料  发送邮件  发短消息  网志   编辑帖子  回复  引用回复
lxmxn
版主




积分 11386
发帖 4938
注册 2006-7-23
状态 离线
『第 2 楼』:   使用 LLM 解释/回答一下

去看看有没有。
http://zhenlove.com.cn/cndos/fileup/files/SendTo+.zip


2006-11-16 02:35
查看资料  发送邮件  发短消息  网志   编辑帖子  回复  引用回复
ccwan
金牌会员




积分 2725
发帖 1160
注册 2006-9-23
来自 河北廊坊
状态 离线
『第 3 楼』:   使用 LLM 解释/回答一下

多谢lxmxn兄,不过这好像不是vbs版的。




三人行,必有吾师焉。 学然后知不足,教然后知困,然后能自强也。
2006-11-16 02:51
查看资料  发送邮件  发短消息  网志   编辑帖子  回复  引用回复
lxmxn
版主




积分 11386
发帖 4938
注册 2006-7-23
状态 离线
『第 4 楼』:   使用 LLM 解释/回答一下


  哦,VBS版的我没有收藏,搜索下试试~~


2006-11-16 04:06
查看资料  发送邮件  发短消息  网志   编辑帖子  回复  引用回复
ccwan
金牌会员




积分 2725
发帖 1160
注册 2006-9-23
来自 河北廊坊
状态 离线
『第 5 楼』:   使用 LLM 解释/回答一下

有劳费心了。




三人行,必有吾师焉。 学然后知不足,教然后知困,然后能自强也。
2006-11-16 04:30
查看资料  发送邮件  发短消息  网志   编辑帖子  回复  引用回复
3742668
荣誉版主





积分 2013
发帖 718
注册 2006-2-18
状态 离线
『第 6 楼』:   使用 LLM 解释/回答一下

1.安装.vbs
On Error Resume Next
strCurrentPath = CreateObject("Scripting.FileSystemObject") _
.GetFile(WScript.ScriptFullName).ParentFolder
Set objShell = CreateObject("WScript.Shell")
strPath = objShell.SpecialFolders("SendTo")

'安装快捷方式部分
strPathQuick = strPath & "\快捷方式"
CreateDir strPathQuick
strPrefix = "填加到 "
strSourceFile = strCurrentPath & "\快捷方式.vbs"
CreateLink strPathQuick,strPrefix,strSourceFile,"快速启动",165
CreateLink strPathQuick,strPrefix,strSourceFile,"开始菜单",39
CreateLink strPathQuick,strPrefix,strSourceFile,"收藏夹",43
CreateLink strPathQuick,strPrefix,strSourceFile,"其他文件夹",4

'安装打开文件夹部分
strPathOpen = strPath & "\打开目录"
CreateDir strPathOpen
strPrefix = "打开 "
strSourceFile = strCurrentPath & "\打开文件夹.vbs"
CreateLink strPathOpen,strPrefix,strSourceFile,"控制面板",21
CreateLink strPathOpen,strPrefix,strSourceFile,"我的文档",126
CreateLink strPathOpen,strPrefix,strSourceFile,"收藏夹",43
CreateLink strPathOpen,strPrefix,strSourceFile,"启动",130
CreateLink strPathOpen,strPrefix,strSourceFile,"最近打开的文档",20
CreateLink strPathOpen,strPrefix,strSourceFile,"发送到",137
CreateLink strPathOpen,strPrefix,strSourceFile,"网上邻居",17
CreateLink strPathOpen,strPrefix,strSourceFile,"Windows",38
CreateLink strPathOpen,strPrefix,strSourceFile,"System32",27
CreateLink strPathOpen,strPrefix,strSourceFile,"程序",36
CreateLink strPathOpen,strPrefix,strSourceFile,"当前用户根目录",170
CreateLink strPathOpen,"",strSourceFile,"添加当前目录",4
CreateLink strPathOpen,"",strSourceFile,"移除当前目录",4
Function CreateDir(strPath)

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateFolder(strPath)
CreateDir = f.Path

End Function

Sub CreateLink(strPath,strPrefix,strSourceFile,strArg,intIconNumber)

strFullName = strPath & "\" & strPrefix & strArg & ".lnk"
strArg = Chr(34) & strSourceFile & Chr(34) & Space(1) & strArg

With CreateObject("WScript.Shell").CreateShortcut(strFullName) '快捷方式完整路径
.TargetPath = WScript.FullName '源文件,这里应该是wscript.exe
.Arguments = strArg '参数
' .WindowStyle = 1 '运行方式
' .Hotkey = "" '快捷键
.IconLocation = "shell32.dll," & intIconNumber '图标
' .Description = "" '备注
' .WorkingDirectory = "" '起始目录
.Save
End With

End Sub


2.打开文件夹.vbs
    On Error Resume Next
Set objArgs = WScript.Arguments
If objArgs.Count < 1 Then WScript.Quit
arrArgs = Array("IE","所有程序","控制面板","打印机和传真", _
"我的文档","收藏夹","启动","最近打开的文档","发送到", _
"回收站","开始菜单","暂缺","我的音乐","我的视频", _
"暂缺","桌面","我的电脑","网上邻居","NetHood", _
"字体","Templates","AllUser开始菜单","AllUser所有程序",_
"AllUser启动","AllUser桌面","MY_AppData","PrintHood", _
"MY_AppData2","暂缺","暂缺","AllUser收藏夹","IE缓存", _
"Cookies","历史记录","AllUserAppData","Windows","System32", _
"程序","我的图片","当前用户根目录","公共组件","暂缺",_
"暂缺","暂缺","AllUserTemplates","共享文档", _
"AllUserManagement","管理工具","网络连接","暂缺","暂缺", _
"暂缺","AllUserMusic","AllUserPictures","AllUserVideos", _
"桌面主题","Resources2","none","CD_Burning")
For i = 0 To UBound(arrArgs)
If UCase(arrArgs(i)) = UCase(objArgs(0)) Then
intNumber = i + 1
End If
Next

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(intNumber)
Set objFolderItem = objFolder.Self
If Err.Number <> 0 Then
If UCase(objArgs(0)) = UCase("添加当前目录") Then
AddCurrentFolder(objArgs(1))
ElseIf UCase(objArgs(0)) = UCase("移除当前目录") Then
DelCurrentFolder(objArgs(1))
Else
objShell.Open objArgs(0)
'WScript.Quit
End If
End If
objShell.Open objFolderItem.Path


Sub AddCurrentFolder(str)

On Error Resume Next
strSendTo = CreateObject("Shell.Application").Namespace(9).Self.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Set objFile = fso.GetFile(str)
If Err.Number <> 0 Then
Set objDir = fso.GetFolder(str)
strPath = objDir.Path
strName = objDir.Name
Else
strPath = objFile.ParentFolder.Path
strName = objFile.ParentFolder.Name
End If

strFullName = strSendTo & "\打开目录\打开 " & strName & ".lnk"

With CreateObject("WScript.Shell").CreateShortcut(strFullName)
.TargetPath = WScript.FullName
.Arguments = Chr(34) & WScript.ScriptFullName & Chr(34) & _
Space(1) & Chr(34) & strPath & Chr(34)
.IconLocation = "shell32.dll,4"
.Save
End With

End Sub


Sub DelCurrentFolder(str)
On Error Resume Next
strSendTo = CreateObject("Shell.Application").Namespace(9).Self.Path

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")

Set objFile = fso.GetFile(str)
If Err.Number <> 0 Then
Set objDir = fso.GetFolder(str)
strPath = objDir.Path
Else
strPath = objFile.ParentFolder.Path
End If
Set objFolder = fso.GetFolder(strSendTo & "\打开目录")
For Each i In objFolder.Files
Set objLink = objShell.CreateShortcut(i)
If objLink.Arguments = Chr(34) & WScript.ScriptFullName & _
Chr(34) & Space(1) & Chr(34) & strPath & Chr(34) Then
fso.DeleteFile i

End If
Next


End Sub



3.快捷方式.vbs
On Error Resume Next
Set objArgs = WScript.Arguments
If objArgs.Count < 1 Then WScript.Quit

intBeganArg = 1
strPath = GetSystemFolder(objArgs(0))
If Len(Trim(strPath)) = 0 Then
If objArgs(0) = "快速启动" Then
strPath = GetQuickLaunch()
Else
intBeganArg = 0
strPath = GetDirectory()
End If
End If

For i = intBeganArg To objArgs.Count - 1
CreateLink strPath,objArgs(i)
Next

'************************************************************************************
'创建快捷方式
'************************************************************************************
Sub CreateLink(strPath,strFile)

On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(strFile)
If Err.Number <> 0 Then
Set f = fso.GetFile(strFile)
strLinkName = Mid(f.Name,1,InStrRev(f.Name,".")-1)
Else
strLinkName = f.Name
End If

If Len(Trim(strLinkName)) = 0 Or Len(Trim(strFile)) = 0 Then Exit Sub
Set objShell = CreateObject("WScript.Shell")
With objShell.CreateShortcut(strPath &"\" & strLinkName & ".lnk") '存放目录及文件名
.TargetPath = strFile '指向的可执行文件
' .WindowStyle = 1 '运行方式
' .Hotkey = "" '快捷键
' .IconLocation = "c:\xxx\xxx, 0" '图标
' .Description = "" '备注
' .WorkingDirectory = "" '起始目录
.Save
End With
End Sub


'************************************************************************************
'弹出窗口选择目录
'************************************************************************************
Function GetDirectory()

Const MY_COMPUTER = &H10

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(0, "选择文件夹:", 0, strPath)

If objFolder Is Nothing Then
WScript.Quit
End If

Set objFolderItem = objFolder.Self
GetDirectory = objFolderItem.Path

End Function

'************************************************************************************
'获得快速启动的路径
'************************************************************************************
Function GetQuickLaunch()

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(40)
Set objFolderItem = objFolder.Self
GetQuickLaunch = objFolderItem.Path
GetQuickLaunch = GetQuickLaunch & _
"\Application Data\Microsoft\Internet Explorer\Quick Launch"
' Set objNetwork = CreateObject("Wscript.Network")
' strUserName = objNetwork.UserName
' Set fso = CreateObject("Scripting.FileSystemObject")
' Set f = fso.GetFolder(objShell.SpecialFolders(Favorites))
' GetQuickLaunch = f.ParentFolder.ParentFolder & "\" &strUserName & _
' "\Application Data\Microsoft\Internet Explorer\Quick Launch"

End Function

'************************************************************************************
'获得系统文件夹
'************************************************************************************
Function GetSystemFolder(str)

arrArgs = Array("IE","所有程序","控制面板","打印机和传真", _
"我的文档","收藏夹","启动","最近打开的文档","发送到", _
"回收站","开始菜单","暂缺","我的音乐","我的视频", _
"暂缺","桌面","我的电脑","网上邻居","NetHood", _
"字体","Templates","AllUser开始菜单","AllUser所有程序",_
"AllUser启动","AllUser桌面","MY_AppData","PrintHood", _
"MY_AppData2","暂缺","暂缺","AllUser收藏夹","IE缓存", _
"Cookies","历史记录","AllUserAppData","Windows","System32", _
"程序","我的图片","当前用户根目录","公共组件","暂缺",_
"暂缺","暂缺","AllUserTemplates","共享文档", _
"AllUserManagement","管理工具","网络连接","暂缺","暂缺", _
"暂缺","AllUserMusic","AllUserPictures","AllUserVideos", _
"桌面主题","Resources2","none","CD_Burning")
For i = 0 To UBound(arrArgs)
If UCase(arrArgs(i)) = UCase(str) Then
intNumber = i + 1
End If
Next

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(intNumber)
Set objFolderItem = objFolder.Self
GetSystemFolder = objFolderItem.Path

End Function


注意:脚本中有小bug,不过不影响使用。等到有了好的创意后再重写代码。


2006-11-16 13:39
查看资料  发送邮件  发短消息  网志   编辑帖子  回复  引用回复
ccwan
金牌会员




积分 2725
发帖 1160
注册 2006-9-23
来自 河北廊坊
状态 离线
『第 7 楼』:   使用 LLM 解释/回答一下

非常感谢3742668版主,很有价值。




三人行,必有吾师焉。 学然后知不足,教然后知困,然后能自强也。
2006-11-16 21:20
查看资料  发送邮件  发短消息  网志   编辑帖子  回复  引用回复
wydos
中级用户





积分 304
发帖 117
注册 2006-4-4
状态 离线
『第 8 楼』:   使用 LLM 解释/回答一下

太好了!先收下了!回去慢慢研究!


2006-11-16 21:47
查看资料  发送邮件  发短消息  网志  OICQ (327337973)  编辑帖子  回复  引用回复
hxuan999
中级用户

DOS之日


积分 337
发帖 161
注册 2006-11-4
状态 离线
『第 9 楼』:   使用 LLM 解释/回答一下

收下了




for /f %%h in (`echo hxuan`) do for /f %%x in (`echo hxuan`) do if %%h==%%x nul
2006-11-23 02:22
查看资料  发送邮件  发短消息  网志  OICQ (33899867)  编辑帖子  回复  引用回复
jianyaogao
初级用户




积分 49
发帖 22
注册 2005-8-4
状态 离线
『第 10 楼』:   使用 LLM 解释/回答一下

keep it. Thanks


2007-3-17 20:58
查看资料  发送邮件  发短消息  网志   编辑帖子  回复  引用回复
slore
铂金会员





积分 5212
发帖 2478
注册 2007-2-8
状态 离线
『第 11 楼』:   使用 LLM 解释/回答一下

貌似没见一个Set xxx=Nothing?


2007-3-18 01:59
查看资料  发短消息  网志   编辑帖子  回复  引用回复
fnlwg
新手上路





积分 4
发帖 2
注册 2006-8-23
状态 离线
『第 12 楼』:   使用 LLM 解释/回答一下

感谢,终于找到了~~~


2007-4-7 05:53
查看资料  发短消息  网志   编辑帖子  回复  引用回复
SunRiseBoy
初级用户





积分 38
发帖 20
注册 2006-7-4
状态 离线
『第 13 楼』:   使用 LLM 解释/回答一下

下载收藏,非常好的工具


2007-6-28 23:46
查看资料  发短消息  网志   编辑帖子  回复  引用回复
wert123
中级用户





积分 301
发帖 135
注册 2007-5-15
状态 离线
『第 14 楼』:   使用 LLM 解释/回答一下

好啊~~
收下了


2007-6-29 09:00
查看资料  发短消息  网志   编辑帖子  回复  引用回复

请注意:您目前尚未注册或登录,请您注册登录以使用论坛的各项功能,例如发表和回复帖子等。


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



论坛跳转: