2016-5-10更新字幕翻译专用软件VBS编制目前只能用于英文字幕转汉字
[i=s] 本帖最后由 9zhmke 于 2016-5-10 23:32 编辑 [/i]有时从网上下载到新的电影，却没有中文字幕，好不容易找到个字幕却是英文版的，太郁闷了，怒之，遂写了此脚本，机译虽然看起来有些吃力，但大体上可以看懂意思了，这翻译质量不好的问题可不是我能解决的。程序原理是调用谷哥的翻译功能，仅调用了英翻汉功能，如果需要其他语言改起来应该不难,为便于修改，使用了VBS来写，随时随地可修改..... 信息反馈可于本贴跟贴，或者发到原贴：[url]http://bbs.dp168.com/thread-108654-1-1.html[/url]
1、生成程序：把下列语句存于一个纯文本文件（比如用你系统的“记事本”粘贴进去再存成“字幕翻译.vbs”即可使用。
2、使用方法：把英文字幕的“.srt”文件用鼠标拖到这个程序上松手即可开始自动翻译，翻译完成后自动生成一个同名文件的汉字字幕文件。[code]
'[程序开始]
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
'[程序结束]
[/code] 工具很实用，谢谢分享。 两个ID都是6位随机字符？ [quote]两个ID都是6位随机字符？
[size=2][color=#999999]523066680 发表于 2016-5-11 17:39[/color] [url=http://www.bathome.net/redirect.php?goto=findpost&pid=185856&ptid=39062][img]http://www.bathome.net/images/common/back.gif[/img][/url][/size][/quote]
你说的是哪两个ID？ 顺便再给个你的Python地址方便不？这段时间正在学。
页:
[1]