.
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 (http://es.wikipedia.org/wiki/Representación_de_números_con_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:
535228288
-105127936
-26281984
-6570496
-1642624
-410656
-1642624
-2147483648
Resultados en Binario:
Pruebas con Test Manual...
00001111111100110111011111000000 <-- {267614144} <--- De este binario se parte...
00011111111001101110111110000000 <-- {-01}
11111001101110111110000000000000 <-- {-06}
11111110011011101111100000000000 <-- {+02}
11111111100110111011111000000000 <-- {+02}
11111111111001101110111110000000 <-- {+02}
11111111111110011011101111100000 <-- {+02}
11111111111001101110111110000000 <-- {-02}
10000000000000000000000000000000 <-- {-24} <-- {-2147483648}
Dulces Lunas!¡.
Interesante reto, pero la firma salio mal (o al menos desde Opera Mobile lo estoy viendo mal)
Lastima no tengo a vb en el celular :xD
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!¡.
Public Static Function ShiftLeft05(ByVal Value As Long, ByVal ShiftCount As Long) As Long
' by Jost Schwider, jost@schwider.de, 20010928
Dim Pow2(0 To 31) As Long
Dim i As Long
Dim mask As Long
Select Case ShiftCount
Case 1 To 31
'Ggf. Initialisieren:
If i = 0 Then
Pow2(0) = 1
For i = 1 To 30
Pow2(i) = 2 * Pow2(i - 1)
Next i
End If
'Los gehts:
mask = Pow2(31 - ShiftCount)
If Value And mask Then
ShiftLeft05 = (Value And (mask - 1)) * Pow2(ShiftCount) Or &H80000000
Else
ShiftLeft05 = (Value And (mask - 1)) * Pow2(ShiftCount)
End If
Case 0
ShiftLeft05 = Value
End Select
End Function
http://xbeat.net/vbspeed/c_ShiftLeft.htm#ShiftLeft05
Public Function ShiftRight08(ByVal Value As Long, ByVal ShiftCount As Long) As Long
' by Jost Schwider, jost@schwider.de, 20011010
Select Case ShiftCount
Case 0&: ShiftRight08 = Value
Case 1&: ShiftRight08 = (Value And &HFFFFFFFE) \ &H2&
Case 2&: ShiftRight08 = (Value And &HFFFFFFFC) \ &H4&
Case 3&: ShiftRight08 = (Value And &HFFFFFFF8) \ &H8&
Case 4&: ShiftRight08 = (Value And &HFFFFFFF0) \ &H10&
Case 5&: ShiftRight08 = (Value And &HFFFFFFE0) \ &H20&
Case 6&: ShiftRight08 = (Value And &HFFFFFFC0) \ &H40&
Case 7&: ShiftRight08 = (Value And &HFFFFFF80) \ &H80&
Case 8&: ShiftRight08 = (Value And &HFFFFFF00) \ &H100&
Case 9&: ShiftRight08 = (Value And &HFFFFFE00) \ &H200&
Case 10&: ShiftRight08 = (Value And &HFFFFFC00) \ &H400&
Case 11&: ShiftRight08 = (Value And &HFFFFF800) \ &H800&
Case 12&: ShiftRight08 = (Value And &HFFFFF000) \ &H1000&
Case 13&: ShiftRight08 = (Value And &HFFFFE000) \ &H2000&
Case 14&: ShiftRight08 = (Value And &HFFFFC000) \ &H4000&
Case 15&: ShiftRight08 = (Value And &HFFFF8000) \ &H8000&
Case 16&: ShiftRight08 = (Value And &HFFFF0000) \ &H10000
Case 17&: ShiftRight08 = (Value And &HFFFE0000) \ &H20000
Case 18&: ShiftRight08 = (Value And &HFFFC0000) \ &H40000
Case 19&: ShiftRight08 = (Value And &HFFF80000) \ &H80000
Case 20&: ShiftRight08 = (Value And &HFFF00000) \ &H100000
Case 21&: ShiftRight08 = (Value And &HFFE00000) \ &H200000
Case 22&: ShiftRight08 = (Value And &HFFC00000) \ &H400000
Case 23&: ShiftRight08 = (Value And &HFF800000) \ &H800000
Case 24&: ShiftRight08 = (Value And &HFF000000) \ &H1000000
Case 25&: ShiftRight08 = (Value And &HFE000000) \ &H2000000
Case 26&: ShiftRight08 = (Value And &HFC000000) \ &H4000000
Case 27&: ShiftRight08 = (Value And &HF8000000) \ &H8000000
Case 28&: ShiftRight08 = (Value And &HF0000000) \ &H10000000
Case 29&: ShiftRight08 = (Value And &HE0000000) \ &H20000000
Case 30&: ShiftRight08 = (Value And &HC0000000) \ &H40000000
Case 31&: ShiftRight08 = CBool(Value And &H80000000)
End Select
http://xbeat.net/vbspeed/c_ShiftRight.htm#ShiftRight08