Convert Values Between Different Bases

Category:

Dates and Math

Type:

Snippets

Difficulty:

Intermediate

Author:

Waty

Version Compatibility:

More information:

This function allows you to convert numbers from different bases between 2 and 36. You can specify the Input Base and the Output Base. For example if you pass the value of 255 and specify 10 for the input base and 2 for the output base, the function will return 11111111.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit Option Compare Text Private Const csValidChars As String = _ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Code:

Public Function BCon(ByVal InputValue As String, ByVal _
  InputBase As Long, ByVal OutputBase As Long) As String

'// Declare following variables
Dim cuOutputCharCount As Currency, lInputCharCount As Long
Dim lCounter As Long, sCompareWith As String, sChar As String
Dim dDecimalChars As Double, lPos As Long, cuBitValue As Currency
Dim cuDecimalValue As Currency, sOutput As String

'// Turn on error trapping
On Error Resume Next

'// Check to see that both InputBase and OutputBase are
'between 2 and 36 inclusively
If (InputBase < 2) Or (InputBase > 36) Then
   BCon = ""
   Exit Function
End If

If (OutputBase < 2) Or (OutputBase > 36) Then
   BCon = ""
   Exit Function
End If

'// Now initiate translation into 10-based value
InputValue = Trim(InputValue)
lInputCharCount = Len(InputValue)
sCompareWith = Left$(csValidChars, InputBase)

'// Check to see that input string is at least one character
If lInputCharCount < 1 Then
   BCon = ""
   Exit Function
End If

'// Loop through each character in input string. Check for 
   'invalid characters according to input base
For lCounter = 1 To lInputCharCount
   sChar = Mid$(InputValue, lCounter, 1)
   If InStr(1, sCompareWith, sChar, vbTextCompare) < 1 Then
      BCon = ""
      Exit Function
   End If
Next

If InputBase = OutputBase Then
   BCon = InputValue
   Exit Function
End If

'// Now get the number of decimal characters needed to hold 
   'input value
dDecimalChars = lInputCharCount * Log(InputBase) / Log(10)

'// If decimal string is longer than 14 characters then 
   'exit function
If dDecimalChars > 14 Then
   BCon = ""
   Exit Function
End If

If InputBase = 10 Then
   cuDecimalValue = CCur(InputValue)
Else
   '// Initiate calculation into decimal value
   cuBitValue = 1
   cuDecimalValue = 0

'// As long there are characters left in input string, add 
   'their value into the decimal hold variable
   While Len(InputValue) > 0
      sChar = Right(InputValue, 1)
      lPos = InStr(1, sCompareWith, sChar, vbTextCompare) - 1
      cuDecimalValue = cuDecimalValue + lPos * cuBitValue
      cuBitValue = cuBitValue * InputBase
      InputValue = Left(InputValue, Len(InputValue) - 1)
   Wend

'// Now we can do a trick. If output base is 10, we already 
    'have the decimal value...
   If OutputBase = 10 Then
      BCon = CStr(cuDecimalValue)
      Exit Function
   End If
End If

'// Calculate number of characters in output string. If not an 
   'integer round up to nearest integer
cuOutputCharCount = 1 + Log(cuDecimalValue) / Log(OutputBase)

'// Now we must convert the decimal value back into a string in 
   'the output base format
cuBitValue = 1
For lCounter = 2 To cuOutputCharCount
   cuBitValue = cuBitValue * OutputBase
Next

'// As long as we have a decimal value greater than 0, add a 
   'character to the output string
sOutput = ""
sCompareWith = Left$(csValidChars, OutputBase)
While cuBitValue > 0
   lPos = cuDecimalValue \ cuBitValue
   sChar = Mid$(sCompareWith, 1 + lPos, 1)
   sOutput = sOutput & sChar
   cuDecimalValue = cuDecimalValue - lPos * cuBitValue
   cuBitValue = cuBitValue \ OutputBase
Wend

'// Strip leading zeros
While Left$(sOutput, 1) < "1"
   sOutput = Right$(sOutput, Len(sOutput) - 1)
Wend

'// Let BCon function value be the output string in output base 
'format
BCon = sOutput

End Function