Punycode

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) to a punycode idn version (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) 
' to an unicode string (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