Stefan Thoolen .nl | VB6 Function Database

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
Visual Basic 6 function "GetShortIPv6Address"

Go back
