Wednesday, October 22, 2008

UTF8 to big5 轉換和簡繁轉換

bytes2BSTR 這個是我當時找XMLHTTP的資料時找到的

至於簡繁轉換則是經驗換來的...

<%
Function bytes2BSTR(vIn)
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function

Function Chg_ASC(str) 'Unicode轉ASCII
dim x,y,z,temp_word,flag
flag=0
x = instr(flag+1,str,"&#")
do until x = 0 or x < flag
x = instr(flag+1,str,"&#")
if x <> 0 then
y = mid(str,x,8)
select case instr(y,";")
case 8
z = chrw(mid(y,3,5))
case 7
z = chrw(mid(y,3,4))
case 6
z = chrw(mid(y,3,3))
case 5
z = chrw(mid(y,3,2))
end select
if instr(y,";") > 4 and asc(z) <> 63 then
str = replace(str,left(y,instr(y,";")),z)
end if
flag = x
end if
loop
Chg_ASC = str
End Function

Function Chg_UNI(str) 'ASCII轉Unicode
dim old,new_w,j
old = str
new_w = ""
for j = 1 to len(str)
if ascw(mid(old,j,1)) < 0 then
new_w = new_w & "&#" & ascw(mid(old,j,1))+65536 & ";"
elseif ascw(mid(old,j,1))>0 and ascw(mid(old,j,1))<127 then
new_w = new_w & mid(old,j,1)
else
new_w = new_w & "&#" & ascw(mid(old,j,1)) & ";"
end if
next
Chg_UNI=new_w
End Function

Function GetHttp(httpURL)
if httpURL = "" then GetHttp = "" :exit function
on error resume next
if not lcase(left(httpURL,4)) = "http" then GetHttp = httpURL : exit function
Dim xmlhttp,requestText
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.open "GET", httpURL, False
xmlhttp.send ""
Session.Codepage=936
requestText = Chg_UNI(bytes2BSTR(xmlhttp.responseBody))
Session.Codepage=950
GetHttp = Chg_ASC(requestText)
Set xmlhttp = Nothing
'on error goto 0
End Function
response.write gethttp("http://tv.etshow.net/htm/wt/dfws.asx")
%>

No comments: