Public Class A2SB
Private Function BCon(ByVal InputValue As String, ByVal InputBase As Long, _
ByVal OutputBase As Long) As String
Const csValidChars As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim cuOutputCharCount As Decimal, lInputCharCount As Long
Dim lCounter As Long, sCompareWith As String, sChar As String
Dim dDecimalChars As Double, lPos As Long, cuBitValue As Decimal
Dim cuDecimalValue As Decimal, sOutput As String
On Error Resume Next
If (InputBase < 2) Or (InputBase > 36) Then
BCon = ""
Exit Function
End If
If (OutputBase < 2) Or (OutputBase > 36) Then
BCon = ""
Exit Function
End If
InputValue = Trim(InputValue)
lInputCharCount = Len(InputValue)
sCompareWith = Left$(csValidChars, InputBase)
If lInputCharCount < 1 Then
BCon = ""
Exit Function
End If
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
dDecimalChars = lInputCharCount * System.Math.Log(InputBase) / _
System.Math.Log(10)
If dDecimalChars > 14 Then
BCon = ""
Exit Function
End If
If InputBase = 10 Then
cuDecimalValue = Convert.ToDecimal(InputValue)
Else
cuBitValue = 1
cuDecimalValue = 0
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)
End While
If OutputBase = 10 Then
BCon = CStr(cuDecimalValue)
Exit Function
End If
End If
cuOutputCharCount = 1 + System.Math.Log(cuDecimalValue) / _
System.Math.Log(OutputBase)
cuBitValue = 1
For lCounter = 2 To cuOutputCharCount
cuBitValue = cuBitValue * OutputBase
Next
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
End While
While Left$(sOutput, 1) < "1"
sOutput = Right$(sOutput, Len(sOutput) - 1)
End While
BCon = sOutput
End Function
Public Function ASCII2Bin(ByVal InputData As String) As String
Dim Temp As String = InputData
Dim Result As String = ""
Dim X As Integer
If Len(Temp) > 0 Then
For X = 1 To Len(Temp)
Result &= EightBits(BCon(Asc(Mid(Temp, X, 1)), 10, 2))
Next
End If
ASCII2Bin = Result
End Function
Public Function Bin2ASCII(ByVal InputData As String) As String
Dim Temp As String = InputData
Dim Result As String = ""
Dim X As Integer
If Len(Temp) > 0 Then
For X = 1 To Len(Temp) - Len(Temp) Mod 8 Step 8
Result &= Chr(BCon(Mid(Temp, X, 8), 2, 10))
Next
End If
Bin2ASCII = Result
End Function
Private Function EightBits(ByVal InputData As String) As String
Dim X As String = InputData
Do While Len(X) < 8
X = "0" & X
Loop
EightBits = X
End Function
End Class