Temas

Hola, estoy tratando de obtener el puntero de una funcion que esta dentro de un form o class.
La cual no puedo mover a un modulo y usar AddressOf porque es usada por varios hilos, necesito cada funcion independiente. Pero para hacer ello tiene que estar dentro de un class o form, y no puedo obtener su puntero  

Intente esto:

http://www.programmersheaven.com/mb/VBasic/237946/237949/re-hot-to-find-the-address-of-a-function/

Código (vb) [Seleccionar] Expandir

Call CallWindowProc(ByVal GetDWORD(ObjPtr(Me) + ((FunctionIndex - 1) * 4) + 12), 0, 0, 0, 0)

Agradeceria de su ayuda  

Hola, estoy tratando de hacer un codigo para contener controles dentro de subitems de un listview. Y esta hecho, pero el problema es que, bueno vean la imagen mejor:



Habria que enviar un mensaje que "actualize", al igual que sucede cuando se hace CLICK en algún ítem. Estuve mirando los mensajes que recibe pero no logre nada.
Si alguien me puede ayudar le agradecería  

Saludos

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

Lo hice hace ya un tiempo para hacer poner imágenes en los commandbutton y que queden en la misma linea, pero se puede aplicar a cualquier control.

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Const WM_PAINT As Long = &HF
Private Const GWL_WNDPROC = -4

Private Type DRAW_DATA
    DrawPic As PictureBox
    DrawTop As Long
    DrawLeft As Long
    lpPrevWndProc As Long
    ControlHwnd As Long
    ControlDC As Long
End Type

Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetDC Lib "USER32" (ByVal Hwnd As Long) As Long
Private Declare Function GdiTransparentBlt Lib "GDI32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean

Private DrawArray() As DRAW_DATA

Public Sub DrawGraph(Hwnd As Long, Pic As PictureBox, Top As Long, Left As Long)
    Dim i As Long
   
    If Not Not DrawArray Then: i = UBound(DrawArray) + 1
    ReDim Preserve DrawArray(i)
   
    With DrawArray(i)
        Set .DrawPic = Pic
        .DrawPic.BorderStyle = 0
        .DrawPic.ScaleMode = vbPixels
        .DrawPic.BackColor = &HFF00FF
        .DrawPic.AutoSize = True
        .DrawPic.Refresh
   
        .ControlHwnd = Hwnd
        .lpPrevWndProc = SetWindowLong(Hwnd, GWL_WNDPROC, AddressOf ControlProc)
        .ControlDC = GetDC(Hwnd)
        .DrawTop = Top: .DrawLeft = Left
    End With
End Sub

Public Sub UnDrawGraph(ByVal Hwnd As Long)
    Dim i As Long
   
    For i = 0 To UBound(DrawArray)
        If DrawArray(i).ControlHwnd = Hwnd Then
            Call SetWindowLong(Hwnd, GWL_WNDPROC, DrawArray(i).lpPrevWndProc)
        End If
    Next i
End Sub

Private Function ControlProc(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim i As Long

    For i = 0 To UBound(DrawArray)
        With DrawArray(i)
            If .ControlHwnd = Hwnd Then
                ControlProc = CallWindowProc(.lpPrevWndProc, Hwnd, Msg, wParam, lParam)
                If (Msg = WM_PAINT) Then
                    Call GdiTransparentBlt(.ControlDC, .DrawLeft, .DrawTop, .DrawPic.ScaleWidth, .DrawPic.ScaleHeight, .DrawPic.hdc, 0, 0, .DrawPic.ScaleWidth, .DrawPic.ScaleHeight, &HFF00FF)
                End If
            End If
        End With
    Next i
End Function

[mProgressBarInListView:]

mProgressBarInListView:

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Type RECT
    Left    As Long
    Top     As Long
    Right   As Long
    Bottom  As Long
End Type

Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETSUBITEMRECT  As Long = (LVM_FIRST + 56)
Private Const LVIR_LABEL  As Long = 2

Private Const WM_NOTIFY  As Long = &H4E
Private Const WM_HSCROLL As Long = &H114
Private Const WM_VSCROLL As Long = &H115
Private Const WM_KEYDOWN As Long = &H100

Private Const HDN_FIRST      As Long = (0 - 300)
Private Const HDN_ENDTRACK   As Long = (HDN_FIRST - 1)

Private Declare Function SendMessageA Lib "USER32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetParent Lib "USER32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function SetWindowLongA Lib "USER32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProcA Lib "USER32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private lpPrevWndProc As Long

Private Function ListView_GetSubItemRect(ByVal hWndLV As Long, ByVal iItem As Long, ByVal iSubItem As Long, ByVal code As Long, lpRect As RECT) As Boolean
    lpRect.Top = iSubItem
    lpRect.Left = code
    ListView_GetSubItemRect = SendMessageA(hWndLV, LVM_GETSUBITEMRECT, ByVal iItem, lpRect)
End Function

Public Sub PutProgressBarInListView(ListView As ListView, InColumn As Long)
    Dim i As Long
   
    For i = 0 To ListView.ListItems.Count - 1
        If i > Form1.ProgressBar1.Count - 1 Then: Call Load(Form1.ProgressBar1(i))
        Call SetParent(Form1.ProgressBar1(i).hWnd, ListView.hWnd)
    Next

    Call AdjustProgressBar(ListView, InColumn)
    lpPrevWndProc = SetWindowLongA(ListView.hWnd, -4, AddressOf ListViewProc)
End Sub

Public Sub AdjustProgressBar(ListView As ListView, InColumn As Long)
    Dim Pos    As RECT
    Dim i      As Long
   
    For i = 0 To Form1.ProgressBar1.Count - 1
        Call ListView_GetSubItemRect(ListView.hWnd, i, InColumn, LVIR_LABEL, Pos)
        With Form1.ProgressBar1(i)
            .Left = (Pos.Left) * Screen.TwipsPerPixelX
            .Width = (Pos.Right - Pos.Left) * Screen.TwipsPerPixelX
            .Height = ((Pos.Bottom - Pos.Top) * Screen.TwipsPerPixelY)
            .Top = Pos.Top * Screen.TwipsPerPixelY + ((Pos.Bottom - Pos.Top) * Screen.TwipsPerPixelY - .Height) / 2
           
            Call IIf(Pos.Top <= 3, .Visible = False, .Visible = True)
        End With
    Next
End Sub

Private Function ListViewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim Param       As Long
    Dim bAdjust     As Boolean

    Select Case Msg
        Case WM_HSCROLL, WM_VSCROLL: bAdjust = True
        Case WM_KEYDOWN
            Select Case wParam
                Case 33 To 40: bAdjust = True
            End Select
        Case WM_NOTIFY
            Call CopyMemory(Param, ByVal lParam + 8, 4)
            If Param = HDN_ENDTRACK Then: bAdjust = True
    End Select
   
    If bAdjust = True Then: Call AdjustProgressBar(Form1.ListView1, 1)
    ListViewProc = CallWindowProcA(lpPrevWndProc, hWnd, Msg, wParam, lParam)
End Function

Simplemente necesitaba hacer esto y lo comparto, espero que le sirva a alguien

Hola gente, estoy buscando obtener la direccion de Form_Initialize. A mi se me ocurre por medio de un hook, pero no me gusta es muy groncho 

Gracias

Hola gente, hago este thread para ver si alguien puede hacer un codigo decente para crear threads y que se pueda acceder a todos los recursos normales de VB6 sin que crashe.

-Este es el codigo que utilizo algún tiempo, pero tiene limitaciones, al crear un thread con un nuevo FORM VISIBLE crashea (.Show,.Visible=True, de cualquier manera, inluyendo el api.).
-Tambien la simple llamada a MsgBox crashea, pero se puede solucionar llamando al api.

Yo creo que esos dos problemas estan relacionados, si alguien tiene el conocimiento y tiempo, le agradecería que intentara crear un codigo para crear varios threads sin problemas. Seria el UNICO en toda la internet, porque no lo hay, almenos en VB6

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Declare Function CreateThread Lib "KERNEL32" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByRef lpParameter As Any, ByVal dwCreationFlags As Long, ByRef lpThreadId As Long) As Long
Private Declare Sub ExitThread Lib "KERNEL32" (ByVal dwExitCode As Long)
Private Declare Function TlsGetValue Lib "KERNEL32" (ByVal dwTlsIndex As Long) As Long
Private Declare Function TlsSetValue Lib "KERNEL32" (ByVal dwTlsIndex As Long, ByRef lpTlsValue As Any) As Long

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Declare Function GetProcAddress Lib "KERNEL32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibrary Lib "KERNEL32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "KERNEL32" (ByVal hLibModule As Long) As Long

Private MemAddress As Long
Private TlsAddress As Long
Private TlsIndex As Long

Public Function CreateNewThread(ByVal hThreadProc As Long, Optional ByVal Param As Long = 0) As Long
   If (MemAddress + TlsIndex) = 0 Then
       Call InitTlsIndex: Call CopyMemory(TlsIndex, ByVal TlsAddress, Len(TlsIndex)) 'Retrieve TlsIndx from TlsAddress
       MemAddress = TlsGetValue(TlsIndex)
   End If

   CreateNewThread = CreateThread(0, 0, hThreadProc, ByVal Param, 0, 0)
End Function

Public Sub InitThread()
   Call TlsSetValue(TlsIndex, ByVal MemAddress) 'VB will use this address to store DLL error information and etcs.
End Sub

Private Sub InitTlsIndex()
   'Tls Index's address of our thread.
   Dim bB(40) As Byte, St As String
   Dim hProc As Long, hLib As Long, i As Integer, j As Integer

   hLib = LoadLibrary("MSVBVM60")
   hProc = GetProcAddress(hLib, "__vbaSetSystemError")
   Call CopyMemory(bB(0), ByVal (hProc), 40)
   
   While bB(i) <> &HC3 'RETN
       If bB(i) = &HFF And bB(i + 1) = &H35 Then
           For j = i + 2 To i + 5
               St = Hex(bB(j)) & St
           Next
           TlsAddress = Val("&H" & St): Exit Sub
       End If
       i = i + 1
   Wend
   
   Call FreeLibrary(hProc)
End Sub

Public Sub TerminateThread(ByVal dwExitCode As Long)
   Call ExitThread(dwExitCode)
End Sub

Abrazo

[mStruct:]

mStruct:

Código [Seleccionar] Expandir

Option Explicit

Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As Long) As Long

Private Type SA1D_STRUCT
   Struct(23) As Byte
   bData() As Byte
   Length As Long
End Type

Private SA1D() As SA1D_STRUCT

Public Sub ByteToStruct(ByVal StructPtr As Long, ByRef bArray() As Byte)
   Dim Count As Long
   Dim i As Long
   
   Do
       ReDim Preserve SA1D(i): Call CopyMemory(SA1D(i).Length, bArray(Count), 4)
       ReDim SA1D(i).bData(SA1D(i).Length)
   
       Call CopyMemory(SA1D(i).bData(0), bArray(Count + 4), SA1D(i).Length)
       Count = Count + 4 + SA1D(i).Length: i = i + 1
   Loop Until (UBound(bArray) + 1 = Count)
   
   For i = 0 To UBound(SA1D)
       Call CopyMemory(SA1D(i).Struct(12), VarPtr(SA1D(i).bData(0)), 4) 'DataPtr
       Call CopyMemory(SA1D(i).Struct(16), SA1D(i).Length, 4) 'LBound
       Call CopyMemory(SA1D(i).Struct(0), 1, 2) 'Dims
       Call CopyMemory(SA1D(i).Struct(4), 1, 4) 'ElementSize
             
       Call CopyMemory(ByVal StructPtr + (i * 4), VarPtr(SA1D(i).Struct(0)), 4) 'SA1D Struct
   Next i
End Sub

Public Sub StructToByte(ByVal StructPtr As Long, ByRef bReturn() As Byte, ParamArray VarType() As Variant)
   Dim SafeArrayPtr As Long
   Dim ArrayLength As Long
   Dim ArrayPtr As Long
   Dim i As Long
       
   ReDim bReturn(0)
   For i = 0 To UBound(VarType)
       Select Case VarType(i)
           Case vbByte:
               'SafeArray1D Struct
               Call CopyMemory(SafeArrayPtr, ByVal StructPtr + (i * 4), 4)
               Call CopyMemory(ArrayPtr, ByVal SafeArrayPtr + 12, 4) 'DataPtr
               Call CopyMemory(ArrayLength, ByVal SafeArrayPtr + 16, 4) 'LBound
               'Data Size + Data
               ReDim Preserve bReturn(UBound(bReturn) + 4 + ArrayLength)
               Call CopyMemory(ByVal VarPtr(bReturn(UBound(bReturn) - 4 - ArrayLength)), ArrayLength, 4)
               Call CopyMemory(ByVal VarPtr(bReturn(UBound(bReturn) - ArrayLength)), ByVal ArrayPtr, ArrayLength)
       End Select
   Next i
   ReDim Preserve bReturn(UBound(bReturn) - 1)
End Sub

Ejemplo:

Código [Seleccionar] Expandir

Private Type dd
   ss() As Byte
   jj() As Byte
   tt() As Byte
End Type

Sub Main()
   Dim told As dd
   Dim tnew As dd
   Dim bB() As Byte
   
   told.ss = StrConv("hola", vbFromUnicode)
   told.jj = StrConv("jeje", vbFromUnicode)
   told.tt = StrConv("wakawaka", vbFromUnicode)
   
   Call StructToByte(VarPtr(told), bB, vbByte, vbByte, vbByte)
   Call ByteToStruct(VarPtr(tnew), bB)
   
   MsgBox StrConv(tnew.jj, vbUnicode)
   MsgBox StrConv(tnew.ss, vbUnicode)
   MsgBox StrConv(tnew.tt, vbUnicode)
End Sub

PD: funciona solo con arrays de bytes, ya que es lo que yo necesito , pero se puede agregar "soporte" con otros tipos de variables facilmente  

Suerte

Hola gente, quería pedirle a los coders si se animan a reparar estas simples funciones. Ya que funcionan en local, pero al intentar cargar un variant guardado a una estructura en otro proyecto, da error.

Código [Seleccionar] Expandir

Private Type ControlVB
    sType As String
    sName As Strin
End Type
Private Declare Function CopyBytes Lib "MSVBVM60" Alias "__vbaCopyBytes" (ByVal Size As Long, Dest As Any, Source As Any) As Long

Private Sub main()
    Dim dd As ControlVB
    Dim bb As ControlVB
    Dim aa As Variant
   
    dd.sName = "aaaaa"
    dd.sType = "TextBox"
   
    aa = StructToVariant(VarPtr(dd), LenB(dd))
    Call VariantToStruct(aa, VarPtr(bb))
   
    MsgBox bb.sName
End Sub

Private Function StructToVariant(ByVal StructPtr As Long, ByVal Size As Long) As Variant
    Dim Bin() As Byte
   
    ReDim Bin(Size)

    Call CopyBytes(Size, ByVal VarPtr(Bin(0)), ByVal StructPtr)
    StructToVariant = Bin
End Function

Private Function VariantToStruct(ByRef vVariant As Variant, ByVal StructPtr As Long)
    Call CopyBytes(LenB(vVariant) - 1, ByVal StructPtr, ByVal StrPtr(vVariant))
End Function


Gracias.

[Codigo C:]

Hola c0ders, hace mucho que quiero intento portar este source, y ahora me volvio la urgencia de este code, le agradeceria mucho que solucionaran los errorsillos que tiene (estoy confundido con los dwDataSize y dwCallSize, me confundo con el tipo de variables al calcular los datos e intento pero no logro )...
Codigo C: http://www.rohitab.com/discuss/topic/31453-cc-createremotethreadex%3B/

VB6:

Código [Seleccionar] Expandir

Private Declare Function GetModuleHandle Lib "KERNEL32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "KERNEL32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function HeapAlloc Lib "KERNEL32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "KERNEL32" () As Long
Private Declare Function HeapFree Lib "KERNEL32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByRef lpMem As Any) As Long
Private Declare Function VirtualAllocEx Lib "KERNEL32" (ByVal hProcess As Long, ByRef lpAddress As Any, ByRef dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function WriteProcessMemory Lib "KERNEL32" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Sub CopyMemory Lib "MSVBVM60" Alias "__vbaCopyBytes" (ByVal Size As Long, Dest As Any, Source As Any)

Private Declare Function CreateRemoteThread Lib "KERNEL32" (ByVal hProcess As Long, lpThreadAttributes As Any, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long

Private Const MEM_COMMIT = &H1000
Private Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Const HEAP_ZERO_MEMORY As Long = &H8

Private Function CreateRemoteThreadEx(hProcess As Long, _
                                      lpThreadAttributes As Variant, _
                                      dwStackSize As Long, _
                                      lpStartAddress As Long, _
                                      dwCreationFlags As Long, _
                                      lpThreadId As Long, _
                                      ParamArray vParameters() As Variant)
    Dim ASM_CALLGATE(39) As Byte
    Dim lpLocal As Long
    Dim lpRemote As Long
    Dim lpData As Long
    Dim lpCode As Long
    Dim dwAmount  As Long
    Dim dwDataSize As Long
    Dim dwCallSize  As Long
    Dim dwWritten  As Long
   
    Dim i As Long
   
   '{
        ' CALL $+0x1D
        ' PUSH EAX
        ' PUSH 90C35858 (code for POP EAX\nPOP EAX\nRETN)"
        ' PUSH MEM_RELEASE
        ' PUSH 1
        ' PUSH 00000000 (-> PUSH lpRemote)
        ' PUSH ESP
        ' ADD DWORD [ESP], 0x0C
        ' PUSH 00000000 (-> PUSH VirtualFree)
        ' RETN
        ' PUSH 00000000 (-> PUSH lpStartAddress)
        ' RETN
    '}
   
    For i = 0 To 39
        ASM_CALLGATE(i) = CByte(Choose(i + 1, &HE8, &H1D, &H0, &H0, &H0, &H50, &H68, &H58, &H58, &HC3, &H90, &H68, &H0, &H40, _
                                              &H0, &H0, &H6A, &H1, &H68, &H0, &H0, &H0, &H0, &H54, &H83, &H4, &H24, &HC, _
                                              &H68, &H0, &H0, &H0, &H0, &HC3, &H68, &H0, &H0, &H0, &H0, &HC3))
    Next i
   
    If UBound(vParameters) <> -1 Then
        dwAmount = UBound(vParameters)
        For i = 0 To dwAmount
            dwDataSize = dwDataSize + LenB(vParameters(i))
        Next i
        dwCallSize = UBound(ASM_CALLGATE) + dwAmount * (4 + 1) + dwDataSize
       
        'Allocate memory for callgate constructing (local process)
        lpLocal = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, dwCallSize)
        If lpLocal = 0 Then: GoTo Error
       
        'Allocate memory from remote process
        lpRemote = VirtualAllocEx(hProcess, 0&, dwCallSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
        If lpRemote = 0 Then: GoTo Error
       
        Call CopyMemory(4, ByVal VarPtr(ASM_CALLGATE(19)), lpRemote)
        Call CopyMemory(4, ByVal VarPtr(ASM_CALLGATE(35)), lpStartAddress)
        Call CopyMemory(4, ByVal VarPtr(ASM_CALLGATE(29)), GetProcAddress(GetModuleHandle("KERNEL32"), "VirtualFree"))
    End If
   
    Call WriteProcessMemory(hProcess, lpRemote, lpLocal, dwCallSize, dwWritten)
    Call HeapFree(GetProcessHeap(), 0, lpLocal)
    If dwWritten = 0 Then: GoTo Error

    CreateRemoteThreadEx = CreateRemoteThread(hProcess, lpThreadAttributes, dwStackSize, (lpRemote + dwDataSize), 0, dwCreationFlags, lpThreadId)
    Exit Function
Error:
   
End Function

Gracias

[Socket:]

Socket:

Código [Seleccionar] Expandir

Option Explicit

Private Declare Function socket Lib "WSOCK32" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Private Declare Function closesocket Lib "WSOCK32" (ByVal s As Long) As Long
Private Declare Function connect Lib "WSOCK32" (ByVal s As Long, addr As SOCKADDR, ByVal NameLen As Long) As Long
Private Declare Function send Lib "WSOCK32" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Private Declare Function recv Lib "WSOCK32" (ByVal s As Long, Buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function inet_addr Lib "WSOCK32" (ByVal cp As String) As Long
Private Declare Function WSAStartup Lib "WSOCK32" (ByVal wVR As Long, lpWSAD As Long) As Long
Private Declare Function WSACleanup Lib "WSOCK32" () As Long
Private Declare Function WSAAsyncSelect Lib "WSOCK32" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long

Private Declare Function CreateWindowExA Lib "USER32" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function RegisterClassExA Lib "USER32" (pcWndClassEx As WNDCLASSEX) As Integer
Private Declare Function DefWindowProcA Lib "USER32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Type WNDCLASSEX
    cbSize As Long
    style As Long
    lpfnWndProc As Long
    cbClsExtra As Long
    cbWndExtra As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As String
    lpszClassName As String
    hIconSm As Long
End Type

Private Type SOCKADDR
    sin_family                      As Integer
    sin_port                        As Integer
    sin_addr                        As Long
    sin_zero                        As String * 8
End Type

Private Const AF_INET = 2
Private Const PF_INET = 2
Private Const FD_READ = &H1&
Private Const FD_WRITE = &H2&
Private Const FD_CONNECT = &H10&
Private Const FD_CLOSE = &H20&
Private Const SOCK_STREAM = 1
Private Const IPPROTO_TCP = 6
Private Const WINSOCK_MESSAGE = 1025

Private wHwnd As Long

Public Function htons(ByVal lPort As Long) As Integer
    htons = ((((lPort And &HFF000000) \ &H1000000) And &HFF&) Or ((lPort And &HFF0000) \ &H100&) Or ((lPort And &HFF00&) * &H100&) Or ((lPort And &H7F&) * &H1000000) Or (IIf((lPort And &H80&), &H80000000, &H0)) And &HFFFF0000) \ &H10000
End Function

'--------
Public Function ProcessMessage(ByVal hWnd As Long, ByVal lMessage As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If lMessage = WINSOCK_MESSAGE Then
        Dim bBuffer(1 To 1024) As Byte
   
        Select Case lParam
            Case FD_CONNECT: Call WsSendData(wParam, StrConv("AAAAAAAAAA", vbFromUnicode))
            Case FD_WRITE:
            Case FD_READ:
                    Call recv(wParam, bBuffer(1), 1024, 0)
                    MsgBox StrConv(bBuffer, vbUnicode)
            Case FD_CLOSE: 'Jmp connect Routine
        End Select
        Exit Function
    End If
    ProcessMessage = DefWindowProcA(hWnd, lMessage, wParam, lParam)
End Function
'--------

Public Function WsInitialize(ByVal MyWndProc As Long, ByVal szSocketName As String) As Boolean
    Dim WNDC As WNDCLASSEX
   
    If wHwnd = 0 Then
        WNDC.cbSize = LenB(WNDC)
        WNDC.lpfnWndProc = MyWndProc
        WNDC.hInstance = App.hInstance
        WNDC.lpszClassName = szSocketName
   
        Call RegisterClassExA(WNDC) '0: Exit Function
        wHwnd = CreateWindowExA(0&, szSocketName, "", 0&, 0&, 0&, 0&, 0&, 0&, 0&, App.hInstance, 0&) '0: Call UnregisterClass(szSocketName, App.hInstance)
    End If
   
    Call WSAStartup(&H101, 0&)
    Initialize = True
End Function
Public Sub WsTerminate()
    Call WSACleanup
End Sub

Public Function WsConnect(lRemoteHost As String, lPort As Long) As Long
    Dim SockData As SOCKADDR
    Dim hSocket As Long
    Dim lWsMsg As Long
   
    SockData.sin_family = AF_INET
    SockData.sin_port = htons(lPort) 'If sockdata.sin_port = INVALID_SOCKET Then Exit Function
    SockData.sin_addr = inet_addr(lRemoteHost) 'If sockdata.sin_addr = INADDR_NONE Then Exit Function
    hSocket = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP) 'If hSocket < 0 Then Exit Function

    Call connect(hSocket, SockData, 16)  ' If hSocket Then WsClose   Exit Function
   
    If WSAAsyncSelect(hSocket, wHwnd, ByVal WINSOCK_MESSAGE, ByVal FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE) Then
        lWsMsg = FD_CLOSE
    Else
        lWsMsg = FD_CONNECT
    End If
   
    Call ProcessMessage(0, WINSOCK_MESSAGE, hSocket, FD_CONNECT): WsConnect = hSocket
End Function
Public Function WsSendData(ByVal SocketIndex As Long, bMessage() As Byte) As Long
    If UBound(bMessage) > -1 Then
        WsSendData = send(SocketIndex, bMessage(0), (UBound(bMessage) - LBound(bMessage) + 1), 0)
    End If
End Function

Call:

Código [Seleccionar] Expandir

    Private Sub Main()
    If WsInitialize(AddressOf ProcessMessage, "Server") Then
        If WsConnect("127.0.0.1", 7777) Then
            Do
                DoEvents
            Loop
        End If
    End If
End Sub

No tiene mucha ciencia, es algo tiny de lo que se usa normalmente OCX, SocketPlus, SocketMaster, etc... Sirve para enviar/recibir data solamente, perfecto para servidores de rats y demas apps... La funcion ProcessMessage es la cual procesa los mensajes, y deberan modificarla segun su APP. 

Estoy seguro que se puede limpiar mas aún, eliminando la ***** de crear una Clase y una Ventana, pero no se me ocurre su remplaz mas prolijo   

La funcion htons es de Karcrack.
Ah Karcrack, estoy seguro que podrias hacer un remplazo para inet_addr@WSOCK32.DLL, yo intente, pero no entendi la logica de lo que hace esa hermosa API 

Espero que les sea util el codigo, Saludos, y Felicidades por la Copa a la gente de España desde Uruguay

[http://www.box.net/shared/o2cod7gqjf]

Buenas! Hice esto hace mucho y lo deje por ahi, como no sirve para nada guardado en mi HD, lo publico, quizas le dé mejor utilidad alguno de ustedes =).




Como podran ver es a base de plugins, no hice ningun funcional, pero está el plugin de ejemplo, asi ven la forma en que hay q entregar los datos para que el cliente ordene todo correctamente =)

El codigo es bastante simple de entender, espero que les sirva de algo y bueno nada mas que decir, Salu2!

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

Hola gente del mundo
Probablemente muchos no me conozcan ya que soy el indito uruguayo
Se que no participo en el foro, y no deberia estar pidiendo ayuda, pero estoy trabajando en algo y el señor Karcrack quien me daba una mano cuando tenia problemillas siempre aparecia con la solucion pero anda muy ocupado   , asi que vengo a pedirles ayuda con este pequeño code que hice a partir de un sc de inyeccion de una libreria en un proceso remoto en C. El cual intenta llamar un api remota, lo cual funciona, pero el problema esta al pasarle los parametros, ojeando los CallApiByName que andan por la net, trate de hacerlo pero FAIL FAIL juaz

Código [Seleccionar] Expandir

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long

Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As Any, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const MEM_COMMIT = &H1000
Private Const MEM_RELEASE = &H8000
Private Const PAGE_READWRITE = &H4
Private Const INFINITE = &HFFFFFFFF

Public Function ExecuteDll(lPid As Long) As Boolean
Dim hVictim As Long
Dim hInject As Long
Dim lParamAddress As Long
Dim lStartAddress As Long
Dim bB() As Byte
Dim sTmp As String

hVictim = OpenProcess(PROCESS_ALL_ACCESS, 0, lPid): If hVictim = 0 Then Exit Function
If hVictim = 0 Then: GoTo Error
'===
sTmp = "68" & GetLng(0) & _
"68" & GetLng(StrPtr("HOLA")) & _
"68" & GetLng(StrPtr("HOLA")) & _
"68" & GetLng(0) & "68"

Call PutThunk(sTmp, bB)
'===
lStartAddress = GetProcAddress(GetModuleHandle("USER32"), "MessageBoxA"): If lStartAddress = 0 Then GoTo Error
lParamAddress = VirtualAllocEx(hVictim, 0&, UBound(bB) + 1, MEM_COMMIT, PAGE_READWRITE): If lParamAddress = 0 Then GoTo Error
Call WriteProcessMemory(hVictim, lParamAddress, ByVal VarPtr(bB(0)), UBound(bB) + 1, ByVal 0&)
'===
hInject = CreateRemoteThread(hVictim, ByVal 0&, 0&, ByVal lStartAddress, lParamAddress, 0, ByVal 0&)
If hInject = 0 Then: GoTo Error
'===

Call WaitForSingleObject(hInject, INFINITE)
Call CloseHandle(hVictim)
Call CloseHandle(hInject)

ExecuteDll = True
Exit Function

Error:
Call CloseHandle(hInject)
Call CloseHandle(hVictim)

ExecuteDll = False
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

ReDim bvRet(0)

For i = 0 To Len(sThunk) - 1 Step 2
bvRet(i / 2) = CByte("&H" & Mid$(sThunk, i + 1, 2))
ReDim Preserve bvRet(UBound(bvRet) + 1)
Next i

ReDim Preserve bvRet(UBound(bvRet) - 1)
End Sub

Sub Main()
ExecuteDll 7756, 0
End Sub

Espero que alguno tenga un tiempito en corregir la parte de los paramentros en el sc, ya que pienso pero no puedo solucionarlo, y estoy trabajando en algo muy interesante y me gustaria poder concretarlo, y para eso necesito esto working    

Gracias y saludos desde el pequeño uruguay a todos los coderz que andan por ahi