.
Crear una función que mueva los bit's (Por si se aparece Karkrack, Cobein o similares NO ASM-Inline) a la izquierda o derecha.

(Los Números binarios se leen de izquierda a derecha, quien no tenga idea use la calculadora de windows o investigue en google como determinar el valor en Base 10).

Los ejemplos son considerando {1 Byte = 8 Bits, con el byte de signo.} la función deberá trabajar con (4 Bytes = 32 bit's = Long)

Ejemplo 1:

Se ingresa el numero  45  de desplazan 2 bit's a la izquierda el resultado es 180
es decir en binario:
00101101  {Desplazando 2 bit's Resultado--->} 10110100

Ejemplo 2:

Se ingresa el numero (-128) se desplazan 5 bit's a la izquierda el resultado es: 0
es decir en binario:
10000000 {Desplazando 5 bit's Resultado--->} 00000000

Ejemplo 3:

Se ingresa el numero 1 se desplazan 5 bit's a la izquierda el resultado es: 32
es decir en binario:
00000001 {Desplazando 5 bit's Resultado--->} 00100000

Ejemplo 4:

Se ingresa el numero 1 se desplazan 5 bit's a la derecha el resultado es: 0
es decir en binario:
00000001 {Desplazando 5 bit's Resultado--->} 00000000

Ejemplo 5:

Se ingresa el numero (-2) se desplazan 5 bit's a la derecha el resultado es: -1
es decir en binario:
11111110 {Desplazando 5 bit's Resultado--->} 11111111

Ejemplo 6:

Se ingresa el numero (-1) se desplazan 5 bit's a la derecha el resultado es: -1
es decir en binario:
11111111 {Desplazando 5 bit's Resultado--->} 11111111

Formato de la funcion:

 
Public Function Bits_d(ByVal lVal As Long, Optional lDesplazamiento As Integer) As Long
'   //  lVal                Indica el valor ingresado (Base 10).
'   //  lDesplazamiento     Indica la longitud de bit's a dezplazar.
'   //  Bits_d              Retorna el resultado Final (Base 10)
    ...
End Function
 
 

Edito:


Codigo para probar los resultados:

 
Private Sub Form_Load()
Dim lres        As Long
    lres = DebugAndRet(Bits_d(267614144, (-1)))
    lres = DebugAndRet(Bits_d(lres, (-6)))
    lres = DebugAndRet(Bits_d(lres, 2))
    lres = DebugAndRet(Bits_d(lres, 2))
    lres = DebugAndRet(Bits_d(lres, 2))
    lres = DebugAndRet(Bits_d(lres, 2))
    lres = DebugAndRet(Bits_d(lres, (-2)))
    lres = DebugAndRet(Bits_d(lres, (-24)))
End Sub
 
Private Function DebugAndRet(ByVal lVal As Long) As Long
    Debug.Print lVal
    DebugAndRet = lVal
End Function
 
 

Resultados en el Debug:


Resultados en Binario:
Pruebas con Test Manual...


Dulces Lunas!¡.

Function SHL(ByVal tStr As Long, ByVal count As Integer) As Long
    Dim Bc As Integer
    Dim Rc As Integer
 
    Bc = Int(count / 4)
    Rc = count Mod 4
    SHL = tStr
 
    For i = 1 To Bc
        SHL = SHL * 16
    Next
 
    For i = 1 To Rc
        SHL = SHL * 2
    Next
End Function
 
Function SHR(ByVal tStr As String, ByVal count As Integer) As String
    Dim Bc As Integer
    Dim Rc As Integer
 
    Bc = Fix(count / 4)
    Rc = count Mod 4
    SHR = tStr
 
    For i = 1 To Bc
        SHR = Fix(SHR / 16)
    Next
 
    For i = 1 To Rc
        SHR = Fix(SHR / 2)
    Next
End Function
 
Function DectoBin(ByVal tStr As String) As String
    Dim cp As Variant
    Dim rval As Double
    tStr = Trim$(tStr)
    DectoBin = ""
 
    rval = Val(tStr)
 
    While rval > 0
        If Mid(tStr, Len(tStr), 1) = "1" Or Mid(tStr, Len(tStr), 1) = "3" Or Mid(tStr, Len(tStr), 1) = "5" Or Mid(tStr, Len(tStr), 1) = "7" Or Mid(tStr, Len(tStr), 1) = "9" Then
            DectoBin = "1" & DectoBin
            rval = rval - 1
        Else
            DectoBin = "0" & DectoBin
        End If
        rval = Fix(rval / 2)
        tStr = Str$(rval)
    Wend
    If DectoBin = "" Then DectoBin = 0
End Function
 
Function BintoDec(ByVal tStr As String) As String
    Dim cp As Double
 
    BintoDec = 0
    cp = 1
 
    For i = Len(tStr) To 1 Step -1
        If i < Len(tStr) Then cp = cp * 2
        BintoDec = BintoDec + Mid(tStr, i, 1) * cp
    Next
End Function
 

Jeje pues estas funciones las hice hace tiempo cuando cree mi primer keygen para el Need For Speed Undergroud, ya que me fui explorando el programa en el OllyDbg y habiendo funciones que no entendia en si para que servian (SHL y SHR) solamente las copie, y los parametros son String y no aceptan negativos(creo)... salud!

.
Aquí dejo mi función antes de que Cobein la haga x¨P.

 
Private Function Bits_d(ByVal lVal As Long, ByVal lD As Integer) As Long
'   //  lVal    Indica el valor al cual se le dezplazaran los Bit's.
'   //  lD      Indica hacia donde se dezplazan los bits, si son menores a 0 a la izquierda de lo contrario si son mayores a 0 a la derecha.
'   //  Bits_d  Retorna el Valor final con los Bits desplazados.
    If (lD > &H0) And (lD < &H20) Then
        Do
            lVal = SwapBitR(lVal)
            lD = (lD - 1)
        Loop Until (lD = &H0)
    ElseIf (lD < &H0) And (lD > (&HFFFFFFE1)) Then
        Do
            lVal = SwapBitL(lVal)
            lD = (lD + 1)
        Loop Until (lD = &H0)
    ElseIf (lD > &H1F) Then
        If ((lVal And &H80000000) = &H80000000) Then
            lVal = &HFFFFFFFF
        Else
            lVal = &H0
        End If
    ElseIf (lD < &HFFFFFFE1) Then
        lVal = &H0
    End If
    Bits_d = lVal
End Function
 
Public Function SwapBitL(ByVal lVal As Long) As Long
    SwapBitL = (lVal And &H7FFFFFFF)
    If ((SwapBitL And &H40000000) = &H40000000) Then
        SwapBitL = (SwapBitL And &H7FFFFFFF)        'SwapBitL = ((SwapBitL Xor &H40000000) And &H7FFFFFFF)
        SwapBitL = ((SwapBitL + SwapBitL) Or &H80000000)
    Else
        SwapBitL = (SwapBitL + SwapBitL)
    End If
End Function
 
Public Function SwapBitR(ByVal lVal As Long) As Long
    If Not ((lVal And &HFFFFFFFF) = &HFFFFFFFF) Then
        SwapBitR = (lVal \ &H2)
    Else
        SwapBitR = lVal
    End If
End Function
 
 

 
Private Function ShiftL(ByVal bVal As Byte, ByVal lNumOfBits As Long) As Byte
    ShiftL = (bVal * (2 ^ lNumOfBits)) And &HFF ' //  El copymemory se puede sustituir por una mascara...
End Function
 
 

Temibles Lunas!¡.

Saludos a todos. Aquí dejo mi código: