Mensajes

Modulo de Clase

Código (vb) [Seleccionar] Expandir


'---------------------------------------------------------------------------------------
' Module      : cCallAPIByName
' DateTime    : 31/08/2008 19:40
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' WebPage     : http://www.advancevb.com.ar
' Purpose     : Call APIs by name
' Usage       : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
'
' Credits     : Arne Elster, original callpointer function.
'
' History     : 31/08/2008 First Cut....................................................
'---------------------------------------------------------------------------------------
Option Explicit

Private Declare Sub CpyMem Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal dlen As Long)
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long

Public Function DoNotCall() As Long
'
End Function

Public Function CallAPIByName(ByVal sLib As String, ByVal sMod As String, ParamArray Params()) As Long
    Dim lPtr                As Long
    Dim bvASM(&HEC00& - 1)  As Byte
    Dim i                   As Long
    Dim lMod                As Long
   
    lMod = GetProcAddress(LoadLibraryA(sLib), sMod)
    If lMod = 0 Then Exit Function
   
    lPtr = VarPtr(bvASM(0))
    CpyMem ByVal lPtr, &H59595958, &H4:            lPtr = lPtr + 4
    CpyMem ByVal lPtr, &H5059, &H2:                lPtr = lPtr + 2
    For i = UBound(Params) To 0 Step -1
        CpyMem ByVal lPtr, &H68, &H1:              lPtr = lPtr + 1
        CpyMem ByVal lPtr, CLng(Params(i)), &H4:   lPtr = lPtr + 4
    Next
    CpyMem ByVal lPtr, &HE8, &H1:                  lPtr = lPtr + 1
    CpyMem ByVal lPtr, lMod - lPtr - 4, &H4:       lPtr = lPtr + 4
    CpyMem ByVal lPtr, &HC3, &H1
   
    Dim lVTE                As Long
    Dim lRet                As Long
   
    CpyMem lVTE, ByVal ObjPtr(Me), &H4
    lVTE = lVTE + &H1C
    CpyMem lRet, ByVal lVTE, &H4
    CpyMem ByVal lVTE, VarPtr(bvASM(0)), &H4
    CallAPIByName = DoNotCall
    CpyMem ByVal lVTE, lRet, &H4
End Function


Como Llamarlo

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Sub Form_Load()
    Dim c As New cCallAPIByName

    c.CallAPIByName "user32", "MessageBoxW", 0, VarPtr(ByVal "Test"), VarPtr(ByVal "Test"), 0
   
End Sub


http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=58641&lngWId=1

Si estas usando los colores por defecto del sistema, va a cambiar, intenta con un color estatico a ver que pasa.

Lo que podes hacer es desde el sub main llamar a una clase en la cual declaras el socket y haces todo como si se tratara de un form, y en el sub main pones un loop con un doevents y un sleep para mantenerlo abierto.

La verdad no se mucho de foros y su funcionamiento, pero hasta donde tenia entendido los foros vienen preparados para darle acceso as los bots.

Podrias pasarlo a VB, son puras apis, ahora si queres algo hecho... nu se.

Mirate esto:

http://www.opensc.ws/delphi-help/2148-need-help-createprocessex-aphex.html

Exelente, es simple, efectivo y el codigo esta muy prolijo y limpio =) me gusta mucho!

Asi es, se desbloquea, lo que puede hacer es usar un hook global y consumir los keystrokes, posiblemente eso funcione, no estoy seguro. O abrir un nuevo escritorio y punto

Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long