Visual Basic

'MakeDWord
'MakeWord
'HiByte
'LoByte
'HiWord
'LoWord
'RShWord
'LShWord
'LShDWord
'RShDWord
'DWordWSwap
'WordBSwap
'ToggleBit
'SetBit
'ClearBit
'SetBitVal
'IsBitSet

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)


'BBBB  Y   Y  TTTTT EEEEE
'B   B  Y  Y    T   E
'BBBB    Y      T   EEEEE
'B   B   Y      T   E
'BBBB   Y       T   EEEEE

'***************************


'Extract
'*********

Function LoWord(ByVal dw As Long) As Integer
CopyMemory LoWord, dw, 2
End Function

Function HiWord(ByVal dw As Long) As Integer
    CopyMemory HiWord, ByVal VarPtr(dw) + 2, 2
End Function

Function LoByte(ByVal dw As Integer) As Integer
CopyMemory LoByte, dw, 1
End Function

Function HiByte(ByVal dw As Integer) As Integer
    CopyMemory HiByte, ByVal VarPtr(dw) + 1, 1
End Function

'Swap
'*****
'(Little <--> Big Endian)

Function WordBSwap(ByVal Wd As Integer) As Integer
WordBSwap = MakeWord(HiByte(Wd), LoByte(Wd))
End Function

Function DWordWSwap(ByVal dw As Integer) As Integer
DWordWSwap = MakeDWord(HiWord(dw), LoWord(dw))
End Function

'Bit Shift
'**********

Function LShWord(ByVal Wd As Integer) As Integer
LShWord = MakeWord(HiByte(Wd), 0)
End Function

Function RShWord(ByVal Wd As Integer) As Integer
RShWord = MakeWord(0, LoByte(Wd))
End Function

Function LShDWord(ByVal dw As Long) As Long
LShDWord = MakeDWord(HiWord(dw), 0)
End Function

Function RShDWord(ByVal dw As Long) As Long
RShDWord = MakeDWord(0, LoWord(dw))
End Function

'Create
'***********

Function MakeWord(iLo As Integer, iHi As Integer) As Integer
CopyMemory MakeWord, iLo, 1
CopyMemory ByVal VarPtr(MakeWord) + 1, iHi, 1
End Function

Function MakeDWord(iLo As Integer, iHi As Integer) As Long
CopyMemory MakeDWord, iLo, 2
CopyMemory ByVal VarPtr(MakeWord) + 2, iHi, 2
End Function


'BBBB  IIIII  TTTTT
'B   B   I      T
'BBBB    I      T
'B   B   I      T
'BBBB  IIIII    T

'***************************


Sub SetBit(refByte As Integer, Bit As Integer)
      ' Create a bitmask with the 2 to the nth power bit set:
      Mask = 2 ^ Bit
      ' Set the nth Bit:
      refByte = refByte Or Mask
End Sub

Sub ToggleBit(refByte As Integer, Bit As Integer)
      ' Create a bitmask with the 2 to the nth power bit set:
      Mask% = 2 ^ Bit
      ' Toggle the nth Bit:
      refByte = refByte Xor Mask%
End Sub

 ' The ClearBit Sub clears the nth bit (Bit%) of an integer (Byte%).
Sub ClearBit(refByte As Integer, ByVal Bit As Integer)
      ' Create a bitmask with the 2 to the nth power bit set:
      Mask% = 2 ^ Bit
      ' Clear the nth Bit:
      refByte = refByte And Not Mask%
End Sub

Sub SetBitVal(refByte As Integer, ByVal Bit As Integer, ByVal Value As Boolean)
Mask% = 2 ^ Bit
If Value Then _
    refByte = refByte Or Mask _
Else _
      refByte = refByte And Not Mask%
End Sub

Function IsBitSet(refByte As Integer, ByVal Bit As Integer) As Boolean
      ' Create a bitmask with the 2 to the nth power bit set:
      Mask% = 2 ^ Bit
      ' Return the truth state of the 2 to the nth power bit:
      IsBitSet = ((refByte And Mask%) > 0)
End Function

Public Function ShiftRight(ByVal Value as Long) As Long
     Return (Value / (2 ^ 16))
End Function

Public Function ShiftLeft(ByVal Value as Long) As Long
     Return (Value * (2 ^ 16))
End Function

Public Function ShiftLeft(ByVal Value as Long) As Long
     Return (Value << 16)
End Function

Function IIf(Byval x as boolean, Byval o1 as object, Byval o2 as object) as Object
    If x then
       Return o1
    Else
       Return o2
    End if
End Function

On Error Goto ErrHandler
Dim xlApp As Excel.Application  'Error will Occur here when not installed
Set xlApp = New Excel.Application 

ErrHandler:
     If (Err.Number <> 0) Then
          'Of course, determine the Correct Error Number for this...
          MsgBox "Excel is not Installed!"
     End If

On Error Goto ErrHandler
Dim xlApp As Object  
Set xlApp = CreateObject("Excel.Application")  'Error will Occur here when not installed

ErrHandler:
     If (Err.Number <> 0) Then
          'Of course, determine the Correct Error Number for this...
          MsgBox "Excel is not Installed!"
     End If

Private Structure Test
     <VBFixedString(25)> Dim MyString As String
End Structure