hassanf
پنج شنبه 30 آبان 1387, 20:09 عصر
سلام
Dim m_BA
Function BA
If IsEmpty(m_BA) Then Set m_BA = CreateObject("ScriptUtils.ByteArray"): m_BA.CharSet = "utf-8"
Set BA = m_BA
End Function
'conversion from unicode string to punycode
Function ToPUNYCODE(Data)
Dim Outdata
BA.String = Data
Outdata = "<div>ToPUNYCODE : Punycode representation of '" & _
Data & "' string :<div style=background-color:yellow;color:blue>"
Outdata = Outdata & "<b>" & BA.Punycode & "</b>"
Outdata = Outdata & "</div></div>"
ToPUNYCODE = Outdata
End Function
'conversion from punycode string (OLE String) to a UNICODE string
Function FromPUNYCODE(Data)
Dim Outdata
On Error Resume Next
BA.Punycode = Data
If Err=0 Then
Outdata = "<div>FromPUNYCODE : Unicode string :<div style=background-color:yellow;color:blue>"
Outdata = Outdata & "<b>" & BA.String & "</b>"'write the UTF representation
Outdata = Outdata & "</div></div>"
Else
Outdata = "<div style=background-color:red;color:yellow>FromPUNYCODE:Punycode string '" & _
Data & "' has no unicode representation.</div>"
End If
FromPUNYCODE = Outdata
End Function
'conversion of a host name (www.anychar.com (http://www.anychar.com)) to a punycode idn version (www.xn--translated.com (http://www.xn--translated.com))
Function ToIDN(Data)
Dim Outdata, pData, partuni, partpuny
pData = Split(Data, ".")
For Each partuni In pData
BA.String = partuni
partpuny = BA.Punycode
If Right(partpuny,1)<>"-" Then partpuny = "xn--" & partpuny Else partpuny = partuni
Outdata = Outdata & partpuny & "."
Next
Outdata = Left(Outdata, Len(Outdata)-1)
ToIDN = "<div>ToIDN : IDN representation of '" & _
Data & "' string :<div style=background-color:yellow;color:blue><b>" & _
Outdata & "</b></div></div>"
End Function
'conversion of a host name in idn punycode (www.xn--translated.com (http://www.xn--translated.com))
' to an unicode string (www.anychar.com (http://www.anychar.com))
Function FromIDN(ByVal Data)
Dim Outdata, pData, partuni, partpuny
Data = LCase(Data)
pData = Split(Data, ".")
For Each partpuny In pData
If Left(partpuny,4)="xn--" Then
BA.Punycode = Mid(partpuny, 5)
partuni = Ba.String
Else
'on error resume next
'BA.Punycode = partpuny
Dim re :set re = New RegExp
re.pattern = "^[-a-zA-Z0-9]+$"
If re.Test(partpuny) Then
partuni = partpuny
Else
partuni = "<font Color=red>error (" & partpuny & ")</Font>"
End If
End If
Outdata = Outdata & partuni & "."
Next
Outdata = Left(Outdata, Len(Outdata)-1)
FromIDN = "<div>FromIDN : Unicode representation of IDN '" & Data & _
"' :<div style=background-color:yellow;color:blue><b>" & _
Outdata & "</b></div></div>"
End Function