[Reto] Barrido de Bits.

BlackZeroX · 10 Junio 2011, 04:02 AM

.
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:

Código (Vb) [Seleccionar]



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:

Código (Vb) [Seleccionar]



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:

Código [Seleccionar]



 535228288 
-105127936
-26281984
-6570496
-1642624
-410656
-1642624
-2147483648

Resultados en Binario:
Pruebas con Test Manual...

Código [Seleccionar]



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!¡.

raul338 · 10 Junio 2011, 04:50 AM

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

ignorantev1.1 · 10 Junio 2011, 20:46 PM

Código (vb) [Seleccionar]

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!

cobein · 11 Junio 2011, 01:34 AM

Edit: ops era con longs xD

Código [Seleccionar]

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Private Function ShiftL(ByVal bVal As Byte, ByVal lNumOfBits As Long) As Byte
    Dim lRet As Long
    lRet = bVal * (2 ^ lNumOfBits)
    CopyMemory ShiftL, lRet, 1
End Function
 
Private Function ShiftR(ByVal bVal As Byte, ByVal lNumOfBits As Long) As Byte
    ShiftR = bVal \ (2 ^ lNumOfBits)
End Function

BlackZeroX · 11 Junio 2011, 03:20 AM

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

Código (Vb) [Seleccionar]



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

Código (vb) [Seleccionar]



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!¡.

Karcrack · 11 Junio 2011, 16:14 PM

Código (vb) [Seleccionar]

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

Código [Seleccionar]

http://xbeat.net/vbspeed/c_ShiftLeft.htm#ShiftLeft05

Código (vb) [Seleccionar]

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

Código [Seleccionar]

http://xbeat.net/vbspeed/c_ShiftRight.htm#ShiftRight08

Tokes · 11 Junio 2011, 16:39 PM

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

Código [Seleccionar]

Private Function Bits_d_tks(ByVal d As Long, ByVal n As Long) As Long
    If n And &H80000000 Then
        n = -n
        While n > 0
            d = desp_1pos_izq(d)
            n = n - 1
        Wend
    Else
        While n > 0
            d = desp_1pos_der(d)
            n = n - 1
        Wend
    End If
    Bits_d_tks = d
End Function

Private Function desp_1pos_izq(ByVal num As Long) As Long
Dim i As Long, b As Long

    b = 1
    For i = 0 To 29
        If num And b Then
            b = b * 2
            desp_1pos_izq = desp_1pos_izq Or b
        Else
            b = b * 2
        End If
    Next
    
    If num And &H40000000 Then
        desp_1pos_izq = desp_1pos_izq Or &H80000000
    End If
End Function

Private Function desp_1pos_der(ByVal num As Long) As Long
    If num <> &HFFFFFFFF And num <> 0 Then
        num = num \ 2
    End If
    desp_1pos_der = num
End Function