Function AsciiToHex(sData)
 ' Turns ASCII string sData into array of hex numerics
 Dim i, aTmp()
 ReDim aTmp(Len(sData) - 1)
 For i = 1 To Len(sData)
  aTmp(i - 1) = Hex(Asc(Mid(sData, i)))
 Next
 ASCIItoHex = aTmp
End Function

Function BinaryToString(Binary)
  'Antonin Foller, http://www.pstruh.cz
  'Optimized version of a simple BinaryToString algorithm.
  
  Dim cl1, cl2, cl3, pl1, pl2, pl3, L
  cl1 = 1
  cl2 = 1
  cl3 = 1
  L = LenB(Binary)
  Do While cl1<=L
    pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
    cl1 = cl1 + 1
    cl3 = cl3 + 1
    If cl3 > 300 Then
      pl2 = pl2 & pl3
      pl3 = ""
      cl3 = 1
      cl2 = cl2 + 1
      If cl2 > 200 Then
        pl1 = pl1 & pl2
        pl2 = ""
        cl2 = 1
      End If
    End If
  Loop
  BinaryToString = pl1 & pl2 & pl3
End Function

Function Chomp(sData)
 ' Trims terminal nonprinting characters from a string
 Dim sNoPrint, sTmp
 sTmp = sData
 sNoPrint = vbCr & vbLf & vbFormFeed _
  & vbVerticalTab & vbNullChar & vbTab & " "
 If Len(sTmp)>0 Then
  Do While (Instr(sNoPrint, Right(sTmp, 1)))
   sTmp = Left(sTmp, Len(sTmp) - 1)
  Loop
 End If
 Chomp = sTmp
End Function


Function HTMLBreaks2TextBreaks(strOut)
 'takes a string of HTML and converts all HTML breaks
 ' into carriage return-line feed form
 HTMLBreaks2TextBreaks = ReplaceText("
",vbcrlf,strOut)
End Function

Function Isl2Rom(sData)
 Dim k,d
 Set d = CreateObject("Scripting.Dictionary")
 d.Add "þ", "t" : d.Add "Á", "A" : d.Add "Æ", "AE"
 d.Add "Ð", "D" : d.Add "É", "E" : d.Add "æ", "ae"
 d.Add "Ó", "O" : d.Add "Ö", "O" : d.Add "Ú", "U"
 d.Add "Ý", "Y" : d.Add "Þ", "T" : d.Add "á", "a"
 d.Add "Í", "I" : d.Add "ð", "d" : d.Add "é", "e"
 d.Add "í", "i" : d.Add "ó", "o" : d.Add "ö", "o"
 d.Add "ú", "u" : d.Add "ý", "y"
 Isl2Rom = sData
 For Each k In d.Keys
  wscript.echo k,d.Item(k)
  Isl2Rom = Replace(Isl2Rom,k,d.Item(k))
 Next
End Function

Function IsPrivateIp(sIpAddress)
 ' Given IP string, checks whether it is a private address
 ' DOES NOT CHECK FOR VALID IP FORM
 ' Use IsValidIp to check validity
 ' Checks for STRICT private addresses;
 ' does not guess about common misuse such as 192.0 nets
 Dim aTmp
 IsPrivateIp = False
 aTmp = split(sIpAddress,".")
 ' Is it a class 10 network?
 If aTmp(0) = 10 Then IsPrivateIp = True
 ' If not a 10, is it a 172 private address?
 If aTmp(0) = 172 Then
  If ( aTmp(1)>15 )  And ( aTmp(1)<32 ) Then IsPrivateIp = True
 End If
 ' If neither of the above, is it a 192.168 IP?
 If ( aTmp(0)=192 )  And ( aTmp(1)=168 ) Then IsPrivateIp = True
End Function

Function IsValidEmail(Expression)
 ' Found on the Internet, modified slightly
 ' Requires WSH 5.6
 ' Returns true if email is of valid form
   Dim objRegExp
   Set objRegExp = New RegExp
   objRegExp.Pattern = "[\w\.-]+@[\w\.-]+\.[a-zA-Z]+"
   ValidateEmail = objRegExp.Test(Expression)
End Function

Function IsValidIp(sIpAddress)
 ' Given IP string, validates
 Dim aTmp
 IsValidIp = False
 aTmp = split(sIpAddress,".")
 ' There must be 4 fields in a valid IP
 If UBound(aTmp) <> 3 Then Exit Function
 For Each field In aTmp
  If field > 255 Then Exit Function
 Next
 IsValidIp = True
End Function

Function LPad(sData, iLen, chrPad)
 'Pads a string sData to length iLen with char chrPad
 ' if length is greater than spec, returns unchanged
    Dim sPadLen
    sPadLen = iLen - Len(sData)
    If sPadLen > 0 Then
     LPad = String(sPadLen, chrPad) & sData
    Else
     LPad = sData
    End If
End Function

Function NumericIp(IpAddress)
 Dim nField, aIp
 ' Split IP address into fields
 aIp = Split(IpAddress, ".", 4)
 ' Loop through fields
 For nField = 0 To 3
  If Not nField = 3 Then
   ' Convert field to Numeric
   aIp(nField) = aIp(nField) * (256 ^ (3 - nField))
  End If
  ' Add the number To the results
  NumericIp = NumericIp + aIp(nField)
 Next
End Function

Function ProperCase(sData)
 ' Changes string to proper case
 ' (First letter of each word is upper case)
 Dim aData, sCap, i
 sData = trim(sData) 'eliminate extra spaces
 aData = Split(sData)
 For i = 0 To UBound(aData)
  aData(i) = LCase(aData(i))
  sCap = Left(aData(i),1)
  aData(i) = Replace(aData(i),sCap,UCase(sCap),1,1)
  wscript.echo aData(i)
 Next
 ProperCase = Join(aData)
End Function

Function ROT13(sData) 'As String
 '	Takes string function, returns string with all 26 standard
 ' English alphabet letters ROT13'ed in place
 '  ROT13 Function by Eric Phelps
 Dim sBuffer, lngPos, intChar, lalpha, ualpha, alpha
 lalpha = "abcdefghijklmnopqrstuvwxyz"
 ualpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 alpha = lalpha & lalpha & ualpha & ualpha
 For lngPos = 1 To Len(sData)
  intChar = Instr(alpha, Mid(sData, lngPos, 1))
  If intChar = 0 Then
   ROT13 = ROT13 & Mid(sData, lngPos, 1)
  Else
   ROT13 = ROT13 & Mid(alpha, intChar + 13, 1)
  End If
 Next
End Function

Function RPad(sData, iLen, chrPad)
 'Pads a string sData to length iLen with char chrPad
 ' if length is greater than spec, returns unchanged
    Dim sPadLen
    sPadLen = iLen - Len(sData)
    If sPadLen > 0 Then
     RPad = sData & String(sPadLen, chrPad)
    Else
     RPad = sData
    End If
End Function

Function SBool(data)
 ' Turns value into a string boolean
 SBool = CStrng(CBool(data))
End Function

Function StringIp(NumericIp)
 Dim Remainder, nIp
 For nIp = 3 To 0 Step -1
  Remainder = Int(NumericIp / (256 ^ nIp))
  StringIp = StringIp & Remainder & "."
  NumericIp = NumericIp - (Remainder * (256 ^ nIp))
 Next
 StringIp = Left(StringIp, Len(StringIp) - 1)
End Function