Código
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
Ejemplo de uso:
Código
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)
El password siempre ha de acabar en chr(0)!!
Saludos