基本转换函数在VBScript

Question

是否有一个函数内建到VBScript (wscript或cscript)，将采取一个数字，并将其转换为基数2?

例如，Base2(45)将输出"101101"

Answer 1

我不知道有什么内置的，但是创建一个可以处理二进制和其他基数的通用例程很容易。例如，如果您定义从0到Z的符号，则可以处理以36为基数的所有符号。

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

对于您的示例，只需传递2作为基础:

WScript.Echo ToBase(45, 2)

输出:

101101

Answer 2

将负数编码为二进制，如calc在编程模式，即仅整数模式(但VBScript仅将精度降低到32位):

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

:

==>cscript //NOLOGO D:VB_scriptsSO32416311.vbs
45       101101 101101
-45      1111111111010011 11111111111111111111111111010011
==>

输出 Base2 = Right( String( iLen, "0") & Base2, iLen)未注释:

==>cscript //NOLOGO D:VB_scriptsSO32416311.vbs
45       0000000000101101 00000000000000000000000000101101
-45      1111111111010011 11111111111111111111111111010011
==>

Answer 3

从c库代码中偷来的更通用(也更安全)的方法:

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

输出:

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