Base conversion function in VBScript

Question

Is there a function built into VBScript (for wscript or cscript) that would take a number and convert it to base 2?

For example, Base2(45

Answer 1

I'm not aware of anything built-in, but it's easy enough to create a general-purpose routine that can handle binary and other bases. If you define symbols from 0 to Z, you can handle everything up to base 36, for example.

Function ToBase(ByVal n, b)

    ' Handle everything from binary to base 36...
    If b < 2 Or b > 36 Then Exit Function

    Const SYMBOLS = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

    Do
        ToBase = Mid(SYMBOLS, n Mod b + 1, 1) & ToBase
        n = Int(n / b)
    Loop While n > 0

End Function

For your example, just pass 2 for the base:

WScript.Echo ToBase(45, 2)

Output:

101101

Answer 2

To encode negative numbers in binary like calc in Programmer mode, i.e. an integer only mode (but VBScript reduces precise up to 32 bits only):

option explicit
On Error GoTo 0
Dim xx
xx = 45
Wscript.Echo +xx, vbTab, Base2( xx, False), Base2( xx, True)
Wscript.Echo -xx, vbTab, Base2(-xx, False), Base2(-xx, True)

Function Base2( iNum, bLong)
  Dim ii, octets, sNum, iLen
  octets = Array ( "000","001", "010", "011", "100", "101", "110", "111")
  If bLong Or Len( CStr( Hex( -Abs(iNum)))) > 4 Then
    sNum = CStr( Oct(CLng(iNum)))   'force Long  : DWORD (32 bits/4 bytes)
    iLen = 32
  Else
    sNum = CStr( Oct(CInt(iNum)))   'keep Integer:  WORD (16 bits/2 bytes)
    iLen = 16
  End If
  Base2 = ""
  For ii = 1 To Len( sNum)
    Base2 = Base2 & octets( Mid( sNum, ii, 1))
  Next
  Do While Len( Base2) > 1 And Left( Base2, 1) = "0"
    Base2 = Mid( Base2, 2)          'truncate left zeroes
  Loop
  'expand left zeroes for a positive value?  
  'Base2 = Right( String( iLen, "0") & Base2, iLen)
End Function

Output:

==>cscript //NOLOGO D:\VB_scripts\SO\32416311.vbs
45       101101 101101
-45      1111111111010011 11111111111111111111111111010011

==>

Output with Base2 = Right( String( iLen, "0") & Base2, iLen) uncommented up:

==>cscript //NOLOGO D:\VB_scripts\SO\32416311.vbs
45       0000000000101101 00000000000000000000000000101101
-45      1111111111010011 11111111111111111111111111010011

==>

Answer 3

A more general (and safer) approach stolen from the c library code:

Option Explicit

Function ntoa( nNum, iBase )
  ntoa = "0"
  If nNum Then
     ntoa = Mid( "-", Sgn( nNum ) + 2 ) + ntoaPos( Abs( nNum ), iBase )
  End If
End Function
Function ntoaPos( nNum, iBase )
  If nNum >= 1 Then
     Dim nD : nD = Fix( nNum / iBase )
     Dim nM : nM = nNum - nD * iBase
     ntoaPos =   ntoaPos( nD, iBase ) _
               & Mid( "0123456789ABCDEFGHIJKLMNOPQRSTUV", 1 + nM, 1 )
  End If
End Function

Function aton( ByVal sNum, iBase )
  sNum = Trim( sNum )
  Dim nLen : nLen = Len( sNum )
  Dim bNeg, nPos
  Select Case Left( sNum, 1 )
     Case "+"
       bNeg = False
       nPos = 2
     Case "-"
       bNeg = True
       nPos = 2
     Case Else
       bNeg = False
       nPos = 1
  End Select
  aton = "0"
  For nPos = nPos To nLen
      Dim nAdd : nAdd = Instr( "0123456789ABCDEFGHIJKLMNOPQRSTUV", Mid( sNum, nPos, 1 ) )
      If 0 = nAdd Then
'        Error
      End If
      aton = aton * iBase + nAdd - 1
  Next
  If bNeg Then
      aton = - aton
  End If
End Function

' use ByVal or don't change the parameter!
Function ToBase(ByVal n, b)

    ' Handle everything from binary to base 36...
    If b < 2 Or b > 36 Then Exit Function

    Const SYMBOLS = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

    Do
        ToBase = Mid(SYMBOLS, n Mod b + 1, 1) & ToBase
        n = Int(n / b)
    Loop While n > 0

End Function

Dim xTests
Dim oWAU : Set oWAU = WScript.Arguments.Unnamed
If 0 = oWAU.Count Then
   Set xTests = CreateObject("System.Collections.ArrayList")
   xTests.Add 45
   xTests.Add 2
Else
   Set xTests = WScript.Arguments.Unnamed
End If

Dim i, n, b, s, o, r
For i = 1 To xTests.Count Step 2
    n = Eval(xTests(i - 1))
    b = xTests(i)
    s = ntoa(n, b)
   On Error Resume Next
    o = ToBase(n, b)
   If Err.Number Then
    o = Err.Description
   End If
   On Error GoTo 0
    r = aton(s, b)
    WScript.Echo n, b, "==>", s, "<==", r, "?", CStr(n = r), o
Next

output:

cscript 32416311-2.vbs 45 2 12345 16 "2^33" 16 -45 2 "2^50" 8 "2^50*-1" 32 "&HFF" 10
45 2 ==> 101101 <== 45 ? True 101101
12345 16 ==> 3039 <== 12345 ? True 3039
8589934592 16 ==> 200000000 <== 8589934592 ? True Overflow
-45 2 ==> -101101 <== -45 ? True Invalid procedure call or argument
1,12589990684262E+15 8 ==> 40000000000000000 <== 1,12589990684262E+15 ? True Overflow
-1,12589990684262E+15 32 ==> -10000000000 <== -1,12589990684262E+15 ? True Overflow
255 10 ==> 255 <== 255 ? True 255