Чтение и изменение бита в числе

Case Is = 2         
        intInf(0) = Asc(MSComm1.Input) '
        intInf(1) = Asc(MSComm1.Input) ' 
        intInf(2) = Asc(MSComm1.Input) ' 
        intInf(3) = Asc(MSComm1.Input) ' 
       ' и т.д

Public Function ToBin(ByVal bByte As Byte) As String
Dim i As Integer
For i = 0 To 7
If bByte And 2 ^ i Then
ToBin = 1 & ToBin
 Else
ToBin = 0 & ToBin
 End If
Next i
End Function

Function MaskL(ByVal MaskS As String) As Long
 Dim p As Long, m As Long, L As Long
 L = Len(MaskS)
 m = 0
 For p = 0 To L - 1
  If Mid(MaskS, p + 1, 1) = "1" Then m = BitPut(m, p)
 Next p
 MaskL = m
End Function
Function MaskS(ByVal MaskL As Long) As String
 Dim p As Long, S As String
 S = ""
 For p = 0 To 15
  If BitGet(MaskL, p) Then
   S = S & "1"
  Else
   S = S & "0"
  End If
 Next p
 MaskS = S
End Function

Sub MaskCheck()
 Dim m1 As Long, m2 As Long, m3 As Long
 Dim s1 As String, s2 As String, s3 As String
 Dim rA As String, rB As String
 
 Call InitDeg2
 s1 = "011000":
 s2 = "000011"
 s3 = "011111"
 m1 = MaskL(s1)
 m2 = MaskL(s2)
 m3 = MaskL(s3)
 
 rA = Mid(MaskS(m1 Xor m3), 1, 5)
 rB = Mid(MaskS(m2 ND m3), 1, 5)
End Sub

Private Deg2(31) As Long
 
Private Sub initDeg2()
    Dim i&
    For i = 0 To 30
        Deg2(i) = 2 ^ i
    Next
    Deg2(i) = -2 ^ i
End Sub
 
Function LeftBitShift(ByVal lVal As Long, ByVal bitCnt As Long) As Long
    LeftBitShift = lVal * Deg2(bitCnt) '2 ^ bitCnt
End Function
Function RightBitShift(ByVal lVal As Long, ByVal bitCnt As Long) As Long
    RightBitShift = lVal \ Deg2(bitCnt) '2 ^ bitCnt
End Function

Option Explicit
 
Private Const tcompSHIFT_LZX_WINDOW As Long = 8
Private Const tcompTYPE_LZX As Long = 3
Private Deg2(31) As Long
 
Private Sub initDeg2()
    Dim i&
    For i = 0 To 30
        Deg2(i) = 2 ^ i
    Next
    Deg2(i) = -2 ^ i
End Sub
 
Private Function LeftBitShift(ByVal lVal As Long, ByVal bitCnt As Long) As Long
    LeftBitShift = lVal * Deg2(bitCnt) ' 2 ^ bitCnt
End Function
 
Private Function TCOMPfromLZXWindow(ByVal w As Long) As Long
    TCOMPfromLZXWindow = LeftBitShift(w, tcompSHIFT_LZX_WINDOW) Or tcompTYPE_LZX
End Function
 
Private Sub Command1_Click()
    MsgBox TCOMPfromLZXWindow(21), vbInformation, "0x" & Hex(TCOMPfromLZXWindow(21)) ' 3 это неправильно...
End Sub

Public Function TCOMPfromLZXWindow(ByVal w As Long) As Long
'    Return w << tcompSHIFT_LZX_WINDOW Or tcompTYPE_LZX
    TCOMPfromLZXWindow = w * 2 ^ tcompSHIFT_LZX_WINDOW Or tcompTYPE_LZX
End Function

Option Explicit
 
Private Const tcompSHIFT_LZX_WINDOW As Long = 8
Private Const tcompTYPE_LZX As Long = 3
Private Deg2(31) As Long
 
Private Sub initDeg2()
    Dim i&
    For i = 0 To 30
        Deg2(i) = 2 ^ i
    Next
    Deg2(i) = -2 ^ i
End Sub
 
Private Function LeftBitShift(ByVal lVal As Long, ByVal bitCnt As Long) As Long
    LeftBitShift = lVal * Deg2(bitCnt) ' 2 ^ bitCnt
End Function
 
'Private Function TCOMPfromLZXWindow(ByVal w As Long) As Long
'    TCOMPfromLZXWindow = LeftBitShift(w, tcompSHIFT_LZX_WINDOW) Or tcompTYPE_LZX
'End Function
 
Public Function TCOMPfromLZXWindow(ByVal w As Long) As Long
'    Return w << tcompSHIFT_LZX_WINDOW Or tcompTYPE_LZX
    TCOMPfromLZXWindow = w * 2 ^ tcompSHIFT_LZX_WINDOW Or tcompTYPE_LZX
End Function
 
Private Sub Command1_Click()
    MsgBox TCOMPfromLZXWindow(21), vbInformation, "0x" & Hex(TCOMPfromLZXWindow(21)) ' 5379 тут уже правильно...
End Sub
 
Private Sub Form_Load()
    Dim i As Long
    
    For i = 0 To 31
        Deg2(i) = 0
    Next
End Sub

Option Explicit
Private Const tcompSHIFT_LZX_WINDOW As Long = 8
Private Const tcompTYPE_LZX As Long = 3
Private Deg2(31) As Long
 
Private Sub initDeg2()
    Dim i&
    For i = 0 To 30
        Deg2(i) = 2 ^ i
    Next
    Deg2(i) = -2 ^ i
End Sub
 
Private Function LeftBitShift(ByVal lVal As Long, ByVal bitCnt As Long) As Long
    LeftBitShift = lVal * Deg2(bitCnt) ' 2 ^ bitCnt
End Function
 
Private Function TCOMPfromLZXWindow(ByVal w As Long) As Long
    TCOMPfromLZXWindow = LeftBitShift(w, tcompSHIFT_LZX_WINDOW) Or tcompTYPE_LZX
End Function
 
Private Sub Command1_Click()
    MsgBox TCOMPfromLZXWindow(21), vbInformation, "0x" & Hex(TCOMPfromLZXWindow(21)) ' 5379 тут уже правильно...
End Sub
 
Private Sub Command2_Click()
    MsgBox TCOMPfromLZXWindow(15), vbInformation, "0x" & Hex(TCOMPfromLZXWindow(15)) ' 3843 теперь всё правильно
End Sub
 
Private Sub Form_Load()
    initDeg2
End Sub

Function TCOMPfromLZXWindow(ByVal w As Long) As Long
'    Return w << tcompSHIFT_LZX_WINDOW Or tcompTYPE_LZX
'    2 ^ tcompSHIFT_LZX_WINDOW = &H100
    TCOMPfromLZXWindow = w * &H100 Or tcompTYPE_LZX
End Function