Call Invoke("USER32", &HBC4DA2BE, 0, StrPtr("Soy Karcrack :D"), StrPtr("Ejemplo"), 0)

;ESI = Puntero cadena
compute_hash:
	xor	edi, edi     ;EDI = 0
	xor	eax, eax   ;EAX = 0
	cld
compute_hash_again:
	lodsb                ;AL = BYTE[ESI] , ESI = ESI + 1
	test	al, al
       jz	compute_hash_finished
	ror	edi, 0xD
	add	edi, eax
       jmp	compute_hash_again
compute_hash_finished:
;EDI = El Hash de la cadena

Código:

http://www.box.net/shared/0ld4yy6bmy

Codigo Fuente incluido

'---------------------------------------------------------------------------------------
' Module    : kInvoke
' Author    : Karcrack
' Date      : 09/04/2010
' Purpose   : Call APIs By Hash
'---------------------------------------------------------------------------------------
 
Option Explicit
 
'USER32
Private Declare Function CallWindowProcW Lib "USER32" (ByVal lpCode As Long, Optional ByVal lParam1 As Long, Optional ByVal lParam2 As Long, Optional ByVal lParam3 As Long, Optional ByVal lParam4 As Long) As Long
 
Private Const THUNK_GETAPIPTR       As String = "E82200000068A44E0EEC50E84300000083C408FF742404FFD0FF74240850E83000000083C408C3565531C0648B70308B760C8B761C8B6E088B7E208B3638471875F3803F6B7407803F4B7402EBE789E85D5EC35552515356578B6C241C85ED74438B453C8B54057801EA8B4A188B5A2001EBE330498B348B01EE31FF31C0FCAC84C07407C1CF0D01C7EBF43B7C242075E18B5A2401EB668B0C4B8B5A1C01EB8B048B01E85F5E5B595A5DC3"
Private Const THUNK_CALLCODE        As String = "<PUSHES>B8<API_PTR>FFD0C3"
Private ASM_GETAPIPTR(0 To 170)     As Byte
Private ASM_CALLCODE(0 To 255)      As Byte
 
Public Function Invoke(ByVal sDLL As String, ByVal hHash As Long, ParamArray vParams() As Variant) As Long
    Dim vItem                       As Variant
    Dim lAPI                        As Long
    Dim sThunk                      As String
 
    Call PutThunk(THUNK_GETAPIPTR, ASM_GETAPIPTR)
    lAPI = CallWindowProcW(VarPtr(ASM_GETAPIPTR(0)), StrPtr(sDLL), hHash)
 
    If lAPI Then
        For Each vItem In vParams
            sThunk = "68" & GetLng(CLng(vItem)) & sThunk
        Next vItem
 
        sThunk = Replace$(Replace$(THUNK_CALLCODE, "<PUSHES>", sThunk), "<API_PTR>", GetLng(lAPI))
        Call PutThunk(sThunk, ASM_CALLCODE)
        Invoke = CallWindowProcW(VarPtr(ASM_CALLCODE(0)))
    Else
        Invoke = -1
        Err.Raise -1, , "Bad Hash or wrong DLL"
    End If
End Function
 
Private Function GetLng(ByVal lLng As Long) As String
    Dim lTMP                        As Long
 
    lTMP = (((lLng And &HFF000000) \ &H1000000) And &HFF&) Or ((lLng And &HFF0000) \ &H100&) Or ((lLng And &HFF00&) * &H100&) Or ((lLng And &H7F&) * &H1000000) ' by Mike D Sutton
    If (lLng And &H80&) Then lTMP = lTMP Or &H80000000
 
    GetLng = String$(8 - Len(Hex$(lTMP)), "0") & Hex$(lTMP)
End Function
 
Private Sub PutThunk(ByVal sThunk As String, ByRef bvRet() As Byte)
    Dim i                           As Long
 
    For i = 0 To Len(sThunk) - 1 Step 2
        bvRet((i / 2)) = CByte("&H" & Mid$(sThunk, i + 1, 2))
    Next i
End Sub
 

Aquí tenéis el código de ejemplo con todos los códigos de ASM utilizados :

http://www.box.net/shared/qgzqkoc4nn

Option Explicit
Private Declare Function RtlGetCompressionWorkSpaceSize Lib "NTDLL" (ByVal flags As Integer, WorkSpaceSize As Long, UNKNOWN_PARAMETER As Long) As Long
Private Declare Function NtAllocateVirtualMemory Lib "ntdll.dll" (ByVal ProcHandle As Long, BaseAddress As Long, ByVal NumBits As Long, regionsize As Long, ByVal flags As Long, ByVal ProtectMode As Long) As Long
Private Declare Function RtlCompressBuffer Lib "NTDLL" (ByVal flags As Integer, ByVal BuffUnCompressed As Long, ByVal UnCompSize As Long, ByVal BuffCompressed As Long, ByVal CompBuffSize As Long, ByVal UNKNOWN_PARAMETER As Long, OutputSize As Long, ByVal WorkSpace As Long) As Long
Private Declare Function RtlDecompressBuffer Lib "NTDLL" (ByVal flags As Integer, ByVal BuffUnCompressed As Long, ByVal UnCompSize As Long, ByVal BuffCompressed As Long, ByVal CompBuffSize As Long, OutputSize As Long) As Long
Private Declare Function NtFreeVirtualMemory Lib "ntdll.dll" (ByVal ProcHandle As Long, BaseAddress As Long, regionsize As Long, ByVal flags As Long) As Long
 
Public Function Compress(Data() As Byte, Out() As Byte) As Long
    Dim WorkSpaceSize As Long
    Dim WorkSpace As Long
    ReDim Out(UBound(Data) * 1.13 + 4)
 
    RtlGetCompressionWorkSpaceSize 2, WorkSpaceSize, 0
    NtAllocateVirtualMemory -1, WorkSpace, 0, WorkSpaceSize, 4096, 64
    RtlCompressBuffer 2, VarPtr(Data(0)), UBound(Data) + 1, VarPtr(Out(0)), (UBound(Data) * 1.13 + 4), 0, Compress, WorkSpace
    NtFreeVirtualMemory -1, WorkSpace, 0, 16384
    ReDim Preserve Out(Compress)
 
End Function
 
Public Function DeCompress(Data() As Byte, dest() As Byte) As Long
    If UBound(Data) Then
        Dim lBufferSize As Long
        ReDim dest(UBound(Data) * 12.5)
        RtlDecompressBuffer 2, VarPtr(dest(0)), (UBound(Data) * 12.5), VarPtr(Data(0)), UBound(Data), lBufferSize
        If lBufferSize Then
            ReDim Preserve dest(lBufferSize - 1)
            DeCompress = lBufferSize - 1
        End If
    End If
End Function