Board logo

标题: [原创] VBS版一键保存代码为批处理工具 [打印本页]

作者: youxi01    时间: 2009-3-18 23:44     标题: VBS版一键保存代码为批处理工具

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

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


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

源代码:
  1. <!--////////程序说明/////////====
  2. Intro  在某网页上选取部分文字,可以将其内容保存为相应文件。
  3. FileName 网页文字保存工具
  4. Author  2laoshi(youxi01)
  5. Version  Beta1.0
  6. Web  http://www.2laoshi.cn
  7. MadeTime 2009-3-17~
  8. <!--//////////设置hta格式////////////-->
  9. <HTA:APPLICATION
  10. SCROLL="no"
  11. MaximizeButton="no"
  12. MinimizeButton="no"
  13. INNERBORDER="no"
  14. SHOWINTASKBAR="yes"
  15. SINGLEINSTANCE="yes"
  16. BORDER="thin"
  17. />
  18. <style type="text/css">
  19. a:link {color: blue}
  20. a:visited {color: blue}
  21. body  {background: #EEEEEE}
  22. fieldset {border :1px solid #BEBEBE;width:98%;height:80px;padding:1px;}
  23. legend {color:red;font-size:14px;margin-bottom:4px;}
  24. button {
  25. height:23px;
  26. padding:2px 0 2px 0;
  27. margin:0 2px 0 0;
  28. }
  29. .text {
  30. background-color:#EEEEEF;
  31. color:Green;
  32. }
  33. #btContainer {
  34. width:100%;
  35. text-align:center;
  36. padding:5px 0 3px 0;
  37. margin-bottom:8px;
  38. }
  39. .footer {
  40. text-align:center;
  41. margin:4px;
  42. font-size:14px;
  43. }
  44. </style>
  45. <script language="vbscript">
  46. Function CHKclick()
  47. tagID=window.event.srcElement.ID
  48. set TagR=document.getElementbyid("text"&tagID)
  49. if document.getElementbyid(tagID).checked then
  50. TagR.style.background="white"
  51. TagR.disabled=false
  52. else
  53. TagR.style.background="#EEEEEF"
  54. TagR.disabled=True
  55. end if
  56. End Function
  57. </script>
  58. <title>网页文字保存工具</title>
  59. <fieldset>
  60. <legend>默认设置</legend>
  61. <input type=checkbox ID="1" onclick=CHKclick> 更改默认 路径 <input type=text size=22 title="设置文件默认保存路径,如:F:\" class="text" disabled id="text1">
  62. <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>
  63. </fieldset>
  64. <div id="btcontainer">
  65. <button onclick=UnInstall>卸载本工具</button>
  66. <button onclick=savefile>保存设置</button>
  67. <button onclick=self.close>退出</button>
  68. </div>
  69. <p class="footer"><a href="http://www.2laoshi.cn/post/165.html">详细使用说明</a></p>
  70. <p class="footer">欢迎光临:<a href="http://www.2laoshi.cn" title="教师教育博客站">爱老师网</a></p>
  71. <SCRIPT LANGUAGE = "vbScript">
  72. on error resume next
  73. set WSH=CreateObject("Wscript.shell")
  74. set FSO=CreateObject("Scripting.FileSystemObject")
  75. '/*配置文件;
  76. FullName=Replace(window.location.href,"file:///","")
  77. FullName=Replace(FullName,"/","\")
  78. optionFile=fso.getfile(FullName).parentfolder&"SaveText.ini"
  79. if not (fso.fileexists(optionFile)) then
  80. fso.createtextfile(optionFile)
  81. Set f = fso.OpenTextFile(optionFile, 2, True)
  82. f.Write "FilePath="&chr(34)&chr(34)&vbcrlf
  83. f.Write "FileName="&chr(34)&"SaveText.txt"&chr(34)&vbcrlf
  84. f.Close
  85. end if
  86. '/*读取配置文件内容;
  87. Set f = fso.OpenTextFile(optionFile, 1, True)
  88. do while f.atendofline<>true
  89. execute f.readline
  90. loop
  91. f.close
  92. FSRegPath="HKCU\Software\Microsoft\Internet Explorer\MenuExt\保存选定文字\"
  93. width=360
  94. height=220
  95. window.resizeTo width,height
  96. ileft=(window.screen.width-width)/2
  97. itop=(window.screen.height-height)/2      
  98. window.moveTo ileft,itop
  99. Sub Install
  100. WSH.regwrite FSRegPath,FullName,"REG_SZ"
  101. WSH.regwrite FSRegPath&"\Contexts","243","REG_DWORD"   
  102. text1.value=FilePath
  103. text2.value=FileName  
  104. End Sub
  105. Sub UnInstall
  106. WSH.RegDelete FSRegPath
  107. FSO.deletefile(OptionFile)
  108. msgbox "卸载成功!",vbexclamation,"提示"
  109. End Sub
  110. Function AddFolder()
  111. Const WH = 0
  112. Const OPTIONS = &H10&  
  113. Set objShell = CreateObject("Shell.Application")
  114. Set objFolder = objShell.BrowseForFolder (WH,"文章保存路径",OPTIONS,".")
  115. If objFolder is Nothing Then
  116. Exit Function
  117. End If
  118. AddFolder=objFolder.Self.Path
  119. End Function
  120. set oWindow = window.external.menuArguments
  121. if not err.number=424 then
  122. fileValue=oWindow.document.selection.createRange().text
  123. if FilePath="" then FilePath=AddFolder
  124. if FileName="" then FileName="SaveText.txt"
  125. FileName=split(FileName,".")
  126. for i=1 to 100   
  127.     if not fso.FileExists(filepath&"\"&FileName(0)&" "&i&"."&FileName(1)) then
  128.   NewFile=FileName(0)&" "&i&"."&FileName(1)
  129.   exit for
  130.     end if
  131. next
  132. set f=FSO.createtextfile(filepath&NewFile)
  133. f.write fileValue
  134. f.close
  135. alert("文件已经保存为:"&filepath&NewFile)
  136. else
  137. Install()
  138. end if
  139. Sub SaveFile
  140. if text1.value="" then
  141. Set f = fso.OpenTextFile(optionFile, 2, True)
  142. f.Write "FilePath="&chr(34)&chr(34)&vbcrlf
  143. f.Write "FileName="&chr(34)&text2.value&chr(34)&vbcrlf
  144. f.Close
  145. alert("保存成功!")
  146. exit sub
  147. end if
  148. if right(text1.value,1)<>"\" then
  149. FilePath=text1.value&"\"
  150. else
  151. FilePath=text1.value
  152. end if
  153. if not fso.folderexists(FilePath) then
  154. alert("请输入一个存在的合法路径")
  155. else
  156. Set f = fso.OpenTextFile(optionFile, 2, True)
  157. f.Write "FilePath="&chr(34)&FilePath&chr(34)&vbcrlf
  158. f.Write "FileName="&chr(34)&text2.value&chr(34)&vbcrlf
  159. f.Close
  160. alert("保存成功!")
  161. end if
  162. End Sub
  163. Sub Window_onunload
  164. set WSH=nothing
  165. set FSO=nothing
  166. End Sub
  167. </script>
复制代码

作者: 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了…顶一个




欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2