Mensajes

Hola ya me estoy reorientando, bien, si la idea es cambiar un array de Bytes por otro de un ejecutable externo, la idea era hacer un cheat par aun juego on line el cual creo que ya me vanearon asi que me lo meto en el ....
pero en fin volviendo al tema Gracias a lo que me paso Seba me puse a investigar un poco y me tope con el problema de ReadProcessMemory el cual desdusco que no me leia nada porque no se puede empezar a leer desde el bite 0

Código [Seleccionar] Expandir

ReadProcessMemory ProcHandle, ByVal 0&, ByVal sBuffer, Len(sBuffer), BytesRead

hay una parte de la memoria que no se puede leer, lo cual se puede saber con VirtualQueryEx ((mbi.lType = MEM_PRIVATE) And (mbi.State = MEM_COMMIT))

como no se la dirección exacta en la memoria donde esta el array de bits que debo reemplazar tengo que buscar el array que tengo dentro del proceso, una vez encontrada la posición meter el nuevo array.

Saludos.

Hola, se que esto ya se hablo en el foro, pero no recuerdo bien con que apis buscar, quiero modificar cierta parte de el array de bits de un proceso.
Se agradecen aportes.

prácticamente son un grupo de constantes, las ventajas de esto es que si declaras en el ide una variable como esa enumeración al escribir esa variable = te salta un menú con la enumeración.

Hola, si es masomenos lo que entiendo esta es la forma mas rapida

Código (vb) [Seleccionar] Expandir


Option Explicit
'Autor: Leandro Ascierto
'Web: http://leandroascierto.com/blog/
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC 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 VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long
Private Declare Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type

Private Type SAFEARRAY2D
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    Bounds(0 To 1) As SAFEARRAYBOUND
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Const DIB_RGB_COLORS = 0
Private Const BI_RGB = 0&


Private Function FindColorInScreen(ByVal oColor As OLE_COLOR, ByRef PT() As POINTAPI) As Long
    Dim ScreenDC As Long
    Dim TmpDC As Long
    Dim hBmp As Long
    Dim OldBmp As Long
    Dim Addrs As Long
    Dim x As Long
    Dim y As Long
    Dim lpBits() As Long
    Dim BI As BITMAPINFO
    Dim SA As SAFEARRAY2D
    Dim W As Long, H As Long
    Dim lColor As Long
   
    W = Screen.Width / Screen.TwipsPerPixelX
    H = Screen.Height / Screen.TwipsPerPixelY

    With BI.bmiHeader
        .biSize = Len(BI.bmiHeader)
        .biWidth = W
        .biHeight = H
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
        .biSizeImage = AlignScan(.biWidth, .biBitCount) * .biHeight
    End With

    ScreenDC = GetDC(0)
    TmpDC = CreateCompatibleDC(ScreenDC)
    hBmp = CreateDIBSection(ScreenDC, BI, DIB_RGB_COLORS, Addrs, 0, 0)

    OldBmp = SelectObject(TmpDC, hBmp)

    Call BitBlt(TmpDC, 0, 0, W, H, ScreenDC, 0, 0, vbSrcCopy)
   
    Call ReleaseDC(0&, ScreenDC)

    With SA
        .cbElements = 4
        .cDims = 2
        .Bounds(0).lLbound = 0
        .Bounds(0).cElements = H
        .Bounds(1).lLbound = 0
        .Bounds(1).cElements = (BI.bmiHeader.biSizeImage \ .Bounds(0).cElements) \ 4
        .pvData = Addrs
    End With

    CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4

    ReDim PT(0)
   
    lColor = ConvertColor(oColor)

    For y = H - 1 To 0 Step -1
        For x = 0 To W - 1
            If lpBits(x, y) = lColor Then
                ReDim Preserve PT(FindColorInScreen)
                With PT(FindColorInScreen)
                    .x = x
                    .y = H - y
                End With
                FindColorInScreen = FindColorInScreen + 1
            End If
        Next
    Next

    CopyMemory ByVal VarPtrArray(lpBits), 0&, 4
    Call DeleteObject(SelectObject(TmpDC, OldBmp))
    Call DeleteDC(TmpDC)
End Function

Private Function AlignScan(ByVal inWidth As Long, ByVal inDepth As Integer) As Long
    AlignScan = (((inWidth * inDepth) + &H1F) And Not &H1F&) \ &H8
End Function

Private Function ConvertColor(oColor As OLE_COLOR) As Long
    Dim RGBA(0 To 3) As Byte
    Dim BGRA(0 To 3) As Byte
    OleTranslateColor oColor, 0, VarPtr(RGBA(0))
    BGRA(0) = RGBA(2)
    BGRA(1) = RGBA(1)
    BGRA(2) = RGBA(0)
    BGRA(3) = &HFF
    CopyMemory ConvertColor, BGRA(0), 4&
End Function

Private Sub Form_Load()
    Dim lCount As Long
    Dim PT() As POINTAPI
    Me.AutoRedraw = True
    lCount = FindColorInScreen(vbBlue, PT)
    If lCount > 0 Then
        SetCursorPos PT(0).x, PT(0).y
        Dim i As Long
        For i = 0 To lCount - 1
            Debug.Print PT(i).x, PT(i).y
        Next
    End If
End Sub


[EDIT: ahora que recuerdo si dentro de la cadena tenes un Nullchar chr(0) solo te cuenta hasta esa posición]

Hola otra opcion con apis

Código [Seleccionar] Expandir

Option Explicit
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Sub Form_Load()
   Dim s As String
   s = "Hola mundo"
   MsgBox lstrlenW(StrPtr(s))
End Sub


EDIT:  ahora que recuerdo si dentro de la cadena tenes un Nullchar chr(0) solo te cuenta hasta esa posición

Hola, estoy intentando obtener el puntero de una funcion dentro de una clase tal como se habló dentro de este post, pero mi problema es que la funcion no tiene cuatro paramentros sino dos y cuando intento llamar a la funcion llega a funcionar pero inmediatamente  revienta el vb bien, no se como hay que modificar el ASM para indicar que la funcion tiene dos long como parametro.

esto es lo que estoy haciendo, intento disparar el callback de una webcam dentro de un modulo clase

Código [Seleccionar] Expandir

Option Explicit

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function capCreateCaptureWindowA Lib "avicap32.dll" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Integer, ByVal hWndParent As Long, ByVal nID As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Const WM_USER                       As Long = &H400
Private Const WM_CAP_START                  As Long = WM_USER
Private Const WM_CAP_SET_CALLBACK_FRAME     As Long = WM_CAP_START + 5
Private Const WM_CAP_DRIVER_CONNECT         As Long = WM_CAP_START + 10
Private Const WM_CAP_DRIVER_DISCONNECT      As Long = WM_CAP_START + 11
Private Const WM_CAP_GET_VIDEOFORMAT        As Long = WM_CAP_START + 44
Private Const WM_CAP_GRAB_FRAME             As Long = WM_CAP_START + 60

Private Type VIDEOHDR
   lpData          As Long
   dwBufferLength  As Long
   dwBytesUsed     As Long
   dwTimeCaptured  As Long
   dwUser          As Long
   dwFlags         As Long
   dwReserved(3)   As Long
End Type

Private bvASM(40) As Byte
Private hwndCap As Long


Public Function FrameCallBack(ByVal lWnd As Long, ByVal lpVHdr As Long) As Long

   Debug.Print "FUNCIONA!"

End Function

Public Function Capture()
   Call SendMessage(hwndCap, WM_CAP_GRAB_FRAME, ByVal 0&, ByVal 0&)
End Function

Public Function CreateCaptureWindow() As Boolean

   hwndCap = capCreateCaptureWindowA(vbNullString, 0&, 0&, 0&, 0&, 0&, 0&, 0&)

   If hwndCap Then
       Call SendMessage(hwndCap, WM_CAP_SET_CALLBACK_FRAME, 0, GetAdressMe(Me))
       CreateCaptureWindow = True
   End If
End Function

Function capGetVideoFormat(ByVal hCapWnd As Long, ByVal CapFormatSize As Long, ByVal BmpFormat As Long) As Long
  capGetVideoFormat = SendMessage(hCapWnd, WM_CAP_GET_VIDEOFORMAT, CapFormatSize, BmpFormat)
End Function

Public Function DestroyCaptureWindow() As Boolean
   If hwndCap Then DestroyCaptureWindow = DestroyWindow(hwndCap): hwndCap = 0
End Function

Public Function ConnectDriver() As Boolean
   If hwndCap Then ConnectDriver = SendMessage(hwndCap, WM_CAP_DRIVER_CONNECT, 0&, 0&)
End Function

Public Function DisconnectDriver() As Boolean
   If hwndCap Then
       Call SendMessage(hwndCap, WM_CAP_SET_CALLBACK_FRAME, 0&, vbNull)
       DisconnectDriver = SendMessage(hwndCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
   End If
End Function


Private Function GetAdressMe(Obj As Object) As Long
   Dim WindowProcAddress As Long
   Dim pObj As Long
   Dim pVar As Long

   Dim i As Long

   For i = 0 To 40
       bvASM(i) = Choose(i + 1, &H55, &H8B, &HEC, &H83, &HC4, &HFC, &H8D, &H45, &HFC, &H50, &HFF, &H75, &H14, _
                                &HFF, &H75, &H10, &HFF, &H75, &HC, &HFF, &H75, &H8, &H68, &H0, &H0, &H0, &H0, _
                                &HB8, &H0, &H0, &H0, &H0, &HFF, &HD0, &H8B, &H45, &HFC, &HC9, &HC2, &H10, &H0)
   Next i

   pObj = ObjPtr(Obj)

   Call CopyMemory(pVar, ByVal pObj, 4)
   Call CopyMemory(WindowProcAddress, ByVal (pVar + 28), 4)

   Call LongToByte(pObj, bvASM, 23)
   Call LongToByte(WindowProcAddress, bvASM, 28)

   GetAdressMe = VarPtr(bvASM(0))
End Function


Private Sub LongToByte(ByVal lLong As Long, ByRef bReturn() As Byte, Optional i As Integer = 0)
   bReturn(i) = lLong And &HFF
   bReturn(i + 1) = (lLong And 65280) / &H100
   bReturn(i + 2) = (lLong And &HFF0000) / &H10000
   bReturn(i + 3) = ((lLong And &HFF000000) \ &H1000000) And &HFF
End Sub





en el formulario con un boton

Código [Seleccionar] Expandir

Option Explicit
Dim C1 As Class1

Private Sub Command1_Click()
   C1.Capture
End Sub

Private Sub Form_Load()
   Set C1 = New Class1
   C1.CreateCaptureWindow
   C1.ConnectDriver
End Sub

Private Sub Form_Unload(Cancel As Integer)
   C1.DisconnectDriver
   C1.DestroyCaptureWindow
   Set C1 = Nothing
End Sub

Hola, esta solo implementa una forma de comprobar el tipo de variable, pero al final utiliza el error para comprovar

Código [Seleccionar] Expandir

Private Function IsNumeric_LeandroA(Expression) As Boolean
    Select Case VarType(Expression)
        Case vbBoolean, vbByte, vbInteger, vbLong, vbCurrency, vbDecimal, vbDouble, vbNull, vbEmpty, vbError
            IsNumeric_LeandroA = True
        Case vbArray, vbDataObject, vbDate, vbObject, vbUserDefinedType
            IsNumeric_LeandroA = False
        Case vbString
            If Val(Expression) <> 0 Then
                IsNumeric_LeandroA = True
            Else
                On Error Resume Next
                IsNumeric_LeandroA = Abs(Expression) + 1
            End If
    End Select
End Function

lo unico que gana en velocidad es si el parametro no fue definido como string.

Código [Seleccionar] Expandir


IsNumeric_LeandroA(85.54778)
IsNumeric_LeandroA(-85.54778)
IsNumeric_LeandroA(8554778)
IsNumeric_LeandroA(me)


i = FindWindowEx(lparam, 0, "#32770", "")

Hola supuestamente el lparam es l handle de la ventana asi que no devias buscar la ventana  "#32770"  en caso que vos no tengas el lparam utilizas findwindow (no findwindowEx)

syslistivew32= FindWindowEx(lparam, ByVal 0&, "SysListView32", vbNullString)


te dejo un link que te va a sevir
http://www.recursosvisualbasic.com.ar/htm/listado-api/70-ocultar-administrador-tareas.htm

Hola se puede eliminar los bordes utilizando una region

Código (vb) [Seleccionar] Expandir


Option Explicit
Private Declare Function CreateRectRgn Lib "gdi32.dll" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32.dll" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Sub Form_Load()
    DeleteCmdBorder Command1.hwnd
End Sub


Private Sub DeleteCmdBorder(ByVal hwnd As Long)
    Dim Rec As RECT
    Dim hRgn As Long
    GetClientRect hwnd, Rec
    hRgn = CreateRectRgn(3, 3, Rec.Right - 3, Rec.Bottom - 3)
    SetWindowRgn hwnd, hRgn, True
End Sub


Buena data seba, de todas formas la forma el de raul es una alternativa por si falla la primera, no es solo un rss de taringa sino es para cualquier rss de cualquier pagina.

SAludos.