More Binary/BitWise Functions for VBScript.
I decided to write some functions to do left shifts, right shifts, signed right shifts as well as roll lefts and roll rights and more. The thing that I like about these functions is that they will work with Long Integers, Integers and Bytes automatically without the need for separate functions.
I think they are pretty self explanatory for anyone searching for binary or bitwise stuff so I won’t go into too much detail about each function but I will say this… These functions will detect and preserve the sub-type of your variables and all operations are based for that data type. So if you want to do a left shift on a 16 bit integer then make sure you use CInt() on your variable first otherwise you may end up shifting over to 32 bits. Same thing goes for Long Integers CLng() and Bytes CByte().
Also worth mentioning is that I like to number my bits starting with bit 1 as the LSB. I know it’s common to start at bit 0 but with these functions there is no bit 0.
Enjoy!! and let me know what you think.
'*******************************************************************************
'* VBScript Binary Functions
'* http://chris.wastedhalo.com
'*
'* VBScript doesn't have the greatest support for Binary Operations
'* so I've created these functions for myself and decided to share them
'* with anyone who is interested. One of my issues with VBScript is that
'* it's constantly changing the sub-type of my variables when doing bit-wise
'* operations. It also throws up overflow errors when you try and mess the
'* sign bit. I have figured out a few tricks to prevent these problems and
'* have incorporated them into these functions.
'*
'* These functions all detect the sub-type of your variables and will preserve
'* them. They will work with Long Integers, Integers and Bytes but you
'* Must set the sub-type of your variables using CLng(), CInt() or CByte()
'* before hand to get the correct results.
'*
'* Long Integer = 32 Bits - Set Sub-Type with CLng()
'* Integer = 16 Bits - Set Sub-Type with CInt()
'* Byte = 8 Bits - Set Sub-Type with CByte()
'*
'* I tried to keep these as simple as possible while preserving sub-types,
'* working around VBScripts quirks and still having some error checking.
'* If you have any comments or suggestions please post them on my blog.
'*
'* Do what you like with these functions. All I ask is that you keep a
'* link back to my site included with them if they're shared or reposted.
'* chris.wastedhalo.com
'*******************************************************************************
'*******************************************************************************
'* GetBit(AnyNumber, BitNumberToCheck)
'* Returns True if bit is a 1, False if bit is a 0
'* Sub-Type does not matter
'*******************************************************************************
Function GetBit(pValue, pBit)
Dim BitMask
If pBit > 32 Then Err.Raise 6 ' Overflow (Bit number too high)
If pBit < 32 Then BitMask = 2 ^ (pBit - 1) Else BitMask = "&H80000000"
GetBit = CBool(pValue AND BitMask)
End Function
'*******************************************************************************
'* SetBit(AnyNumber, BitNumberToChange, ChangeBitTo)
'* Returns a new number with your bit changed.
'* For the pNewValue argument you can use True/False or (1 or 0)
'*******************************************************************************
Function SetBit(pValue, pBit, pNewValue)
Dim NewValue, BitMask, vType
If pBit > 32 Then Err.Raise 6 ' Bit number too high
If pBit < 32 Then BitMask = 2 ^ (pBit - 1) Else BitMask = "&H80000000"
vType = VarType(pValue)
If vType <> vbLong And vType <> vbInteger And vType <> vbByte Then Err.Raise 13
If pNewValue Then
NewValue = CLng(pValue Or BitMask)
Else
NewValue = CLng(pValue And Not BitMask)
End If
Select Case vType
Case vbLong: SetBit = CLng(NewValue)
Case vbInteger: SetBit = CInt("&H"+ Hex(NewValue And "&HFFFF"))
Case vbByte: SetBit = cByte(NewValue And "&HFF")
End Select
End Function
'*******************************************************************************
'* ToggleBit(AnyNumber, BitNumberToToggle)
'* Returns a new number with your bit toggled.
'*******************************************************************************
Function ToggleBit(pValue, pBit)
Dim BitMask
If pBit > 32 Then Err.Raise 6 ' Bit number too high
If pBit < 32 Then BitMask = 2 ^ (pBit - 1) Else BitMask = "&H80000000"
Select Case VarType(pValue)
Case vbLong: ToggleBit = pValue XOR BitMask
Case vbInteger: ToggleBit = CInt("&H"+ Hex((pValue XOR BitMask) And "&HFFFF"))
Case vbByte: ToggleBit = CByte((pValue XOR BitMask) And "&HFF")
Case Else: Err.Raise 13 ' Not a supported type
End Select
End Function
'*******************************************************************************
'* ExtractBits(AnyNumber, BitStartPosition, NumberOfBits)
'* Returns the decimal value of the extracted bits.
'*******************************************************************************
Function ExtractBits(pValue, pStartPos, pBits)
Dim BitMask, tmpMask, i, NewValue
For i = pStartPos - pBits + 1 To pStartPos
If i < 32 Then tmpMask = 2 ^ (i - 1) Else tmpMask = "&H80000000"
BitMask = BitMask Or tmpMask
Next
NewValue = CLng(pValue And BitMask)
If NewValue And "&H80000000" Then tmpMask = pBits Else tmpMask = 0
NewValue = (NewValue And "&H7FFFFFFF") / 2 ^ (pStartPos - pBits)
If tmpMask Then
If tmpMask < 32 Then BitMask = 2 ^ (tmpMask - 1) Else BitMask = "&H80000000"
NewValue = NewValue Or BitMask
End If
ExtractBits = CLng(NewValue)
End Function
'*******************************************************************************
'* LeftShift(AnyNumber, BitsToShiftBy)
'* Returns a new number with bits shifted. 0's are shifted in from the
'* right, bits will fall off on the left.
'*******************************************************************************
Function LeftShift(pValue, pShift)
Dim NewValue, PrevValue, i
PrevValue = pValue
For i = 1 to pShift
Select Case VarType(pValue)
Case vbLong
NewValue = (PrevValue And "&H3FFFFFFF") * 2
If PrevValue And "&H40000000" Then NewValue = NewValue Or "&H80000000"
NewValue = CLng(NewValue)
Case vbInteger
NewValue = (PrevValue And "&H3FFF") * 2
If PrevValue And "&H4000" Then NewValue = NewValue Or "&H8000"
NewValue = CInt("&H"+ Hex(NewValue))
Case vbByte
NewValue = CByte((PrevValue And "&H7F") * 2)
Case Else: Err.Raise 13 ' Not a supported type
End Select
PrevValue = NewValue
Next
LeftShift = NewVAlue
End Function
'*******************************************************************************
'* RollLeft(AnyNumber, BitsToShiftBy)
'* Returns a new number with bits shifted
'* Bits are shifted to the left. Bits that that fall off
'* get rolled over to the right.
'*******************************************************************************
Function RollLeft(pValue, pRoll)
Dim NewValue, PrevValue, i
PrevValue = pValue
For i = 1 to pRoll
Select Case VarType(pValue)
Case vbLong
NewValue = (PrevValue And "&H3FFFFFFF") * 2
If PrevValue And "&H40000000" Then NewValue = NewValue Or "&H80000000"
If PrevValue And "&H80000000" Then NewValue = NewValue Or "&H1"
NewValue = CLng(NewValue)
Case vbInteger
NewValue = (PrevValue And "&H3FFF") * 2
If PrevValue And "&H4000" Then NewValue = NewValue Or "&H8000"
If PrevValue And "&H8000" Then NewValue = NewValue Or "&H1"
NewValue = CInt("&H"+ Hex(NewValue))
Case vbByte
NewValue = (PrevValue And "&H7F") * 2
If PrevValue And "&H80" Then NewValue = NewValue Or "&H1"
NewValue = CByte(NewValue)
Case Else: Err.Raise 13 ' Not a supported type
End Select
PrevValue = NewValue
Next
RollLeft = NewVAlue
End Function
'*******************************************************************************
'* RightShift(AnyNumber, BitsToShiftBy)
'* Returns a new number with bits shifted
'* 0's are shifted in from the left. Bits will fall off on the right.
'*******************************************************************************
Function RightShift(pValue, pShift)
Dim NewValue, PrevValue, i
PrevValue = pValue
For i = 1 to pShift
Select Case VarType(pValue)
Case vbLong
NewValue = Int((PrevValue And "&H7FFFFFFF") / 2)
If PrevValue And "&H80000000" Then NewValue = NewValue Or "&H40000000"
NewValue = CLng(NewValue)
Case vbInteger
NewValue = Int((PrevValue And "&H7FFF") / 2)
If PrevValue And "&H8000" Then NewValue = NewValue Or "&H4000"
NewValue = CInt(NewValue)
Case vbByte
NewValue = CByte(PrevValue / 2)
Case Else: Err.Raise 13 ' Not a supported type
End Select
PrevValue = NewValue
Next
RightShift = PrevValue
End Function
'*******************************************************************************
'* SignedRightShift(AnyNumber, BitsToShiftBy)
'* Returns a new number with bits shifted
'* The sign bit is copied and shifted in from the left.
'* Bits will fall off on the right.
'*******************************************************************************
Function SignedRightShift(pValue, pShift)
Dim NewValue, PrevValue, i
PrevValue = pValue
For i = 1 to pShift
Select Case VarType(pValue)
Case vbLong
NewValue = Int((PrevValue And "&H7FFFFFFF") / 2)
If PrevValue And "&H80000000" Then NewValue = NewValue Or "&HC0000000"
NewValue = CLng(NewValue)
Case vbInteger
NewValue = Int((PrevValue And "&H7FFF") / 2)
If PrevValue And "&H8000" Then NewValue = NewValue Or "&HC000"
NewValue = CInt("&H"+ Hex(NewValue))
Case vbByte
NewValue = Int(PrevValue / 2)
If PrevValue And "&H80" Then NewValue = NewValue Or "&HC0"
NewValue = CByte(NewValue)
Case Else: Err.Raise 13 ' Not a supported type
End Select
PrevValue = NewValue
Next
SignedRightShift = PrevValue
End Function
'*******************************************************************************
'* RollRight(AnyNumber, BitsToShiftBy)
'* Returns a new number with bits shifted
'* Bits are shifted to the right. Bits that fall off
'* get rolled over to the left.
'*******************************************************************************
Function RollRight(pValue, pRoll)
Dim NewValue, PrevValue, i
PrevValue = pValue
For i = 1 to pRoll
Select Case VarType(pValue)
Case vbLong
NewValue = Int((PrevValue And "&H7FFFFFFF") / 2)
If PrevValue And "&H80000000" Then NewValue = NewValue Or "&H40000000"
If PrevValue And "&H1" Then NewValue = NewValue Or "&H80000000"
NewValue = CLng(NewValue)
Case vbInteger
NewValue = Int((PrevValue And "&H7FFF") / 2)
If PrevValue And "&H8000" Then NewValue = NewValue Or "&H4000"
If PrevValue And "&H1" Then NewValue = NewValue Or "&H8000"
NewValue = CInt("&H"+ Hex(NewValue))
Case vbByte
NewValue = Int(PrevValue / 2)
If PrevValue And "&H1" Then NewValue = NewValue Or "&H80"
NewValue = CByte(NewValue)
Case Else: Err.Raise 13 ' Not a supported type
End Select
PrevValue = NewValue
Next
RollRight = PrevValue
End Function
'*******************************************************************************
'* bMask(BitNumber)
'* Returns a number with all bits set to 0 except for the specified bit
'*******************************************************************************
Function bMask(pBit)
If pBit < 32 Then bMask = 2 ^ (pBit - 1) Else bMask = "&H80000000"
End Function
'*******************************************************************************
'* Dec2Bin(AnyNumber)
'* Returns a string representing the number in binary.
'*******************************************************************************
Function Dec2Bin(pValue)
Dim TotalBits, i
Select Case VarType(pValue)
Case vbLong: TotalBits = 32
Case vbInteger: TotalBits = 16
Case vbByte: TotalBits = 8
Case Else: Err.Raise 13 ' Not a supported type
End Select
For i = TotalBits to 1 Step -1
If pValue And bMask(i) Then Dec2Bin = Dec2Bin + "1" Else Dec2Bin = Dec2Bin + "0"
Next
End Function
'*******************************************************************************
'* Bin2Dec(BinaryString)
'* Returns the decimal value of a string of binary.
'*******************************************************************************
Function Bin2Dec(pBinString)
Dim Binary, i
Binary = Trim(Right(pBinString, Len(pBinString) - Instr(pBinString,"1") + 1))
If Len(Binary) > 32 Then Err.Raise 6' Overflow
For i = 1 To Len(Binary)
Select Case Mid(Binary, i, 1)
Case "1": Bin2Dec = Bin2Dec Or bMask(Len(Binary) - i + 1)
Case "0": 'Do Nothing
Case Else: Err.Raise 13 ' Not 1 or 0 (Type Mismatch Error)
End Select
Next
End Function
Category: Classic ASP
About the Author (Author Profile)
I'm a factory certified trainer for Haas Automation and train the service technicians who repair CNC mills and lathes. I'm a bit of a computer geek and enjoy programming, web design, 3D printing, playing with my laser cutter/engraver and taking things apart to see how they work.Subscribe
If you enjoyed this article, subscribe to receive more just like it.
In Office 365 and possibly before there are functions named BITLSHIFT and BITRSHIFT that can be accessed via Application.WorksheetFunction.Bitlshift and Application.WorksheetFunction.Bitrshift. They seem to work well with longs – I’m using them to do IP arithmetic and so far so good.
Good work but vbscript in some software creates an overflow when bit 32 is high. How to solve this issue in the functions above?
I have found that when you set the sign bit using hex it works without overflow errors. That’s why you see things like: BitMask = “&H80000000”. I don’t think you will get overflow errors with my functions, if you do please give me an example so I can recreate it.
Muito obrigado … salvou a minha vida !!! Que Deus te abençoe
Thank you very much … saved my life !!! God bless you
You’re welcome, glad I could help.
Chris,
This is really great as I’m working on converting an algorithm coded in C to vbscript. I’ve tested your bit shift functions and they seem to work great. However, I seem constrained by the fact that all vbscript bitwise operations (XOR, AND) only use the integer data-type.
As I am working with numbers above 2,147,483,647 (though not by much) I can’t figure out how to do what should be relatively simple bitwise operations. I’m wondering if you’ve experienced this before and if you might have a solution. I’m sure there must be some way to divide the numbers up and perform operations on them, but I can’t wrap my head around it!
Where are these values coming from that you want to do bitwise ops on? If you just want to do bitwise operations it should be possible as long as you can get the data into VBScript. Can you give me an example? It would help me to get a better idea of what you’re trying to do.
XOR & AND only effect bits in the same bit position so if you can break the number into two parts you can just XOR or AND the parts separately. Without knowing how you are getting the data into VB without getting overflow erros I can’t be more specific.