<%
'==================================================
'函数名：gb2big5
'作 用：国标码转大五码
'参 数：Text ------ 字符串
'作 者：netyum(杨嵩)
'Q Q: 8025628
'时 间：2004年6月28日
'==================================================
Function gb2big5(Text)
Dim Ados,Max,i,c,b,h,l
If IsNull(Text) Or Text = "" Then Exit Function

Set Ados=Server.CreateObject("Adodb.Stream")
Ados.Mode = 3
Ados.Type = 1
Ados.Open
Ados.LoadFromFile(Server.MapPath("gb-big5.table"))

Text = Server.UrlEnCode(Text)
b = ""
Max = Len(Text)
For i=1 To Max
c = Mid(Text,i,1)
If c = "%" Then
h = eval("&h"+Mid(Text,i+1,2))
If h < 128 Then
b = b & chr(h)
i = i+2
Else
If isvalidhex(mid(Text,i,3)) Then
If isvalidhex(mid(Text,i+3,3)) Then
l = eval("&h"+Mid(Text,i+4,2))
Ados.Position = (h-160)*510+(l-1)*2
b = b & bytes2BSTR(Ados.Read(2))
i = i+5
Else
b = b & " "
i = i+3
End If
End If
End If
Else
If c = "+" Then
b = b & " "
Else
b = b & c
End If
End If
Next
Set Ados = Nothing
gb2big5 = b
End Function

Function isvalidhex(str)
isvalidhex=true
str=ucase(str)
If Len(str) <> 3 Then isvalidhex = false : Exit Function
if Left(str,1) <> "%" Then isvalidhex = false : Exit Function
c = Mid(str,2,1)
If Not (((c>="0") And (c<="9")) Or ((c>="A") And (c<="Z"))) Then isvalidhex = false : Exit Function
c = Mid(str,3,1)
If Not (((c>="0") And (c<="9")) Or ((c>="A") And (c<="Z"))) Then isvalidhex = false : Exit Function
End Function

Function bytes2BSTR(vIn)
Dim strReturn
Dim i,ThisCharCode,NextCharCode
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
%>