Public Function ReverseString(text As String)
ReverseString = StrReverse(text)
End Function
Public Function getRootDomain(text As String)
Dim i
' Remove protocol
text = Replace(text, "http://", "")
text = Replace(text, "https://", "")
text = Replace(text, "ftp://", "")
' Remove trailing / and path
i = InStr(text, "/")
If (i > 0) Then
text = Left(text, InStr(text, "/") - 1)
End If
If Left(Right(text, 5), 1) = "." Then ' info TLD
If InStr(6, ReverseString(text), ".") > 0 Then
text = Right(text, InStr(6, ReverseString(text), ".") - 1)
Else
text = Replace(text, "www.", "")
End If
ElseIf Left(Right(text, 4), 1) = "." Then '.xxx TLD
If InStr(5, ReverseString(text), ".") > 0 Then
text = Right(text, InStr(5, ReverseString(text), ".") - 1)
Else
text = Replace(text, "www.", "")
End If
Else
'xxx.TLD.uk
If Left(Right(text, 7), 1) = "." Then
If InStr(8, ReverseString(text), ".") > 0 Then
text = Right(text, InStr(8, ReverseString(text), ".") - 1)
Else 'we don't not handle http://www.wp.pl/ case well
text = Replace(text, "www.", "")
End If
'xxx.xx.uk
ElseIf Left(Right(text, 6), 1) = "." Then
If InStr(7, ReverseString(text), ".") > 0 Then
text = Right(text, InStr(7, ReverseString(text), ".") - 1)
Else 'we don't not handle http://www.wp.pl/ case well
text = Replace(text, "www.", "")
End If
Else 'xxxx.uk
If InStr(4, ReverseString(text), ".") > 0 Then
text = Right(text, InStr(4, ReverseString(text), ".") - 1)
Else
text = Replace(text, "www.", "")
End If
End If
End If
getRootDomain = text
End Function
