Foro de elhacker.net

Option Explicit
'USER32
Private Declare Function CallWindowProcA Lib "USER32" (ByVal lPtr As Long, Optional ByVal Param1 As Long = 0, Optional ByVal Param2 As Long = 0, Optional ByVal Param3 As Long = 0, Optional ByVal Param4 As Long = 0) As Long
 
Private Const sThunk        As String = "8B7C24048B4C24088B54240CE8000000005D83ED118A1A885D1EC0<OPCODE>39FFFF42803A007404E2EEEB068B54240CEBF6C3"
 
'---------------------------------------------------------------------------------------
' Procedure : CryptIt
' Author    : Karcrack
' Date      : 19/09/2009
' Purpose   : Encrypt Using ROL/ROR operands...
' NOTES     : Now FULL ASM, to make it QUICKEST possible!
'             Now PASSWORD compatible
'             Fixed FULL rotation...
'---------------------------------------------------------------------------------------
'
Public Sub CryptIt(ByRef bvData() As Byte, ByRef bvPass() As Byte, Optional ByVal bDecrypt As Boolean = False, Optional ByVal bPreventFULL As Boolean = True)
    Dim i                   As Long
    Dim sASM                As String
    Dim bvASM(&HFF)         As Byte
 
    If bPreventFULL = True Then
        'Prevent FULL rotation...
        For i = LBound(bvPass) To UBound(bvPass)
            If Not (bvPass(i) Mod 8) Then bvPass(i) = bvPass(i) + 1
        Next i
    End If
 
    sASM = Replace$(sThunk, "<OPCODE>", IIf((bDecrypt = False), "4C", "44"))
 
    Call OPCODES(sASM, bvASM)
 
    Call CallWindowProcA(VarPtr(bvASM(0)), VarPtr(bvData(0)), UBound(bvData) + 1, VarPtr(bvPass(0)))
End Sub
 
Private Sub OPCODES(ByVal sThunk As String, ByRef bvTmp() As Byte)
    Dim i               As Long
 
    For i = 0 To Len(sThunk) - 1 Step 2
        bvTmp((i / 2)) = CByte("&H" & Mid$(sThunk, i + 1, 2))
    Next i
End Sub

    Dim bvPass()        As Byte
    Dim bvData()        As Byte
 
    bvPass = StrConv("YEEEAH!" & Chr$(0), vbFromUnicode)
    bvData = StrConv("KARCRACK FTW! =D", vbFromUnicode)
 
    Call CryptIt(bvData, bvPass)
 
    MsgBox StrConv(bvData, vbUnicode)
 
    Call CryptIt(bvData, bvPass, True)
    MsgBox StrConv(bvData, vbUnicode)