primeramente le doy gracias a BlackZeroX (Astaroth) por haberme enseñado a manipular los bits y bytes y las famosas
mascaras de bytes por haberme tenido paciencia cuando no entendia :xD gracias tio ;D
aqui esta un poco de lo que ya sé >:D
lo que hace este trozo de codigo es invertir cada byte del valor insertado acepta de Tipo Byte, Integer, Long.
hace la rotacion Byte por Byte...
' DWORD = LONG... ?
' HIGH/LOW DWORD
Function HLDWORD(DWord As Long) As Long
Dim RotHWord As Integer
Dim RotLWord As Integer
RotHWord = HLWORD( _
HWord(DWord) _
)
RotLWord = HLWORD( _
LWord(DWord) _
)
HLDWORD = MakeDWord(RotHWord, RotLWord)
End Function
' HIGH/LOW WORD
Function HLWORD(Word As Integer) As Integer
Dim RotHbyte As Byte
Dim RotLbyte As Byte
RotHbyte = hByte(Word): RotHbyte = RotBits(RotHbyte)
RotLbyte = LByte(Word): RotLbyte = RotBits(RotLbyte)
HLWORD = MakeWord(RotHbyte, RotLbyte)
End Function
Function HWord(DWord As Long) As Integer
HWord = (DWord / &H10000)
End Function
Function LWord(DWord As Long) As Integer
If DWord And &H8000& Then
LWord = &H8000 Or (DWord And &H7FFF&)
Else
LWord = DWord And &HFFFF&
End If
End Function
Function hByte(Word As Integer) As Byte
If Word And &H8000 Then
If Not (Word Or &HFF) = &HFFFFFFFF Then Word = (Word Xor &HFF)
hByte = &H80 Or ((Word And &H7FFF) \ &HFF)
Else
hByte = Word \ 256
End If
End Function
Function LByte(Word As Integer) As Byte
LByte = (Word And &HFF)
End Function
' 1 byte, Rotbits
Function RotBits(XByte As Byte) As Byte
Dim BytesTmp As Byte
BytesTmp = (XByte And &H1) * &H80
BytesTmp = BytesTmp Or (XByte And &H2) * &H20
BytesTmp = BytesTmp Or (XByte And &H4) * &H8
BytesTmp = BytesTmp Or (XByte And &H8) * &H2
BytesTmp = BytesTmp Or (XByte And &H10) / &H2
BytesTmp = BytesTmp Or (XByte And &H20) / &H8
BytesTmp = BytesTmp Or (XByte And &H40) / &H20
BytesTmp = BytesTmp Or (XByte And &H80) / &H80
RotBits = BytesTmp
End Function
' Makers...
' HWord & LWord = 8 Bytes
Function MakeDWord(HWord As Integer, LWord As Integer) As Long
MakeDWord = (HWord * &H10000) Or (LWord And &HFFFF&)
End Function
' hByte & Lbyte = 4 bytes
Function MakeWord(hByte As Byte, LByte As Byte) As Integer
If hByte And &H80 Then
MakeWord = ((hByte * &H100&) Or LByte) Or &HFFFF0000
Else
MakeWord = (hByte * &H100) Or LByte
End If
End Function
' By Raul100 @ Raul_hernandez_u@hotmail.com
' no quitar este texto
HLDWORD ( 1410872291 )
INPUT:
1410872291
0101 0100 0001 1000 0011 0011 1110 0011
OUTPUT
706268359
0010 1010 0001 1000 1100 1100 1100 0111
.
El algoritmo esta bueno para hacer una encriptacion de longitud 32bits.
Dulces Lunas!¡.
mira que casualidad recuerdas cuantas lineas de codigo se escribieron anteriormente para invertir bits adecuadamente y no por byte a byte... es decir los 4 bytes de un jalon con las funciones que has dejado se hace mas corto.
Public Function Rot32Bits(ByVal lLong As Long) As Long
' // Rota los bits de un Long (DWord)
' // Manda el 1er bit al final el segundo al antepenultimo, el tercero uno antes del antepenultimo, etc...
' // (1410872291) -> 0101 0100 0001 1000 0011 0011 1110 0011
' // Invertidos:
' // (-942925782) -> 1100 0111 1100 1100 0001 1000 0010 1010
Dim iLWord As Integer
Dim iHWord As Integer
iLWord = LWord(lLong)
iHWord = HWord(lLong)
If (lLong And &H1) Then
Rot32Bits = ((RotBits(LByte(iLWord)) And &H7F) * &H1000000) Or &H80000000
Else
Rot32Bits = (RotBits(LByte(iLWord)) * &H1000000)
End If
Rot32Bits = Rot32Bits Or _
(RotBits(hByte(iLWord)) * &H10000) Or _
(RotBits(LByte(iHWord)) * &H100) Or _
(RotBits(hByte(iHWord)))
End Function
Dulces Lunas!¡.
Cita de: BlackZeroX (Astaroth) en 21 Octubre 2011, 06:30 AM
.
El algoritmo esta bueno para hacer una encriptacion de longitud 32bits.
Dulces Lunas!¡.
si, eso estaba pensando cuando estaba escribiendola :D
Cita de: BlackZeroX (Astaroth) en 21 Octubre 2011, 07:00 AM
mira que casualidad recuerdas cuantas lineas de codigo se escribieron anteriormente para invertir bits adecuadamente y no por byte a byte... es decir los 4 bytes de un jalon con las funciones que has dejado se hace mas corto.
Public Function Rot4Bits(ByVal lLong As Long) As Long
' // Rota los bits de un Long (DWord)
' // Manda el 1er bit al final el segundo al antepenultimo, el tercero uno antes del antepenultimo, etc...
' // (1410872291) -> 0101 0100 0001 1000 0011 0011 1110 0011
' // Invertidos:
' // (-942925782) -> 1100 0111 1100 1100 0001 1000 0010 1010
Dim iLWord As Integer
Dim iHWord As Integer
iLWord = LWord(lLong)
iHWord = HWord(lLong)
If (lLong And &H1) Then
Rot4Bits = ((RotBits(LByte(iLWord)) And &H7F) * &H1000000) Or &H80000000
Else
Rot4Bits = (RotBits(LByte(iLWord)) * &H1000000)
End If
Rot4Bits = Rot4Bits Or _
(RotBits(hByte(iLWord)) * &H10000) Or _
(RotBits(LByte(iHWord)) * &H100) Or _
(RotBits(hByte(iHWord)))
End Function
Dulces Lunas!¡.
andale >:D esta bueno!
pero si inserto un valor tipo byte o integer siempre me devuelve un long :P
Cita de: Raul100 en 21 Octubre 2011, 07:09 AM
pero si inserto un valor tipo byte o integer siempre me devuelve un long :P
Option Explicit
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal RetVal As Long)
' DWORD = LONG... ?
' HIGH/LOW DWORD
Function hlDWORD(ByVal DWord As Long) As Long
hlDWORD = MakeDWord(hlWORD(hWord(DWord)), hlWORD(lWord(DWord)))
End Function
' HIGH/LOW WORD
Function hlWORD(ByVal Word As Integer) As Integer
hlWORD = MakeWord(Rot8Bits(hByte(Word)), Rot8Bits(lByte(Word)))
End Function
Function hWord(ByVal DWord As Long) As Integer
hWord = (DWord \ &H10000)
End Function
Function lWord(ByVal DWord As Long) As Integer
lWord = DWord And &HFFFF&
End Function
Function hByte(ByVal iWord As Integer) As Byte
hByte = (iWord \ &H100) And &HFF
End Function
Function lByte(ByVal Word As Integer) As Byte
lByte = (Word And &HFF)
End Function
' Makers...
' HWord & LWord = 8 bits
Function MakeDWord(ByVal hWord As Integer, ByVal lWord As Integer) As Long
MakeDWord = (hWord * &H10000) Or (lWord And &HFFFF&)
End Function
' hByte & Lbyte = 4 bits
Function MakeWord(ByVal hByte As Byte, ByVal lByte As Byte) As Integer
MakeWord = (((hByte And &H7F) * &H100&) Or lByte)
If hByte And &H80 Then MakeWord = MakeWord Or &H8000
End Function
' 1 byte, Rot8Bits
Function Rot8Bits(ByVal xByte As Byte) As Byte
Dim BytesTmp As Byte
BytesTmp = (xByte And &H1) * &H80
BytesTmp = BytesTmp Or (xByte And &H2) * &H20
BytesTmp = BytesTmp Or (xByte And &H4) * &H8
BytesTmp = BytesTmp Or (xByte And &H8) * &H2
BytesTmp = BytesTmp Or (xByte And &H10) / &H2
BytesTmp = BytesTmp Or (xByte And &H20) / &H8
BytesTmp = BytesTmp Or (xByte And &H40) / &H20
BytesTmp = BytesTmp Or (xByte And &H80) / &H80
Rot8Bits = BytesTmp
End Function
' By Raul100 @ Raul_hernandez_u@hotmail.com
' no quitar este texto
Public Function Rot16Bits(ByVal iWord As Integer) As Integer
' // Rota los bits de un integer (DWord)
Rot16Bits = ((Rot8Bits(lByte(iWord)) And &H7F) * &H100)
If (iWord And &H1) Then Rot16Bits = Rot16Bits Or &H8000
Rot16Bits = Rot16Bits Or (Rot8Bits(hByte(iWord)))
End Function
Public Function Rot32Bits(ByVal lLong As Long) As Long
' // Rota los bits de un Long (DWord)
' // Manda el 1er bit al final el segundo al antepenultimo, el tercero uno antes del antepenultimo, etc...
' // (1410872291) -> 0101 0100 0001 1000 0011 0011 1110 0011
' // Invertidos:
' // (-942925782) -> 1100 0111 1100 1100 0001 1000 0010 1010
Rot32Bits = &H10000 * (Rot16Bits(lWord(lLong)) And &H7FFF)
Rot32Bits = Rot32Bits Or Rot16Bits(hWord(lLong))
If (lLong And &H1) Then Rot32Bits = Rot32Bits Or &H80000000
End Function
Public Function Rot64Bits(ByVal lDouble As Double) As Double
' // Rota los bits de un Double (QWord)
' // Manda el 1er bit al final el segundo al antepenultimo, el tercero uno antes del antepenultimo, etc...
Dim lDWord As Long
GetMem4 ByVal VarPtr(lDouble), ByVal VarPtr(lDWord)
PutMem4 ByVal (VarPtr(Rot64Bits) + &H4), Rot32Bits(lDWord)
GetMem4 ByVal (VarPtr(lDouble) + &H4), ByVal VarPtr(lDWord)
PutMem4 ByVal VarPtr(Rot64Bits), Rot32Bits(lDWord)
End Function
Private Sub Form_Load()
Const VALOR8BITS As Byte = &H54 ' // MAX &HFF
Const VALOR16BITS As Integer = &H4F3F ' // MAX &HFFFF
Const VALOR32BITS As Long = &H541833E3 ' // MAX &HFFFFFFFF
Const VALOR64BITS As Double = 1.08086391056892E+18 ' // MAX &HFFFFFFFFFFFFFFFF (En Hex solo llega a 32bits)
Debug.Print Rot8Bits(VALOR8BITS)
Debug.Print Rot16Bits(VALOR16BITS)
Debug.Print Rot32Bits(VALOR32BITS)
Debug.Print Rot64Bits(VALOR64BITS)
Debug.Print hlDWORD(VALOR32BITS)
End Sub
P.D.: No me citen el post que se hace largo el hilo
Dulces Lunas!¡.
:laugh: me impresionas BlackZeroX >:D
yo mejore esta funcion :P espero no equivocarme :P
' ==> Bits
Function Hbyte(Word As Integer) As Byte
Hbyte = (Word / &H100)
End Function
e visto que mi funcion se puede mejorar pasando arrays como parametros, tambien hice una version con la RtlMoveMemory
y funciono pero es menos rapida que trabajar directamente con los bits :P
En efecto pero le falta una mascara... al dividir un numero negativo los bits de mayor peso se setean en 1...
Function hByte(iWord As Integer) As Byte
hByte = (iWord / &H100) And &HFF
End Function
P.D.: Optimice todas las funciones Aqui (http://foro.elhacker.net/programacion_visual_basic/sources_code_rotbits_byte_to_byte-t342467.0.html;msg1676295#msg1676295), y agregue una funcion para rotar 64bits.
Dulces Lunas!¡.
Una pequeña pregunta... ¿Para que sirve? :rolleyes:
Su implementacion es variada, por ejemplo Rot16Bits() seria un reemplazdo de htons@Ws2_32 (API) (http://msdn.microsoft.com/en-us/library/ms738557(VS.85).aspx).
leete esto...
https://secure.wikimedia.org/wikipedia/es/wiki/Bit
https://secure.wikimedia.org/wikipedia/es/wiki/Nibble
https://secure.wikimedia.org/wikipedia/es/wiki/Sistema_binario
Dulces Lunas!¡.