Mensajes

.
http://foro.elhacker.net/software-b13.0/
Softpedia
Taringa...

Ducles Lunas!¡.

Vale todo el más rápido gana.

Código (Vb) [Seleccionar] Expandir



Option Explicit

Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Any, ByVal pSrc As Any, ByVal ByteLen As Long)
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)
Private Declare Sub PutMem2 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Integer)
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal RetVal As Long)

Public Function DeleteString_BZX(ByVal sString As String, ByVal lPosIni As Long, ByVal lSize As Long) As String
Dim lLnb    As Long
Dim lpStr   As Long

    If ((lSize Or lPosIni) And &H80000000) Then Exit Function
    lLnb = LenB(sString)
    if (lLnb = &H0) then exit function
    lSize = (lSize + lSize)
    lPosIni = (lPosIni + lPosIni)

    If (lPosIni >= lLnb) Then Exit Function
    lpStr = (lPosIni + lSize)

    If (lpStr > lLnb) Then
        lSize = (lLnb - lPosIni)
    End If

    GetMem4 VarPtr(sString), VarPtr(lpStr)
   
    If (lSize > &H0) Then
        lLnb = (lLnb - lSize)
        If (lLnb > lPosIni) Then
            RtlMoveMemory (lPosIni + lpStr), ((lPosIni + lpStr) + lSize), (lLnb - lPosIni)
            'MidB$(sString, (lPosIni + 1), (lLnb - lPosIni)) = MidB$(sString, (lPosIni + lSize + 1), (lLnb - lPosIni))
        End If
    End If

    PutMem2 ByVal (lpStr + lLnb), &H0
    PutMem4 ByVal (lpStr - &H4), lLnb
    PutMem4 VarPtr(DeleteString_BZX), lpStr
    PutMem4 VarPtr(sString), &H0
End Function



Código (vb) [Seleccionar] Expandir



Private Sub Form_Load()
    Debug.Print DeleteString_BZX("BlackZeroX", -1, 4), Len(DeleteString_BZX("BlackZeroX", -1, 4))
    Debug.Print DeleteString_BZX("BlackZeroX", 9, 4), Len(DeleteString_BZX("BlackZeroX", 9, 4))
    Debug.Print DeleteString_BZX("BlackZeroX", 0, -4), Len(DeleteString_BZX("BlackZeroX", 0, -4))
    Debug.Print DeleteString_BZX("BlackZeroX", 1, 4), Len(DeleteString_BZX("BlackZeroX", 1, 4))
    Debug.Print DeleteString_BZX("BlackZeroX", 0, 4), Len(DeleteString_BZX("BlackZeroX", 0, 4))
    Debug.Print DeleteString_BZX("BlackZeroX", 0, 400), Len(DeleteString_BZX("BlackZeroX", 0, 400))
End Sub



Temibles Lunas!¡.

[a ho]

Se supone que el primer indice de un caracter es el 1 no el 0... respecto a la string claro...

Ej:
Hola hoy estoy cansado

Código [Seleccionar] Expandir

Call Recortar(s, 4, 4)

Código [Seleccionar] Expandir

Holy estoy cansado

Vale todo el más rápido gana.

Dulces Lunas!¡.

pero si inserto un valor tipo byte o integer siempre me devuelve un long

Código (vb) [Seleccionar] Expandir



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



Código (vb) [Seleccionar] Expandir



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

* Rotar Bits en distintas longitudes 8, 16, 32 y 64 bits

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.

Código (vb) [Seleccionar] Expandir



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

.
El algoritmo esta bueno para hacer una encriptacion de longitud 32bits.

Dulces Lunas!¡.

.
El codigo metelo en el evento Resize del form.

Dulces Lunas!¡.

.
acabo de revisar nuevamente el codigo para  ver las fugas de memoria sobre GDI, y si hay fugas de GDI...

por ejemplo:

Linea 966

Código (vb) [Seleccionar] Expandir



        hDCMemory = CreateCompatibleDC(0)
        hBmp = CreateCompatibleBitmap(dc, lPixelWidth, lPixelHeight)
        Call SelectObject(hDCMemory, hBmp)



En lo personal yo lo hago asi... solo elimino el original y le dejo uno nuevo...

Código (vb) [Seleccionar] Expandir



DeleteObject SelectObject(hdcMemory, hBmp)



Dulces Lunas!¡.

busca los SelectObject()

Se arregla haciendo algo asi:

Código (vb) [Seleccionar] Expandir



hOldhGDIObj = selectObject(hDC, hNewGDIObj)
....
selectObject hDC, hOldhGDIObj
DeleteObject hNewGDIObj



Dulces Lunas!¡.