<%@codepage=936%>
<%
Server.ScriptTimeOut=300
'----取得区位码的函数---------------------
Function CharToQWM(byVal str)
dim sHex,sHigh,sLow,iLow,iHigh,sResult
sHex=Hex(Asc(str)) '取得字符的内码的编码，如B0A1，此编码是正确的顺序，不必交换高低位。
sHigh=Left(sHex,2) '取得编码的高位，如B0。
sLow=Right(sHex,2) '取得编码的低位，如A1。
'GB2312内码范围为&HA1A1--&HFEFE，每个字节都在A1-FE之间。
if NOT (sHigh>="A1" AND sHigh<="FE") then
CharToQWM=""
Exit Function
end if
if NOT (sLow>="A1" AND sLow<="FE") then
CharToQWM=""
Exit Function
end if
'GB交换码仅使用了7位，高位置1，即为内码。反过来就是将高位置0，可得到交换码。
iLow=Clng("&H" & sLow)-128
iHigh=Clng("&H" & sHigh)-128
'区位码与控制码0-31冲突，所以加上32之后，即是交换码。反过来减去32即可。
iLow=iLow-32
iHigh=iHigh-32
'OK，区位码已经得到。
sResult=""
if iHigh<10 then
sResult = sResult & "0" & Cstr(iHigh)
else
sResult = sResult & Cstr(iHigh)
end if
if iLow<10 then
sResult = sResult & "0" & Cstr(iLow)
else
sResult = sResult & Cstr(iLow)
end if
CharToQWM=sResult
End Function
'----根据区位码得到字符的函数---------------------
Function QWMToChar(byVal str,byVal doCheckFlg)
dim sHex,sHigh,sLow,iLow,iHigh,sResult
'-------------检查输入格式--------------
if doCheckFlg then
if Len(str)<>4 then
QWMToChar=""
Exit Function
end if
'--4位必须都是数字
dim i,iAsc
for i=1 to 4
iAsc=Asc(mid(str,i,1))
if NOT (iAsc>=&H30 AND iAsc<=&H39) then
QWMToChar=""
Exit Function
end if
next
'--区号，位号都要在01-94之间
iHigh=Clng(Left(str,2))
iLow=Clng(Right(str,2))
if NOT (iHigh>=1 AND iHigh<=94) then
QWMToChar=""
Exit Function
end if
if NOT (iLow>=1 AND iLow<=94) then
QWMToChar=""
Exit Function
end if
end if
'-------------检查完毕------------------
iHigh=Clng(Left(str,2))
iLow=Clng(Right(str,2))
iHigh=iHigh + 32 + 128
iLow=iLow + 32 + 128
sHex=Hex(iHigh) & Hex(iLow)
QWMToChar=Chr("&H" & sHex)
End Function
%>
电话名字－数字代码 在线转换
<%
dim str
myAction=request.form("myAction")
if myAction="StrToCode" then '查看区位码
str=request.form("inputStr")
elseif myAction="CodeToStr" then
str=request.form("inputCode")
if instr(str," ")>0 then
dim s
sCharArray=Split(str," ")
for i=0 to Ubound(sCharArray)
s=s & QWMToChar(trim(sCharArray(i)),True)
next
str=s
else
str=QWMToChar(str,True)
end if
end if
if Len(str)>100 then
str=Left(str,100) '最多处理100个
end if
if myAction="StrToCode" OR myAction="CodeToStr" then
if Len(str)>0 then
%>
电话名字
数字代码
<%
for i=1 to Len(str)
sChar=Mid(str,i,1)
if (i mod 2=0) then
bgColor="#F1F8FC"
else
bgColor="#FFFFFF"
end if %>
<%=sChar%>
<%=CharToQWM(sChar)%>
<% next %>
<%
end if
elseif myAction="CodeList" then
'查看区位码列表
startCode=CLng(request.form("startCode"))
endCode=CLng(request.form("endCode"))
if endCode=10 then
endCode=startCode +9
end if
'--循环输出
%>
<% for i=1 to 16 %>
<% next %>
<%
dim rows,cols,sCode
bgColor="#FFFFFF"
for rows=startCode to endCode
response.write "
" & rows & "区
" &vbcrlf
response.write "
" &vbcrlf
for cols=1 to 94
sCode=Right("0" & cstr(rows),2)
sCode=sCode & Right("0" & cstr(cols),2)
response.write "
" & QWMToChar(sCode,False) &" " & sCode & "
" &vbcrlf
if (cols mod 16)=0 then
response.write "
" &vbcrlf
if bgColor="#FFFFFF" then
bgColor="#F1F8FC"
else
bgColor="#FFFFFF"
end if
response.write "
" &vbcrlf
end if
next
response.write "
"
if bgColor="#FFFFFF" then
bgColor="#F1F8FC"
else
bgColor="#FFFFFF"
end if
next
%>