眉山东坡论坛

 找回密码
 注册账号

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 4803|回复: 4
收起左侧

[精品软件] 2016年5月10日更新字幕翻译专用VBS程序[暂只有英文转中文]

[复制链接]
发表于 2016-1-3 18:36 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转东坡论坛

您需要 登录 才可以下载或查看,没有帐号?注册账号

x
有时从网上下载到新的电影,却没有中文字幕,好不容易找到个字幕却是英文版的。于是上网寻找字幕翻译软件,却被告之需要安装JAVA虚拟机,我有系统洁癖最不喜欢装一抹多东西,太郁闷了,怒之,遂写了此脚本,本程序是绿色版,体积轻小,内容可用任意编辑器修改,诸位看高兴了还可以加上自己的版权信息谓之自己编制...
程序原理是调用谷哥的翻译功能,仅调用了英翻汉功能,如果需要其他语言请回贴说明一下,改起来应该不难。虽然翻译质量上比不得人工翻译,但谷哥翻译也在逐渐进步,感觉尚可,理解意思肯定是没问题的了。

1、生成程序:把下列语句存于一个纯文本文件(比如用你系统的“记事本”粘贴进去再存成“字幕翻译.vbs”即可使用
2、使用方法:把英文字幕的“.srt”文件用鼠标拖到这个程序上松手即可开始自动翻译,翻译完成后自动生成一个同名文件的汉字字幕文件。


一楼程序不完善,已进一步改进稳定性和速度,最新版在5楼
最新版也可以点这里下载: 字幕英翻汉脚本ok.rar (3.81 KB, 下载次数: 81)
发表于 2016-1-7 11:58 | 显示全部楼层
专业了点

点评

不算专业吧,我编辑下做个下载,这下你可以不用复制生成文件了。  详情 回复 发表于 2016-1-10 00:09
回复

使用道具 举报

 楼主| 发表于 2016-1-10 00:09 | 显示全部楼层

不算专业吧,我编辑下做个下载,这下你可以不用复制生成文件了。
发表于 2016-3-6 10:52 | 显示全部楼层
这个有用!
回复

使用道具 举报

 楼主| 发表于 2016-5-10 23:25 | 显示全部楼层
快来参与金币拍卖吧

  1. '有时从网上下载到新的电影,却没有中文字幕,好不容易找到个字幕却是英文版的,太郁闷了,怒之,遂写了此脚本。
  2. '程序原理是调用谷哥的翻译功能,仅调用了英翻汉功能,如果需要其他语言请回贴说明一下,改起来应该不难。
  3. '为便于修改,使用了VBS来写,随时随地可修改.....
  4. '使用方法是把“英文字幕.srt”用鼠标拖到这个程序上松手即可开始自动翻译。
  5. '[程序开始]
  6. lang="en"
  7. Interval="________________"
  8. 'lang="bs" '波斯尼亚
  9. Dim WshShell,file_name,ping_time,str,val(5000,3),reg,wmi,tran_temp
  10. Set WshShell=WScript.CreateObject("WScript.Shell")
  11. Set objFSO = CreateObject("Scripting.FileSystemObject")
  12. Set objShell = CreateObject("Shell.Application") '建立Shell.Applciation 对象
  13. Set Shell=CreateObject("Shell.Application")
  14. Set objArgs=WScript.Arguments'取得拖入的文件名
  15. on error resume next
  16.     Set wmiService = GetObject("winmgmts:\\.\root\cimv2") '关闭内存中未完全退出占用小于8M的IE
  17.     Set wmiObjects = wmiService.ExecQuery("SELECT * FROM Win32_process where caption='iexplore.exe'")
  18.     if wmiObjects.count > 0 then
  19.         For Each wmiObject In wmiObjects
  20.             if (wmiObject.workingsetsize/1048576) < 80 then wmiObject.terminate()
  21.         next
  22.     End if
  23.     file_name=""
  24.     if objArgs(0)=Empty then file_name="No"
  25.     WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Window Title","","REG_SZ" '去除标题栏后IE说明
  26.     ping_time=600
  27.     Set objWMI = GetObject("winmgmts:\\.")
  28.     Set colPings = objWMI.ExecQuery ("Select * From Win32_PingStatus where Address = '" & "translate.google.cn" & "'")
  29.     For Each objPing in colPings
  30.         ping_time=objPing.ResponseTime+0
  31.     Next
  32.     if not isnumeric(ping_time) then ping_time=60
  33.     if ping_time >500 then msgbox "翻译服务器太慢,请改时段翻译":Wscript.Quit
  34. on error goto 0
  35. start_time=now()
  36. if file_name="No" then msgbox "未找到匹配文件,请拖动字幕文件到本程序。":Wscript.Quit
  37. set ie=wscript.createobject("internetexplorer.application","event_") '创建ie对象'
  38. Set google = WScript.CreateObject("InternetExplorer.Application")
  39. google.visible = 0
  40. WshShell.RegDelete "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Window Title"'恢复IE标题栏说明为Internet Exporer
  41. 'ie.fullscreen=0:ie.menubar=0:ie.addressbar=0:ie.toolbar=0:ie.statusbar=0:ie.resizable=1
  42. ' 不使用全屏   '取消菜单栏   '取消地址栏     '取消工具栏  '取消状态栏 '允许用户改变窗口大小
  43. ie.width=500:ie.height=500:ie.top=2:ie.navigate "about:blank" '宽 高 打开空白页面
  44. ie.document.write "<html><head><title> - 字幕英翻汉程序</title></head><body>"
  45. ie.document.write "<div id=right>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
  46. ie.document.write "<a target=_BLANK href=http://bbs.dp168.com/thread-108654-1-1.html style=font-size:12px;>论坛</a></div><br>"
  47. set wnd=ie.document.parentwindow '设置wnd为窗口对象'
  48. set id=ie.document.all '设置id为document中全部对象的集合'
  49. tmp1=InstrRev(objArgs(0),".")-1 '计算中间应使用的中文字幕文件名
  50. if tmp1>0 then
  51.     if instr(objArgs(0),"eng") then
  52.         file_name=replace(objArgs(0),"eng","chs")
  53.     else
  54.         file_name=left(objArgs(0),tmp1) & ".chs" & right(objArgs(0),len(objArgs(0))-tmp1)
  55.     end if
  56. else
  57.     file_name=objArgs(0) & "chs.txt"
  58. end if
  59. on error resume next
  60.     objFSO.deletefile file_name,true
  61. on error goto 0
  62. txt=""
  63. Set tmp1 = objFSO.OpenTextFile (objArgs(0),1) '打开英文字幕原始文件准备读取
  64. txt = trim(tmp1.ReadAll) & vbCrLf & vbCrLf '读所有进内存
  65. set tmp1=nothing
  66. for i=1 to 3 '修正头部出错
  67.     line=mid(txt,i,1)
  68.     if asc(line)=31 then exit for
  69. next
  70. txt="1" & vbCrLf & right(txt,len(txt)-i)
  71. reg=split(txt,vbCrLf)'在内存中提取已读入的注册表关键字并放入reg
  72. srt_line=UBound(reg)
  73. count=1
  74. ie.document.write "&nbsp;&nbsp;<textarea rows=15 cols=35 id=txt></textarea>"
  75. ie.visible=1   '窗口可见
  76. Set tmp2=objFSO.OpenTextFile(file_name,8,True,-1) '打开TXT准备写入
  77. block=1
  78. for i=0 to srt_line     '翻译开始:读一行处理一行
  79.     old_i=i:old_count=count
  80.     for j=i to srt_line '从当前到最后,检索序号
  81.              if IsNumeric(reg(i)) then if cint(reg(i))=count then exit for
  82.          i=i+1
  83.     next    '出循环时已找到第count句
  84.     i=i+1:if i>srt_line then exit for
  85.     on error resume next
  86.         while instr(reg(i),"-->")=0 and i<srt_line
  87.             i=i+1
  88.         wend'如果行号是第i,并且下行有表示时间轴的"-->"则后面是文字
  89.     on error goto 0
  90.     val(count,0)=reg(i)'出循环时已找到有"-->"的时间轴
  91.     i=i+1:str=""
  92.     if i>srt_line and count<2 then
  93.         if count<2 then
  94.             ie.document.write "这个字幕格式不能被识别:<br>" & file_name & "。<br>"
  95.             Wscript.Quit
  96.         end if
  97.         exit for
  98.     end if
  99.     for j=i to srt_line-1
  100.         str=str & reg(j) & vbCrLf
  101.         if IsNumeric(reg(j+1)) then if int(reg(j+1))=count+1 then exit for
  102.     next
  103.     str=Del_Enter(str,3) '删除多余回车换行:左1中2右3左中4左右5中右6全部7
  104. '此处应增加判断无空格回车替换成带空格回车,以在翻译时不会把前后两个单词连在一起翻译不出来。
  105. '句点后无空格的要增加空格,否则翻译会出错。
  106.     val(count,1)=str
  107.     if (i+1)>srt_line or (j+1)>srt_line then exit for
  108.     count=count+1
  109. next
  110. '已读入内存,准备翻译
  111. for i=1 to count
  112.     str=""
  113.     for j=i to i+20
  114.         if val(j,1)>"" then
  115.             str=str & Interval & " " & val(j,1) & vbCrLf
  116.         end if
  117.     next
  118.     str=str & Interval & "______"
  119.     str=replace(str,"&lt;","<"):str=replace(str,"&gt;",">")
  120.     tmp_trans=trans(str)
  121.     tran_temp=split(tmp_trans,"______________")
  122.     'msgbox tran_temp(1)  & "|||" & tran_temp(UBound(tran_temp))& "|||" & tmp_trans
  123.     str=""'j序列号;val(j,0)时间线;val(j,1)原文;tran_temp
  124.     for j=0 to UBound(tran_temp)-1'j序列号;val(j,0)时间线;val(j,1)原文;tran_temp
  125.         str=str & i+j & vbCrLf & val(i+j,0) & vbCrLf & val(i+j,1) & vbCrLf
  126.         str=str & tran_temp(j+1) & vbCrLf & vbCrLf
  127.     next
  128.     i=i+20
  129.     ie.document.getElementById("txt").value=  str
  130.     tmp2.write(str)
  131. next
  132. tmp2.write(vbCrLf & vbCrLf)
  133. tmp2.close
  134. i=datediff("s",start_time,now()) :if i>60 then j=(i mod 60) & "分" & int(i/60) & "秒" else j=i & "秒"
  135. k=int(i/(count-1)*100)/100:if k<1 then k="0" & k
  136. j=j & "平均" & k & "秒"
  137. ie.document.write "<br><br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;翻译" & count & "句用了" & j & ",请直接"
  138. ie.document.write "关闭本窗口。<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;已生成" & file_name & "。<br><br><br>"
  139. ie.document.parentwindow.scrollby 0,150
  140. Wscript.Quit


  141. '使用谷歌翻译对应的句子,请注意之前使用了以下几句
  142. 'Set google = WScript.CreateObject("InternetExplorer.Application")
  143. 'google.visible = false
  144. 'ping_time=600
  145. 'Set objWMI = GetObject("winmgmts:\\.")
  146. 'Set colPings = objWMI.ExecQuery ("Select * From Win32_PingStatus where Address = '" & "translate.google.cn" & "'")
  147. 'For Each objPing in colPings
  148. '    ping_time=objPing.ResponseTime+0
  149. 'Next
  150. 'if not isnumeric(ping_time) then ping_time=60
  151. 'if ping_time >500 then msgbox "翻译服务器太慢,请改时段翻译":Wscript.Quit
  152. FunctiOn trans(str_in)
  153.     dim str_out,strURL,tmpval,txt
  154.     if trim(str_in)="" then trans="翻译字符串不能为空":Exit Function
  155.     str_in=trim(replace(str_in,vbCrLf," " & vbCrLf))
  156.     strURL=trim(replace(str_in," ","%20"))
  157.     strURL = "[url=http://translate.google.cn/?sl=auto&tl=zh-CN]http://translate.google.cn/?sl=auto&tl=zh-CN[/url]#"& lang & "/zh-CN/" & strURL & ""
  158.     google.navigate strURL
  159.     trans="":str_out="":tmpval=0:txt=""
  160.     on error resume next
  161.         while instr(trans,Interval)=0
  162.             txt=ie.document.documentElement.outerHTML
  163.             if txt="" then Wscript.Quit
  164.             wscript.sleep ping_time
  165.             trans = google.document.body.innerText
  166.         wend
  167.         wscript.sleep ping_time *2
  168.         wscript.sleep 180
  169.         trans = google.document.body.innerText
  170.     on error goto 0
  171.     tmpval=len(trans)-instr(trans,"您也可以直接上传文档")
  172.     trans=right(trans,tmpval)
  173.     tmpval=len(trans)-instr(trans,Interval)
  174.     trans=right(trans,tmpval+1)
  175.     'ie.document.getElementById("txt").value=  trans
  176.     trans=left(trans,instr(trans,Interval & "______")-1)
  177.     trans=replace(trans,"_ ","_")
  178.     trans=replace(trans,"_,","_")
  179.     trans=replace(trans,Interval,"______________")
  180.     trans=replace(trans,"_______________","______________")
  181.     'ie.document.getElementById("txt").value=  trans
  182. End Function
  183. FunctiOn Del_Enter(str,del_attrib) '删除多余回车换行:左1中2右3左中4左右5中右6全部7
  184.     str=trim(str)
  185.     if del_attrib=2 or del_attrib=4 or del_attrib=6 or del_attrib=7 then
  186.         while len(str)>len(replace(str,vbCrLf & vbCrLf,vbCrLf))'合并中间多余的回车或换行成一行
  187.             str=replace(str,vbCrLf & vbCrLf,vbCrLf)
  188.             str=trim(str)
  189.         wend
  190.     end if
  191.     if del_attrib=1 or del_attrib=4 or del_attrib=5 or del_attrib=7 then
  192.         while left(str,1)=chr(10) or left(str,1)=chr(13) '删除左边的回车或换行
  193.             str=right(str,len(str)-1)
  194.         wend
  195.     end if
  196.     if del_attrib=3 or del_attrib=5 or del_attrib=6 or del_attrib=7 then
  197.         while right(str,1)=chr(10) or right(str,1)=chr(13) '删除右边的回车或换行
  198.             str=left(str,len(str)-1)
  199.         wend
  200.     end if
  201.     Del_Enter=str
  202. End Function
  203. '[程序结束]

复制代码

您需要登录后才可以回帖 登录 | 注册账号

本版积分规则

QQ|网站地图|关于我们|小黑屋|爱好群|眉山东坡论坛 ( 蜀ICP备05001993号-1 )

GMT+8, 2018-1-20 22:56

Powered by Discuz! X3.4 Licensed

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表