This routine will convert a string representation of a number from one base to another base e.g. 71 (base 10 ) converts to 107 (base 8).
VB has inbuilt functions hex() and oct(), but if you wanted to play around with other base numbers (2 to 20), try this. It can easily be adapted for larger base numbers.
Try it here, although this is written in vbscript, the routine is the same. Note: the max. value is a long, 2.14 billion
eg 987654321 base 10 to base 16 converts to 3ADE68B1
Click to see versions in java vbscript
VB code
Start a new project and add to Form 1
4 x text boxes (text1, text2, text3, text4)
1 x command button (caption = Convert)
Option Explicit
'-------------
Private Sub Command1_Click()
Text4.Text = convert(Text1.Text, Text2.Text, Text3.Text)
End Sub
'-------------
Private Function convert(ByVal oldNum As String, _
ByVal base1 As Integer, ByVal base2 As Integer) As String
Dim temp As Long
Dim x As Integer
Dim i As Integer
Dim nextChar As String
Dim convertedNumber As String
Dim chars As String
Dim validPos As Integer
Dim index As Integer
chars =
"0123456789ABCDEFGHIJ"
'//add KLM.....XYZ etc to take base range to 36
If
base2 > Len(chars) Then
'//ERROR HANDLING
convert = "invalid base2 number"
Exit Function
End If
For i = 1 To Len(oldNum)
'//ERROR HANDLING
validPos = InStr(1, chars, Mid$(oldNum, i, 1))
If validPos =
0 Or validPos > base1 Then
convert = "error - invalid data detected"
Exit Function
End If
Next
On Error Resume Next
'//ERROR HANDLING
x = 1
For i =
Len(oldNum) To 1 Step -1
nextChar = Mid$(oldNum, x, 1)
x = x + 1
temp = temp + ((InStr(1, chars, nextChar) - 1) * (base1 ^ (i - 1)))
Next
If Err.Number Then
convert = "number over 2.14 billion"
Exit Function
End If
On Error GoTo 0
x = 0
Do
While temp > base2 ^ x
x = x + 1
Loop
For i = 1 To x
index = temp \ (base2 ^ (x - i))
convertedNumber = convertedNumber & Mid$(chars, index + 1, 1)
temp = temp - index * (base2 ^ (x - i))
Next
convert =
convertedNumber
End Function
back top main page vb snippets page java snippets page vbscript snippets page email Page last modified