<%
'说明：该程序用于远程调用有道翻译接口中译英，http://fanyi.youdao.com/openapi.do?keyfrom=localhost&key=1204607085&type=data&doctype=xml&version=1.1&q="&toutf8(sytr_remx(i-1))&"里面的keyfrom，key可以在有道演绎里面申请，申请地址：http://fanyi.youdao.com/openapi?path=data-mode，那里有详细的讲解。
'点航科技技术支持，我们的网址：http://www.zgdhkj.com
'---------------------------主程序开始------------------------
Response.Charset="gb2312"
Response.AddHeader "Pragma","no-cache"
Response.AddHeader "cache-ctrol","no-cache"
Session.CodePage=936
dim sytr_ntxt
function FSOlinedit(filename,lineNum)
if linenum < 1 then exit function
dim fso,f,tempID,temparray,tempcnt
set fso = server.CreateObject("scripting.filesystemobject")
if not fso.fileExists(server.mappath(filename)) then exit function
set f = fso.opentextfile(server.mappath(filename),1)
if not f.AtEndofStream then
tempcnt = f.readall
f.close
set f = nothing
temparray = split(tempcnt,chr(13)&chr(10)) '取每一行的字符串
if lineNum>ubound(temparray)+1 then
exit function
else
FSOlinedit = temparray(lineNum-1)
call rechken(FSOlinedit)
end if
end if
end function
function FSOappline(sfilename,Linecontent)
dim fso,f
set fso = server.CreateObject("scripting.filesystemobject")
if not fso.fileExists(server.mappath(sfilename)) then exit function
set f = fso.opentextfile(server.mappath(sfilename),8,1)
f.write Linecontent
f.close
set f = nothing
end function
Function GetBodyP(ConStr,StartStr,OverStr,IncluL,IncluR)
If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True or StartStr="" or IsNull(StartStr)=True or OverStr="" or IsNull(OverStr)=True Then
GetBodyP="$False$"
Exit Function
End If
Dim ConStrTemp
Dim Start,Over
ConStrTemp=Lcase(ConStr)
StartStr=Lcase(StartStr)
OverStr=Lcase(OverStr)
Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
If Start<=0 then
GetBodyP="$False$"
Exit Function
Else
If IncluL=False Then
Start=Start+LenB(StartStr)
End If
End If
Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
If Over<=0 or Over<=Start then
GetBodyP="$False$"
Exit Function
Else
If IncluR=True Then
Over=Over+LenB(OverStr)
End If
End If
GetBodyP=MidB(ConStr,Start,Over-Start)
End Function
function rechken(nt)
wrd=nt
wrd=replace(wrd," ","-")
call FSOappline(savefile,wrd&chr(9))
if len(nt)>=200 then
dim sytr_remx(1000),sytr_remn(1000)
for i = 1 to len(nt)
sytr_remx(i-1)=mid(nt,(i-1)*200+1,200)
if len(sytr_remx(i-1))<=0 then exit for
urlx="http://fanyi.youdao.com/openapi.do?keyfrom=localhost&key=1204607085&type=data&doctype=xml&version=1.1&q="&toutf8(sytr_remx(i-1))&""
call getbody(urlx)
sytr_remn(i-1)=sytr_ntxt
next
for i=0 to ubound(sytr_remn)
if len(sytr_remn(i))<=0 then exit for
response.Write sytr_remn(i)
next
else
urlx="http://fanyi.youdao.com/openapi.do?keyfrom=localhost&key=1204607085&type=data&doctype=xml&version=1.1&q="&toutf8(nt)&""
call getbody(urlx)
response.Write sytr_ntxt
end if
end function
function getbody(url)
dim objxml
on error resume next
set objxml = createobject("microsoft.xmlhttp")
with objxml
.open "get", url, false, "", ""
.send
xgetbody = .responsebody
end with
xgetbody=bytestobstr(xgetbody,"utf-8")
'response.Write xgetbody
if len(xgetbody)>0 then
call splitre(xgetbody)
'call FSOappline(savefile,xgetbody)
list=GetBodyP(xgetbody,"<explains>","</explains>",False,False)
'call FSOappline(savefile,list)
list=replace(list,chr(10),"")
list=replace(list," <ex><![CDATA[","")
list=replace(list,"]]></ex>"," & ")
call FSOappline(savefile,list&chr(13)&chr(10)) '/
end if
set objxml = nothing
end function
function bytestobstr(strbody,codebase)
dim objstream
set objstream = server.createobject("adodb.stream")
objstream.type = 1
objstream.mode =3
objstream.open
objstream.write strbody
objstream.position = 0
objstream.type = 2
objstream.charset = codebase
bytestobstr = objstream.readtext
objstream.close
set objstream = nothing
end function
function splitre(str)
str1=split(str,"<paragraph><![CDATA[")
str2=replace(str1(1),"]]></paragraph>","")
str3=replace(str2," </translation>","")
str4=replace(str3,"</youdao-fanyi>","")
sytr_ntxt=str2
'response.Write sytr_ntxt
'call FSOappline(savefile,str4) '
end function
Function toUTF8(szInput)
Dim wch, uch, szRet
Dim x
Dim nAsc, nAsc2, nAsc3
If szInput = "" Then
toUTF8 = szInput
Exit Function
End If
For x = 1 To Len(szInput)
wch = Mid(szInput, x, 1)
nAsc = AscW(wch)
If nAsc < 0 Then nAsc = nAsc + 65536
If (nAsc And &HFF80) = 0 Then
szRet = szRet & wch
Else
If (nAsc And &HF000) = 0 Then
uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
Else
uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
End If
End If
Next
toUTF8 = szRet
End Function
'---------------------------主程序结束------------------------
'---------------------------调试开始------------------------
'strx="轻轻的闭上双眼，思绪跟随着音符早已飞回曾经住过的小山村。仿佛看到了日落西山袅袅炊烟里，大人们忙完了一天的农活忙着回家吃晚饭，头上戴着散发着汗味的草帽，黝黑的面容上留下一层层岁月冲刷过的痕迹，那一双双破旧沾满泥土的布鞋和草鞋，脚趾裸露着，蜷曲在裤脚边里的干土粒簌簌掉落，肩上扛着那些磨得发光的农具，一边轻松地吸着烟，一边谈笑风声；花色各样的狗大概是因为能够跟着主人一起回家而感到无比的高兴吧？窜前跑后，开心得摇头摆尾，“汪汪”地叫唤着；最快乐的是孩子们了，在草地里田埂上跑啊，跳啊，追逐嬉戏，甚至打滚；远处传来一种声音——“叮叮当，叮叮当”，羊群在黄昏时分显得洁白无比，它们“咩咩”的叫着，主人跟在后面欢快的哼着小曲，和孩子们“丢啊丢手绢……”的歌声混合在一起，醉了整个黄昏。不经意间想起这些场景，心底里有一股暖流在静静流淌，往昔瞬间忆起，禁不住有怦然心动的感觉，有泪湿眼眸的温暖。时不时地有一种错觉，那些曾经是在梦中吗？但我知道梦中不可能有爽朗的笑声，也不可能有草叶沁香，自己的生命曾经在那一片土地上走过，留下了深深浅浅的脚印，我生命的根在那里。"
'call rechken(strx)
filename="angerWrd.out.txt"
savefile="angerTrans.txt"
lineNum=1
maxline=600
for j=1 to maxline
call FSOlinedit(filename,j)
next
'---------------------------调试结束------------------------
%>Windows7下配置运行ASP：
1. 点击：开始==》控制面板==》程序和功能==》打开或关闭Windows功能==》Internet信息服务==》Web管理工具，并勾选如图项目保存配置
2. 返回：所有控制面板==》管理工具，双击打开第二项“Internet信息服务(IIS)管理器”；
3. 选择：Default Web Site==》双击打开“ASP”
4. 启用父路径，将默认父路径设置为True；
5. 退回“Default Web Site”==》右边栏的“绑定”==》添加端口：8081（也可以不用绑定？验证时直接输入http://localhost？）
IIS和ASP设置完成，在浏览器地址栏输入如下地址验证是否配置成功：http://localhost:8081，若打开如下画面则配置成功。
调用方法：
将.asp文件拷贝到C:\inetpub\wwwroot 目录下，在浏览器地址栏输入：http://localhost/myAsp.asp
通过有道提供的API获取词典释义。
7662
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
