VBScript bit tools

There are two posts at MSDN about Integer Arithmetic in VBScript:

Output

signed_as_unsigned
------------------
(Double) 2147483649
(Double) 2147483650
(Double) 2147483651
(Double) 2147483652

get_bit_mask
------------
(Long) 1
(Long) 2
(Long) 4
(Long) 8
(Long) 16
(Long) 32
(Long) 64
(Long) 128
(Long) 256
(Long) 512
(Long) 1024
(Long) 2048
(Long) 4096
(Long) 8192
(Long) 16384
(Long) 32768
(Long) 65536
(Long) 131072
(Long) 262144
(Long) 524288
(Long) 1048576
(Long) 2097152
(Long) 4194304
(Long) 8388608
(Long) 16777216
(Long) 33554432
(Long) 67108864
(Long) 134217728
(Long) 268435456
(Long) 536870912
(Long) 1073741824
(Long) -2147483648

decimal_to_bitstr
-----------------
(String) "00000000 00000001"
(String) "00000000 00000010"
(String) "00000000 00000011"
(String) "00000000 00000100"
(String) "00000000 00101010"
(String) "01111111 11111111 11111111 11111100"
(String) "01111111 11111111 11111111 11111101"
(String) "01111111 11111111 11111111 11111110"
(String) "01111111 11111111 11111111 11111111"

bitstr_to_decimal
-----------------
(Long) 1
(Long) 2
(Long) 4
(Long) 42
(Long) 2147483645
(Long) 2147483646
(Long) 2147483647
(Long) -2147483648
(Long) -2147483647
(Long) -2147483646

bit_get
-------
True
True
False
False

bit_set
-------
(Long) 11
(Long) 131

bit_toggle
----------
(Long) 1
(Long) 7
(Long) 11

bit_extract
-----------
(Long) 3

<<
--
00000000 00000100
00001011 01001010
10000000 00000000

>>
--
-1
-1
-1073741824

>>>
---
00000000 00000001
00000101 10100101
01000000 00000000

rotl
----
00000000 00000000 00000001 01010000
10101000 00000000 00000000 00000000
10100000 00000000 00000000 00000010
00000001 01010000
10101000 00000000
10100000 00000010

rotr
----
00000000 00000000 00000000 00101010
10000000 00000000 00000000 00001010
10100000 00000000 00000000 00000010
00000000 00101010
10000000 00001010
10100000 00000010

Sources

/vbscript-bit.asp

<!--#include virtual="/lib/unit-tests.asp"-->
<html xmlns="http://www.w3.org/1999/xhtml" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xml:lang="en">
	<head>
		<title>VBScript bit tools</title>
		<!--// meta tags //-->
		<meta http-equiv="content-type" content="text/html; charset=UTF-8" />
		<!--// link tags //-->
		<link rel="stylesheet" type="text/css" media="screen" href="/lib/unit-tests.css" />
	</head>
	<body>
		<div id="container">
			<div id="container-hd">
				<h1>VBScript bit tools</h1>
			</div>
			<div id="container-bd">
 
<p>
There are two posts at MSDN about Integer Arithmetic in VBScript:
<ul>
	<li><a href="https://blogs.msdn.microsoft.com/ericlippert/2004/12/01/integer-arithmetic-in-vbscript-part-one/">Integer Arithmetic In VBScript, Part One</a></li>
	<li><a href="https://blogs.msdn.microsoft.com/ericlippert/2004/12/03/integer-arithmetic-in-vbscript-part-two/">Integer Arithmetic in VBScript, Part Two</a></li>
</ul>
</p>
 
<h2>Output</h2>
<div class="code"><pre><%
 
function strwrap(byVal w, byVal n, byVal break)
	dim i, iK
	iK = int(len(w)/n)
	with Server.createObject("System.Text.StringBuilder")
		for i = 0 to iK
			.append_3 mid(w, i * n + 1, n) & break
		next
		strwrap = trim(.toString())
	end with
end function
 
function signed_as_unsigned(byVal x)
	if x < 0 then x = x + 2 ^ 32
	signed_as_unsigned = x
end function
Response.write vbNewline
Response.write "signed_as_unsigned" & vbNewline
Response.write "------------------" & vbNewline
Response.write dump( signed_as_unsigned( &H80000001 ) ) & vbNewline
Response.write dump( signed_as_unsigned( &H80000002 ) ) & vbNewline
Response.write dump( signed_as_unsigned( &H80000003 ) ) & vbNewline
Response.write dump( signed_as_unsigned( &H80000004 ) ) & vbNewline
 
function get_bit_mask(byVal bit)
	if bit > 32 then
		Err.raise 6, typename(Me) & " runtime error", "Overflow. Given bit is too high."
	elseif bit < 32 then
		get_bit_mask = clng( 2 ^ ( bit - 1 ) )
	else
		' 10000000 00000000 00000000 00000000
		' If the high bit is one then the signed interpretation is equal to the unsigned interpretation minus 2^32
		get_bit_mask = clng( &H80000000 )' 32 is the sign bit
	end if
end function
Response.write vbNewline
Response.write "get_bit_mask" & vbNewline
Response.write "------------" & vbNewline
Response.write dump( get_bit_mask(1) ) & vbNewline
Response.write dump( get_bit_mask(2) ) & vbNewline
Response.write dump( get_bit_mask(3) ) & vbNewline
Response.write dump( get_bit_mask(4) ) & vbNewline
Response.write dump( get_bit_mask(5) ) & vbNewline
Response.write dump( get_bit_mask(6) ) & vbNewline
Response.write dump( get_bit_mask(7) ) & vbNewline
Response.write dump( get_bit_mask(8) ) & vbNewline
Response.write dump( get_bit_mask(9) ) & vbNewline
Response.write dump( get_bit_mask(10) ) & vbNewline
Response.write dump( get_bit_mask(11) ) & vbNewline
Response.write dump( get_bit_mask(12) ) & vbNewline
Response.write dump( get_bit_mask(13) ) & vbNewline
Response.write dump( get_bit_mask(14) ) & vbNewline
Response.write dump( get_bit_mask(15) ) & vbNewline
Response.write dump( get_bit_mask(16) ) & vbNewline
Response.write dump( get_bit_mask(17) ) & vbNewline
Response.write dump( get_bit_mask(18) ) & vbNewline
Response.write dump( get_bit_mask(19) ) & vbNewline
Response.write dump( get_bit_mask(20) ) & vbNewline
Response.write dump( get_bit_mask(21) ) & vbNewline
Response.write dump( get_bit_mask(22) ) & vbNewline
Response.write dump( get_bit_mask(23) ) & vbNewline
Response.write dump( get_bit_mask(24) ) & vbNewline
Response.write dump( get_bit_mask(25) ) & vbNewline
Response.write dump( get_bit_mask(26) ) & vbNewline
Response.write dump( get_bit_mask(27) ) & vbNewline
Response.write dump( get_bit_mask(28) ) & vbNewline
Response.write dump( get_bit_mask(29) ) & vbNewline
Response.write dump( get_bit_mask(30) ) & vbNewline
Response.write dump( get_bit_mask(31) ) & vbNewline
Response.write dump( get_bit_mask(32) ) & vbNewline
 
function decimal_to_bitstr(byVal d)
	dim bits, a, i
	select case vartype(d)
		case vbLong
			bits = 32
		case vbInteger
			bits = 16
		case vbByte
			bits = 8
		case else
			Err.raise 13, typename(Me) & " runtime error", "Type mismatch. Conversion cannot be performed."
	end select
	redim a(bits)
	for i = bits to 1 step -1
		if d and get_bit_mask(i) then
			a(i) = 1
		else
			a(i) = 0
		end if
	next
	decimal_to_bitstr = strReverse( join( a, "" ) )
end function
Response.write vbNewline
Response.write "decimal_to_bitstr" & vbNewline
Response.write "-----------------" & vbNewline
Response.write dump( strwrap( decimal_to_bitstr(1), 8, " " ) ) & vbNewline
Response.write dump( strwrap( decimal_to_bitstr(2), 8, " " ) ) & vbNewline
Response.write dump( strwrap( decimal_to_bitstr(3), 8, " " ) ) & vbNewline
Response.write dump( strwrap( decimal_to_bitstr(4), 8, " " ) ) & vbNewline
Response.write dump( strwrap( decimal_to_bitstr(42), 8, " " ) ) & vbNewline
Response.write dump( strwrap( decimal_to_bitstr(2147483644), 8, " " ) ) & vbNewline
Response.write dump( strwrap( decimal_to_bitstr(2147483645), 8, " " ) ) & vbNewline
Response.write dump( strwrap( decimal_to_bitstr(2147483646), 8, " " ) ) & vbNewline
Response.write dump( strwrap( decimal_to_bitstr(2147483647), 8, " " ) ) & vbNewline
 
function bitstr_to_decimal(byVal bits)
	dim binary, K, i
	bits = replace(bits, " ", "")
	binary = trim( right( bits, len(bits) - instr( bits, 1 ) + 1 ) )
	K = len(binary)
	if K > 32 then Err.raise 6, typename(Me) & " runtime error", "Overflow. Given bits is too high."
	for i = 1 to len(binary)
		select case mid(binary, i, 1)
			case "1"
				bitstr_to_decimal = bitstr_to_decimal or get_bit_mask( K - i + 1 )
			case "0"
				' pass
			case else
				Err.raise 13, typename(Me) & " runtime error", "Type mismatch. Bits should contain only 1 and 0."
		end select
	next
end function
Response.write vbNewline
Response.write "bitstr_to_decimal" & vbNewline
Response.write "-----------------" & vbNewline
Response.write dump( bitstr_to_decimal("1") ) & vbNewline
Response.write dump( bitstr_to_decimal("10") ) & vbNewline
Response.write dump( bitstr_to_decimal("100") ) & vbNewline
Response.write dump( bitstr_to_decimal("00000000 00101010") ) & vbNewline
Response.write dump( bitstr_to_decimal("01111111 11111111 11111111 11111101") ) & vbNewline
Response.write dump( bitstr_to_decimal("01111111 11111111 11111111 11111110") ) & vbNewline
Response.write dump( bitstr_to_decimal("01111111 11111111 11111111 11111111") ) & vbNewline
Response.write dump( bitstr_to_decimal("10000000 00000000 00000000 00000000") ) & vbNewline
Response.write dump( bitstr_to_decimal("10000000 00000000 00000000 00000001") ) & vbNewline
Response.write dump( bitstr_to_decimal("10000000 00000000 00000000 00000010") ) & vbNewline
 
function bit_get(byVal bits, byVal bit)
	bit_get = cbool( bits and get_bit_mask(bit) )
end function
Response.write vbNewline
Response.write "bit_get" & vbNewline
Response.write "-------" & vbNewline
Response.write bit_get( clng(3), 1 ) & vbNewline' true
Response.write bit_get( clng(3), 2 ) & vbNewline' true
Response.write bit_get( clng(3), 3 ) & vbNewline' false
Response.write bit_get( clng(3), 4 ) & vbNewline' false
 
function bit_set(byVal bits, byVal bit, byVal b)
	dim [τ] : [τ] = vartype(bits)
	if [τ] <> vbLong and [τ] <> vbInteger and [τ] <> vbByte then _
		Err.raise 13, typename(Me) & " runtime error", "Type mismatch. Conversion cannot be performed."
	if b then
		bit_set = clng( bits or get_bit_mask(bit) )
	else
		bit_set = clng( bits or not get_bit_mask(bit) )
	end if
	select case [τ]
		case vbLong
			' pass, already set
		case vbInteger
			bit_set = cint( "&H" + hex( bit_set and &HFFFF ) )
		case else
			bit_set = cbyte( bit_set and &HFF )
	end select
end function
Response.write vbNewline
Response.write "bit_set" & vbNewline
Response.write "-------" & vbNewline
Response.write dump( bit_set( clng(3), 4, 1 ) ) & vbNewline' 00000011 -> 00001011 (11)
Response.write dump( bit_set( clng(3), 8, 1 ) ) & vbNewline' 00000011 -> 10000011 (131)
 
function bit_toggle(byVal bits, byVal bit)
	select case vartype(bits)
		case vbLong
			bit_toggle = bits xor get_bit_mask(bit)
		case vbInteger
			bit_toggle = cint( "&H" & hex( ( bits xor get_bit_mask(bit) ) and &HFFFF ) )
		case vbByte
			bit_toggle = cbyte( ( bits xor get_bit_mask(bit) ) and &HFF )
		case else
			Err.raise 13, typename(Me) & " runtime error", "Type mismatch. Conversion cannot be performed."
	end select
end function
Response.write vbNewline
Response.write "bit_toggle" & vbNewline
Response.write "----------" & vbNewline
Response.write dump( bit_toggle( clng(0), 1 ) ) & vbNewline' 00000000 -> 00000001 (1)
Response.write dump( bit_toggle( clng(3), 3 ) ) & vbNewline' 00000011 -> 00000111 (7)
Response.write dump( bit_toggle( clng(3), 4 ) ) & vbNewline' 00000011 -> 00001011 (11)
 
function bit_extract(byVal bits, byVal p, byVal n)
	dim bitmask, tmpmask, i
	for i = p - n + 1 to p
		bitmask = bitmask or get_bit_mask(i)
	next
	bit_extract = clng( bits and bitmask )
	if bit_extract and &H80000000 then
		tmpmask = n
	else
		tmpmask = 0
	end if
	bit_extract = ( bit_extract and &H7FFFFFFF ) / 2 ^ (p - n)
	if tmpmask then bit_extract = bit_extract or get_bit_mask( tmpmask )
	bit_extract = clng( bit_extract )
end function
Response.write vbNewline
Response.write "bit_extract" & vbNewline
Response.write "-----------" & vbNewline
Response.write dump( bit_extract(clng(31), 2, 2) ) & vbNewline' 00011111, f(00011111,2,2) -> 11 (3)
 
function [<<](byVal bits, byVal amount)
	dim prev, i
	prev = bits
	for i = 1 to amount
		select case vartype(bits)
			case vbLong
				[<<] = (prev and &H3FFFFFFF) * 2
				if prev and &H40000000 then [<<] = [<<] or &H80000000
				[<<] = clng( [<<] )
			case vbInteger
				[<<] = (prev and &H3FFF) * 2
				if prev and &H4000 then [<<] = [<<] or &H8000
				[<<] = cint( "&H" + hex( [<<] ) )
			case vbByte
				[<<] = cbyte( (prev and &H7F) * 2 )
			case else
				Err.raise 13, typename(Me) & " runtime error", "Type mismatch. Conversion cannot be performed."
		end select
		prev = [<<]
	next
end function
Response.write vbNewline
Response.write "<<" & vbNewline
Response.write "--" & vbNewline
Response.write strwrap( decimal_to_bitstr( [<<]( cint(1), 2 ) ), 8, " " ) & vbNewline     ' 00000000 00000001 << 2 -> 00000000 00000100 (4)
Response.write strwrap( decimal_to_bitstr( [<<]( cint(1445), 1 ) ), 8, " " ) & vbNewline  ' 00000101 10100101 << 1 -> 00001011 01001010 (2890)
Response.write strwrap( decimal_to_bitstr( [<<]( cint(16384), 1 ) ), 8, " " ) & vbNewline ' 01000000 00000000 << 1 -> 10000000 00000000 (-32768)
 
function [>>](byVal bits, byVal amount)' aka arithmetic right shift
	dim prev, i
	prev = bits
	for i = 1 to amount
		select case vartype(bits)
			case vbLong
				[>>] = int( (prev and &H7FFFFFFF) / 2 )
				if prev and &H80000000 then [>>] = [>>] or &HC0000000
				[>>] = clng([>>])
			case vbInteger
				[>>] = int( (prev and &H7FFF) / 2 )
				if prev and &H8000 then [>>] = [>>] or &HC000
				[>>] = cint( "&H" + hex( [>>] ) )
			case vbByte
				[>>] = int( prev / 2 )
				if prev and &H80 then [>>] = [>>] or &HC0
				[>>] = cbyte([>>])
			case else
				Err.raise 13, typename(Me) & " runtime error", "Type mismatch. Conversion cannot be performed."
		end select
		prev = [>>]
	next
end function
Response.write vbNewline
Response.write ">>" & vbNewline
Response.write "--" & vbNewline
Response.write [>>]( cint(-4), 2 ) & vbNewline
Response.write [>>]( cint(-8), 3 ) & vbNewline
Response.write [>>]( clng(-2147483648), 1 ) & vbNewline
 
function [>>>](byVal bits, byVal amount)' aka logical right shift
	dim prev, i
	prev = bits
	for i = 1 to amount
		select case vartype(bits)
			case vbLong
				[>>>] = int( (prev and &H7FFFFFFF) / 2 )
				if prev and &H80000000 then [>>>] = [>>>] or &H40000000
				[>>>] = clng([>>>])
			case vbInteger
				[>>>] = int( (prev and &H7FFF) / 2 )
				if prev and &H8000 then [>>>] = [>>>] or &H4000
				[>>>] = cint( "&H" + hex( [>>>] ) )
			case vbByte
				[>>>] = cbyte( prev / 2 )
			case else
				Err.raise 13, typename(Me) & " runtime error", "Type mismatch. Conversion cannot be performed."
		end select
		prev = [>>>]
	next
end function
Response.write vbNewline
Response.write ">>>" & vbNewline
Response.write "---" & vbNewline
Response.write strwrap( decimal_to_bitstr( [>>>]( cint(4), 2 ) ), 8, " " ) & vbNewline      ' 00000000 00000100 >> 2 -> 00000000 00000001 (1)
Response.write strwrap( decimal_to_bitstr( [>>>]( cint(2890), 1 ) ), 8, " " ) & vbNewline   ' 00001011 01001010 >> 1 -> 00000101 10100101 (1445)
Response.write strwrap( decimal_to_bitstr( [>>>]( cint(-32768), 1 ) ), 8, " " ) & vbNewline ' 10000000 00000000 >> 1 -> 01000000 00000000 (16384)
 
function rotl(byVal bits, byVal amount)
	dim prev, i
	prev = bits
	for i = 1 to amount
		select case vartype(bits)
			case vbLong
				rotl = (prev and &H3FFFFFFF) * 2
				if prev and &H40000000 then rotl = rotl or &H80000000
				if prev and &H80000000 then rotl = rotl or &H1
				rotl = clng(rotl)
			case vbInteger
				rotl = (prev and &H3FFF) * 2
				if prev and &H4000 then rotl = rotl or &H8000
				if prev and &H8000 then rotl = rotl or &H1
				rotl = cint( "&H" & hex(rotl) )
			case vbByte
				rotl = (prev and &H7F) * 2
				if prev and &H80 then rotl = rotl or &H1
				rotl = cbyte(rotl)
			case else
				Err.raise 13, typename(Me) & " runtime error", "Type mismatch. Conversion cannot be performed."
		end select
		prev = rotl
	next
end function
Response.write vbNewline
Response.write "rotl" & vbNewline
Response.write "----" & vbNewline
Response.write strwrap( decimal_to_bitstr( rotl( bitstr_to_decimal("00000000 00000000 00000000 00101010"), 3 ) ), 8, " " ) & vbNewline
Response.write strwrap( decimal_to_bitstr( rotl( bitstr_to_decimal("01010100 00000000 00000000 00000000"), 1 ) ), 8, " " ) & vbNewline
Response.write strwrap( decimal_to_bitstr( rotl( bitstr_to_decimal("01010100 00000000 00000000 00000000"), 3 ) ), 8, " " ) & vbNewline
Response.write strwrap( decimal_to_bitstr( rotl( cint( bitstr_to_decimal("00000000 00101010") ), 3 ) ), 8, " " ) & vbNewline
Response.write strwrap( decimal_to_bitstr( rotl( cint( bitstr_to_decimal("01010100 00000000") ), 1 ) ), 8, " " ) & vbNewline
Response.write strwrap( decimal_to_bitstr( rotl( cint( bitstr_to_decimal("01010100 00000000") ), 3 ) ), 8, " " ) & vbNewline
 
function rotr(byVal bits, byVal amount)
	dim prev, i
	prev = bits
	for i = 1 to amount
		select case vartype(bits)
			case vbLong
				rotr = int( ( prev and &H7FFFFFFF ) / 2 )
				if prev and &H80000000 then rotr = rotr or &H40000000
				if prev and &H1 then rotr = rotr or &H80000000
				rotr = clng(rotr)
			case vbInteger
				rotr = int( ( prev and &H7FFF ) / 2 )
				if prev and &H8000 then rotr = rotr or &H4000
				if prev and &H1 then rotr = rotr or &H8000
				rotr = cint( "&H" & hex(rotr) )
			case vbByte
				rotr = int( prev / 2 )
				if prev and &H1 then rotr = rotr or &H80
				rotr = cbyte(rotr)
			case else
				Err.raise 13, typename(Me) & " runtime error", "Type mismatch. Conversion cannot be performed."
		end select
		prev = rotr
	next
end function
Response.write vbNewline
Response.write "rotr" & vbNewline
Response.write "----" & vbNewline
Response.write strwrap( decimal_to_bitstr( rotr( bitstr_to_decimal("00000000 00000000 00000000 10101000"), 2 ) ), 8, " " ) & vbNewline
Response.write strwrap( decimal_to_bitstr( rotr( bitstr_to_decimal("00000000 00000000 00000000 00101010"), 2 ) ), 8, " " ) & vbNewline
Response.write strwrap( decimal_to_bitstr( rotr( bitstr_to_decimal("00000000 00000000 00000000 00101010"), 4 ) ), 8, " " ) & vbNewline
Response.write strwrap( decimal_to_bitstr( rotr( cint( bitstr_to_decimal("00000000 10101000") ), 2 ) ), 8, " " ) & vbNewline
Response.write strwrap( decimal_to_bitstr( rotr( cint( bitstr_to_decimal("00000000 00101010") ), 2 ) ), 8, " " ) & vbNewline
Response.write strwrap( decimal_to_bitstr( rotr( cint( bitstr_to_decimal("00000000 00101010") ), 4 ) ), 8, " " ) & vbNewline
 
%></pre></div>
 
			</div>
			<div id="container-ft">
				<h2>Sources</h2>
				<h3><%= Request.ServerVariables("SCRIPT_NAME") %></h3>
				<div class="code"><%= geshify( loadTextFile( Server.mapPath( Request.ServerVariables("SCRIPT_NAME") ) ), "asp" ) %></div>
			</div>
		</div>
		<!--// javascript tags //-->
	</body>
</html>