Below you'll find the source for the Visual Basic 6 function GetShortIPv6Address.
Attribute VB_Name = "modGetShortIPv6Address"
' These functions are downloaded from:
' http://www.stefanthoolen.nl/archive/vb6-functions/
'
' You may freely distribute this file but please leave all comments, including this one, in it.
'
' @Author Stefan Thoolen <mail@stefanthoolen.nl>
Option Explicit
''
' Gets a full IPv6 address as 8 times 4 hex-digits
' @param String The short IP address notation
' @return String The full IP address notation
' @author Stefan Thoolen <mail@stefanthoolen.nl>
Public Function GetFullIPv6Address(ByVal ip As String) As String
Dim check_strings() As String, i As Integer, j As Integer, s As String
ip = Trim(LCase(ip))
Select Case CountChars(ip, "::") ' Amount of double colon parts
' A substitution with double-colon may be performed only once in an address, because multiple occurrences would lead to ambiguity.
Case Is > 1: Exit Function
Case 1
' We have multipart digits, lets prepair with 8 parts
Dim parts() As String
ReDim check_strings(0 To 7)
For i = 0 To 7
check_strings(i) = "0"
Next i
' Lets get the start
parts = Split(ip, "::"): parts = Split(parts(0), ":")
For i = LBound(parts) To UBound(parts)
check_strings(i - LBound(parts)) = parts(i)
Next i
' Lets get the end
parts = Split(ip, "::"): parts = Split(parts(1), ":")
For i = LBound(parts) To UBound(parts)
check_strings(7 - UBound(parts) + LBound(parts) + i) = parts(i)
Next i
Case 0
' We need 8 digits of 4 hexidecimal characters
If CountChars(ip, ":") <> 7 Then Exit Function
check_strings = Split(ip, ":")
Case Else
' Invalid IPv6-string
Exit Function
End Select
' If all goes well we now have 8 digits filled with parts
' Lets check all characters
For i = 1 To Len(s)
j = Asc(Mid(s, i, 1))
If (j < Asc("0") Or j > Asc("9")) And (j < Asc("a") Or j > Asc("f")) Then Exit Function
Next i
' Now lets zerofill all 8 parts
For i = 0 To 7
check_strings(i) = String(4 - Len(check_strings(i)), "0") & check_strings(i)
Next i
' Lets combine all parts and return the value
GetFullIPv6Address = Join(check_strings, ":")
End Function
''
' Counts how many a character occures in a string
' @param String txt The text to search in
' @param String search The text to count
' @return Integer The amount of search in txt
' @author Stefan Thoolen <mail@stefanthoolen.nl>
Public Function CountChars(ByVal txt As String, ByVal search As String) As Integer
Dim arr() As String
arr = Split(txt, search)
CountChars = UBound(arr) - LBound(arr)
End Function
''
' Decreases size of an IPv6 address by replacing multiple zero values by two colons
' @param String The long IP address notation
' @return String The short IP address notation
' @author Stefan Thoolen <mail@stefanthoolen.nl>
Public Function GetShortIPv6Address(ByVal ip As String) As String
Dim parts() As String, i As Integer
' Lets start with a full version
ip = GetFullIPv6Address(ip)
If ip = "" Then Exit Function
' Removes unnecessary zeroes
parts = Split(ip, ":")
For i = LBound(parts) To UBound(parts)
If Left(parts(i), 3) = "000" Then
parts(i) = Right(parts(i), 1)
ElseIf Left(parts(i), 2) = "00" Then
parts(i) = Right(parts(i), 2)
ElseIf Left(parts(i), 1) = "0" Then
parts(i) = Right(parts(i), 3)
End If
Next i
ip = Join(parts, ":")
' There are three ways of shorten it more, we try all three and later we check which is shorter
Dim Method1 As String, Method2 As String, Method3 As String
' First method: two colons as the start
Method1 = ip
Do Until Left(Method1, 2) <> "0:"
Method1 = Right(Method1, Len(Method1) - 2)
Loop
Method1 = "::" & Method1
If CountChars(Method1, ":") > 8 Then Method1 = ip
' Second method: two colons at the end
Method2 = ip
Do Until Right(Method2, 2) <> ":0"
Method2 = Left(Method2, Len(Method2) - 2)
Loop
Method2 = Method2 & "::"
If CountChars(Method2, ":") > 8 Then Method2 = ip
' Third method: two colons somewere in the midle
i = InStr(ip, ":0:")
If i = 0 Then
Method3 = ip
Else
Dim begin As String, rest As String
begin = Left(ip, i)
rest = Right(ip, Len(ip) - i)
Do Until Left(rest, 2) <> "0:"
rest = Right(rest, Len(rest) - 2)
Loop
Method3 = begin & ":" & rest
End If
' Looks for the shortest method
If Len(Method1) < Len(ip) Then ip = Method1
If Len(Method2) < Len(ip) Then ip = Method2
If Len(Method3) < Len(ip) Then ip = Method3
GetShortIPv6Address = ip
End Function