本帖最后由 9zhmke 于 2016-5-10 23:32 编辑
有时从网上下载到新的电影，却没有中文字幕，好不容易找到个字幕却是英文版的，太郁闷了，怒之，遂写了此脚本，机译虽然看起来有些吃力，但大体上可以看懂意思了，这翻译质量不好的问题可不是我能解决的。程序原理是调用谷哥的翻译功能，仅调用了英翻汉功能，如果需要其他语言改起来应该不难,为便于修改，使用了VBS来写，随时随地可修改..... 信息反馈可于本贴跟贴，或者发到原贴：http://bbs.dp168.com/thread-108654-1-1.html
1、生成程序：把下列语句存于一个纯文本文件（比如用你系统的“记事本”粘贴进去再存成“字幕翻译.vbs”即可使用。
2、使用方法：把英文字幕的“.srt”文件用鼠标拖到这个程序上松手即可开始自动翻译，翻译完成后自动生成一个同名文件的汉字字幕文件。- '[程序开始]
-
- lang="en"
- Interval="________________"
- 'lang="bs" '波斯尼亚
- Dim WshShell,file_name,ping_time,str,val(5000,3),reg,wmi,tran_temp
- Set WshShell=WScript.CreateObject("WScript.Shell")
- Set objFSO = CreateObject("Scripting.FileSystemObject")
- Set objShell = CreateObject("Shell.Application") '建立Shell.Applciation 对象
- Set Shell=CreateObject("Shell.Application")
- Set objArgs=WScript.Arguments'取得拖入的文件名
- on error resume next
- Set wmiService = GetObject("winmgmts:\\.\root\cimv2") '关闭内存中未完全退出占用小于8M的IE
- Set wmiObjects = wmiService.ExecQuery("SELECT * FROM Win32_process where caption='iexplore.exe'")
- if wmiObjects.count > 0 then
- For Each wmiObject In wmiObjects
- if (wmiObject.workingsetsize/1048576) < 80 then wmiObject.terminate()
- next
- End if
- file_name=""
- if objArgs(0)=Empty then file_name="No"
- WshShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Window Title","","REG_SZ" '去除标题栏后IE说明
- ping_time=600
- Set objWMI = GetObject("winmgmts:\\.")
- Set colPings = objWMI.ExecQuery ("Select * From Win32_PingStatus where Address = '" & "translate.google.cn" & "'")
- For Each objPing in colPings
- ping_time=objPing.ResponseTime+0
- Next
- if not isnumeric(ping_time) then ping_time=60
- if ping_time >500 then msgbox "翻译服务器太慢，请改时段翻译":Wscript.Quit
- on error goto 0
- start_time=now()
- if file_name="No" then msgbox "未找到匹配文件，请拖动字幕文件到本程序。":Wscript.Quit
- set ie=wscript.createobject("internetexplorer.application","event_") '创建ie对象'
- Set google = WScript.CreateObject("InternetExplorer.Application")
- google.visible = 0
- WshShell.RegDelete "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Window Title"'恢复IE标题栏说明为Internet Exporer
- 'ie.fullscreen=0:ie.menubar=0:ie.addressbar=0:ie.toolbar=0:ie.statusbar=0:ie.resizable=1
- ' 不使用全屏 '取消菜单栏 '取消地址栏 '取消工具栏 '取消状态栏 '允许用户改变窗口大小
- ie.width=500:ie.height=500:ie.top=2:ie.navigate "about:blank" '宽 高 打开空白页面
- ie.document.write "<html><head><title> - 字幕英翻汉程序</title></head><body>"
- ie.document.write "<div id=right> "
- ie.document.write "<a target=_BLANK href=http://bbs.dp168.com/thread-108654-1-1.html style=font-size:12px;>论坛</a></div><br>"
- set wnd=ie.document.parentwindow '设置wnd为窗口对象'
- set id=ie.document.all '设置id为document中全部对象的集合'
- tmp1=InstrRev(objArgs(0),".")-1 '计算中间应使用的中文字幕文件名
- if tmp1>0 then
- if instr(objArgs(0),"eng") then
- file_name=replace(objArgs(0),"eng","chs")
- else
- file_name=left(objArgs(0),tmp1) & ".chs" & right(objArgs(0),len(objArgs(0))-tmp1)
- end if
- else
- file_name=objArgs(0) & "chs.txt"
- end if
- on error resume next
- objFSO.deletefile file_name,true
- on error goto 0
- txt=""
- Set tmp1 = objFSO.OpenTextFile (objArgs(0),1) '打开英文字幕原始文件准备读取
- txt = trim(tmp1.ReadAll) & vbCrLf & vbCrLf '读所有进内存
- set tmp1=nothing
- for i=1 to 3 '修正头部出错
- line=mid(txt,i,1)
- if asc(line)=31 then exit for
- next
- txt="1" & vbCrLf & right(txt,len(txt)-i)
- reg=split(txt,vbCrLf)'在内存中提取已读入的注册表关键字并放入reg
- srt_line=UBound(reg)
- count=1
-
- ie.document.write " <textarea rows=15 cols=35 id=txt></textarea>"
- ie.visible=1 '窗口可见
- Set tmp2=objFSO.OpenTextFile(file_name,8,True,-1) '打开TXT准备写入
- block=1
- for i=0 to srt_line '翻译开始:读一行处理一行
- old_i=i:old_count=count
- for j=i to srt_line '从当前到最后，检索序号
- if IsNumeric(reg(i)) then if cint(reg(i))=count then exit for
- i=i+1
- next '出循环时已找到第count句
- i=i+1:if i>srt_line then exit for
- on error resume next
- while instr(reg(i),"-->")=0 and i<srt_line
- i=i+1
- wend'如果行号是第i，并且下行有表示时间轴的"-->"则后面是文字
- on error goto 0
- val(count,0)=reg(i)'出循环时已找到有"-->"的时间轴
-
- i=i+1:str=""
- if i>srt_line and count<2 then
- if count<2 then
- ie.document.write "这个字幕格式不能被识别:<br>" & file_name & "。<br>"
- Wscript.Quit
- end if
- exit for
- end if
- for j=i to srt_line-1
- str=str & reg(j) & vbCrLf
- if IsNumeric(reg(j+1)) then if int(reg(j+1))=count+1 then exit for
- next
- str=Del_Enter(str,3) '删除多余回车换行：左1中2右3左中4左右5中右6全部7
- '此处应增加判断无空格回车替换成带空格回车，以在翻译时不会把前后两个单词连在一起翻译不出来。
- '句点后无空格的要增加空格，否则翻译会出错。
- val(count,1)=str
- if (i+1)>srt_line or (j+1)>srt_line then exit for
- count=count+1
- next
- '已读入内存，准备翻译
- for i=1 to count
- str=""
- for j=i to i+20
- if val(j,1)>"" then
- str=str & Interval & " " & val(j,1) & vbCrLf
- end if
- next
- str=str & Interval & "______"
- str=replace(str,"<","<"):str=replace(str,">",">")
- tmp_trans=trans(str)
- tran_temp=split(tmp_trans,"______________")
- 'msgbox tran_temp(1) & "|||" & tran_temp(UBound(tran_temp))& "|||" & tmp_trans
- str=""'j序列号；val(j,0)时间线；val（j,1)原文；tran_temp
- for j=0 to UBound(tran_temp)-1'j序列号；val(j,0)时间线；val（j,1)原文；tran_temp
- str=str & i+j & vbCrLf & val(i+j,0) & vbCrLf & val(i+j,1) & vbCrLf
- str=str & tran_temp(j+1) & vbCrLf & vbCrLf
- next
- i=i+20
- ie.document.getElementById("txt").value= str
- tmp2.write(str)
- next
-
- tmp2.write(vbCrLf & vbCrLf)
- tmp2.close
- i=datediff("s",start_time,now()) :if i>60 then j=(i mod 60) & "分" & int(i/60) & "秒" else j=i & "秒"
- k=int(i/(count-1)*100)/100:if k<1 then k="0" & k
- j=j & "平均" & k & "秒"
- ie.document.write "<br><br> 翻译" & count & "句用了" & j & "，请直接"
- ie.document.write "关闭本窗口。<br> 已生成" & file_name & "。<br><br><br>"
- ie.document.parentwindow.scrollby 0,150
- Wscript.Quit
-
-
-
-
-
- '使用谷歌翻译对应的句子，请注意之前使用了以下几句
- 'Set google = WScript.CreateObject("InternetExplorer.Application")
- 'google.visible = false
- 'ping_time=600
- 'Set objWMI = GetObject("winmgmts:\\.")
- 'Set colPings = objWMI.ExecQuery ("Select * From Win32_PingStatus where Address = '" & "translate.google.cn" & "'")
- 'For Each objPing in colPings
- ' ping_time=objPing.ResponseTime+0
- 'Next
- 'if not isnumeric(ping_time) then ping_time=60
- 'if ping_time >500 then msgbox "翻译服务器太慢，请改时段翻译":Wscript.Quit
- FunctiOn trans(str_in)
- dim str_out,strURL,tmpval,txt
- if trim(str_in)="" then trans="翻译字符串不能为空":Exit Function
- str_in=trim(replace(str_in,vbCrLf," " & vbCrLf))
- strURL=trim(replace(str_in," ","%20"))
- strURL = "http://translate.google.cn/?sl=auto&tl=zh-CN#"& lang & "/zh-CN/" & strURL & ""
- google.navigate strURL
- trans="":str_out="":tmpval=0:txt=""
- on error resume next
- while instr(trans,Interval)=0
- txt=ie.document.documentElement.outerHTML
- if txt="" then Wscript.Quit
- wscript.sleep ping_time
- trans = google.document.body.innerText
- wend
- wscript.sleep ping_time *2
- wscript.sleep 180
- trans = google.document.body.innerText
- on error goto 0
- tmpval=len(trans)-instr(trans,"您也可以直接上传文档")
- trans=right(trans,tmpval)
- tmpval=len(trans)-instr(trans,Interval)
- trans=right(trans,tmpval+1)
- 'ie.document.getElementById("txt").value= trans
- trans=left(trans,instr(trans,Interval & "______")-1)
- trans=replace(trans,"_ ","_")
- trans=replace(trans,"_，","_")
- trans=replace(trans,Interval,"______________")
- trans=replace(trans,"_______________","______________")
- 'ie.document.getElementById("txt").value= trans
- End Function
-
- FunctiOn Del_Enter(str,del_attrib) '删除多余回车换行：左1中2右3左中4左右5中右6全部7
- str=trim(str)
- if del_attrib=2 or del_attrib=4 or del_attrib=6 or del_attrib=7 then
- while len(str)>len(replace(str,vbCrLf & vbCrLf,vbCrLf))'合并中间多余的回车或换行成一行
- str=replace(str,vbCrLf & vbCrLf,vbCrLf)
- str=trim(str)
- wend
- end if
- if del_attrib=1 or del_attrib=4 or del_attrib=5 or del_attrib=7 then
- while left(str,1)=chr(10) or left(str,1)=chr(13) '删除左边的回车或换行
- str=right(str,len(str)-1)
- wend
- end if
- if del_attrib=3 or del_attrib=5 or del_attrib=6 or del_attrib=7 then
- while right(str,1)=chr(10) or right(str,1)=chr(13) '删除右边的回车或换行
- str=left(str,len(str)-1)
- wend
- end if
- Del_Enter=str
- End Function
- '[程序结束]
|
发表于 2016-1-13 23:19
| 
发表于 2016-5-11 17:39
| 