批处理之家's Archiver

youxi01 发表于 2009-3-18 23:44

VBS版一键保存代码为批处理工具

在很早以前,网络上就流传着一段js代码,可以实现网页选定文字保存为文件的功能,它其实是由两个文件组成的,一个注册表文件,一个htm文件。它的基本作用原理如下:
先用注册表文件导入配置信息,控制网页右键菜单,该菜单命令指向上面的htm文件,该htm文件包含的js代码实现保存选定内容的功能。

本工具是在以上JS代码基础上,功能加强的vbs版本,新添加的功能有:
①利用hta的高权限,直接实现注册表的修改工作,从而实现功能文件单一化。也就是把所有的功能文件整合为一个hta文件。并且提供自身卸载功能,当不需要使用本工具时,可以轻松从注册表卸载相关配置信息。
②具有较好的用户交互界面,轻松实现用户的相关配置。包括:“使用默认保存路径",“默认文件名保存”,另外还支持用户自由选择保存路径;支持同系列文件名保存工作...


注意:本工具为试用版本,有何建议或意见请留言,谢谢。

源代码:[code]<!--////////程序说明/////////====
Intro  在某网页上选取部分文字,可以将其内容保存为相应文件。
FileName 网页文字保存工具
Author  2laoshi(youxi01)
Version  Beta1.0
Web  http://www.2laoshi.cn
MadeTime 2009-3-17~
<!--//////////设置hta格式////////////-->
<HTA:APPLICATION
SCROLL="no"
MaximizeButton="no"
MinimizeButton="no"
INNERBORDER="no"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
BORDER="thin"
/>
<style type="text/css">
a:link {color: blue}
a:visited {color: blue}
body  {background: #EEEEEE}
fieldset {border :1px solid #BEBEBE;width:98%;height:80px;padding:1px;}
legend {color:red;font-size:14px;margin-bottom:4px;}
button {
height:23px;
padding:2px 0 2px 0;
margin:0 2px 0 0;
}
.text {
background-color:#EEEEEF;
color:Green;
}
#btContainer {
width:100%;
text-align:center;
padding:5px 0 3px 0;
margin-bottom:8px;
}
.footer {
text-align:center;
margin:4px;
font-size:14px;
}
</style>
<script language="vbscript">
Function CHKclick()
tagID=window.event.srcElement.ID
set TagR=document.getElementbyid("text"&tagID)
if document.getElementbyid(tagID).checked then
TagR.style.background="white"
TagR.disabled=false
else
TagR.style.background="#EEEEEF"
TagR.disabled=True
end if
End Function
</script>
<title>网页文字保存工具</title>
<fieldset>
<legend>默认设置</legend>
<input type=checkbox ID="1" onclick=CHKclick> 更改默认 路径 <input type=text size=22 title="设置文件默认保存路径,如:F:\" class="text" disabled id="text1">
<p style="margin:8px 0 5px 0;"><input type=checkbox id=2 onclick=CHKclick>更改默认文件名 <input type=text size=22 title="设置文件命名规律,如:SaveText" class="text" disabled id=text2>
</fieldset>
<div id="btcontainer">
<button onclick=UnInstall>卸载本工具</button>
<button onclick=savefile>保存设置</button>
<button onclick=self.close>退出</button>
</div>
<p class="footer"><a href="http://www.2laoshi.cn/post/165.html">详细使用说明</a></p>
<p class="footer">欢迎光临:<a href="http://www.2laoshi.cn" title="教师教育博客站">爱老师网</a></p>
<SCRIPT LANGUAGE = "vbScript">
on error resume next
set WSH=CreateObject("Wscript.shell")
set FSO=CreateObject("Scripting.FileSystemObject")
'/*配置文件;
FullName=Replace(window.location.href,"file:///","")
FullName=Replace(FullName,"/","\")
optionFile=fso.getfile(FullName).parentfolder&"SaveText.ini"
if not (fso.fileexists(optionFile)) then
fso.createtextfile(optionFile)
Set f = fso.OpenTextFile(optionFile, 2, True)
f.Write "FilePath="&chr(34)&chr(34)&vbcrlf
f.Write "FileName="&chr(34)&"SaveText.txt"&chr(34)&vbcrlf
f.Close
end if
'/*读取配置文件内容;
Set f = fso.OpenTextFile(optionFile, 1, True)
do while f.atendofline<>true
execute f.readline
loop
f.close
FSRegPath="HKCU\Software\Microsoft\Internet Explorer\MenuExt\保存选定文字\"
width=360
height=220
window.resizeTo width,height
ileft=(window.screen.width-width)/2
itop=(window.screen.height-height)/2      
window.moveTo ileft,itop

Sub Install
WSH.regwrite FSRegPath,FullName,"REG_SZ"
WSH.regwrite FSRegPath&"\Contexts","243","REG_DWORD"   
text1.value=FilePath
text2.value=FileName  
End Sub
Sub UnInstall
WSH.RegDelete FSRegPath
FSO.deletefile(OptionFile)
msgbox "卸载成功!",vbexclamation,"提示"
End Sub
Function AddFolder()
Const WH = 0
Const OPTIONS = &H10&  
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder (WH,"文章保存路径",OPTIONS,".")
If objFolder is Nothing Then
Exit Function
End If
AddFolder=objFolder.Self.Path
End Function
set oWindow = window.external.menuArguments
if not err.number=424 then
fileValue=oWindow.document.selection.createRange().text
if FilePath="" then FilePath=AddFolder
if FileName="" then FileName="SaveText.txt"

FileName=split(FileName,".")
for i=1 to 100   
    if not fso.FileExists(filepath&"\"&FileName(0)&" "&i&"."&FileName(1)) then
  NewFile=FileName(0)&" "&i&"."&FileName(1)
  exit for
    end if
next
set f=FSO.createtextfile(filepath&NewFile)
f.write fileValue
f.close
alert("文件已经保存为:"&filepath&NewFile)
else
Install()
end if
Sub SaveFile
if text1.value="" then
Set f = fso.OpenTextFile(optionFile, 2, True)
f.Write "FilePath="&chr(34)&chr(34)&vbcrlf
f.Write "FileName="&chr(34)&text2.value&chr(34)&vbcrlf
f.Close
alert("保存成功!")
exit sub
end if

if right(text1.value,1)<>"\" then
FilePath=text1.value&"\"
else
FilePath=text1.value
end if
if not fso.folderexists(FilePath) then
alert("请输入一个存在的合法路径")
else
Set f = fso.OpenTextFile(optionFile, 2, True)
f.Write "FilePath="&chr(34)&FilePath&chr(34)&vbcrlf
f.Write "FileName="&chr(34)&text2.value&chr(34)&vbcrlf
f.Close
alert("保存成功!")
end if
End Sub
Sub Window_onunload
set WSH=nothing
set FSO=nothing
End Sub
</script>[/code]

youxi01 发表于 2009-3-29 12:17

想不到,自以为一个不错的工具,竟然落得这么“悲凉的命运”,我改个标题试试?

SmallK 发表于 2009-3-30 13:53

大概是vbs区本来就不怎么热闹的缘故吧~

lyunj520 发表于 2009-4-9 10:15

呵呵   大家注意力都在BAT了吧

lyunj520 发表于 2009-4-9 10:19

太深奥了  看不懂,这才是真正没人的原因吧

okkyy 发表于 2010-12-6 21:48

哇~~~
这东西好棒的
用了一下很是方便。
不过可否在修改成保存文件时无提示,还有就是在右键菜单里的“保存选定文字”后面加快捷键。

jikea 发表于 2010-12-10 12:04

我现在开始学习vbs了…顶一个

页: [1]

Powered by Discuz! Archiver 7.2  © 2001-2009 Comsenz Inc.