Stefan Thoolen .nl | VB6 Function Database

Attribute VB_Name = "modGetFullIPv6Address"
' 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

''
' 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

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

Go back
