Source code for Issue Number 69

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste create a new module and then paste this source code into it. You can name the module basBaseConversions.

'----------------------------------------------------------------------
'
'   Module Name:    basBaseConversions
'   Written By:     Pedro Dias
'                   C&D Programming Corp.
'   Create Date:    1/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Function AnyBase(sValueToConvert As String, iBaseIn As Integer, iBaseOut As Integer) As String
    Dim i As Integer, iNumOfDigits As Integer
    Dim iValue As Integer           ' the ASCII value of a digit
    Dim DecimalAmount As Long       ' corresponding value of sValueToConvert in Decimal
    Dim sTemp As String

    On Error GoTo ErrorTrap


    iNumOfDigits = Len(sValueToConvert)
    sValueToConvert = UCase(sValueToConvert)

    '
    ' loop through each character and convert one by one.
    '
    For i = 1 To iNumOfDigits
        iValue = Asc(Mid(sValueToConvert, i, 1))
        Select Case iValue
            Case 48 To 57:  ' values 0 through 9
                iValue = iValue - 48
            Case 65 To 90:  ' values A through Z, adjust to make A=10, B=11, etc
                iValue = iValue - 65 + 10
        End Select
        If iValue >= iBaseIn Then 'This will occur if the sValueToConvert
            Error 51            'is not in iBaseIn. Example: the F is greater than 8
        End If                  'sValueToConvert = "123F6" and iBaseIn = 8
        ' build the decimal value of sValueToConvert.
        DecimalAmount = DecimalAmount + ((iBaseIn) ^ (iNumOfDigits - i) * (iValue))
    Next i

    ' convert the decimal value determined above into the appropriate
    ' base according to the number passed in iBaseOut
    While (DecimalAmount > 0) Or (sTemp = "")
        iValue = DecimalAmount Mod iBaseOut
        DecimalAmount = DecimalAmount \ iBaseOut
        Select Case iValue
            Case 0 To 9: iValue = iValue + 48
            Case 10 To 35: iValue = iValue + 65 - 10
        End Select
        sTemp = Chr$(iValue) & sTemp
    Wend

    ' return the string built above.
    AnyBase = sTemp
    Exit Function

ErrorTrap:
    Err.Raise Err.Number, "AnyBase", Err.Description
End Function