Copiar pantalla segun coordenadas

Vengo trabajando hace un tiempo con esto de capturar una parte de la pantalla, funciona bien en mi troyano y te lo dejo a ver si es lo que quieres:

en un modulo:

Código

Option Explicit
 
Declare Function GetActiveWindow _
        Lib "user32.dll" () As Long
Declare Function FlashWindow Lib "user32.dll" _
       (ByVal hwnd As Long, _
        ByVal bInvert As Long) As Long
Declare Sub Sleep Lib "kernel32.dll" _
       (ByVal dwMilliseconds As Long)
 
 
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
' ----==== GDIPlus Const ====----
Public Const GdiPlusVersion As Long = 1
Private Const mimeJPG As String = "image/jpeg"
 
Private Const EncoderParameterValueTypeLong As Long = 4
Private Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Private Const EncoderCompression As String = "{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"
' ----==== Sonstige Types ====----
Private Type PICTDESC
    cbSizeOfStruct As Long
    picType As Long
    hgdiObj As Long
    hPalOrXYExt As Long
End Type
 
Private Type IID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7)  As Byte
End Type
 
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
' ----==== GDIPlus Types ====----
Private Type GDIPlusStartupInput
    GdiPlusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type
 
Private Type GdiplusStartupOutput
    NotificationHook As Long
    NotificationUnhook As Long
End Type
 
Private Type EncoderParameter
    GUID As GUID
    NumberOfValues As Long
    type As Long
    Value As Long
End Type
 
Private Type EncoderParameters
    Count As Long
    Parameter(15) As EncoderParameter
End Type
 
Private Type ImageCodecInfo
    Clsid As GUID
    FormatID As GUID
    CodecNamePtr As Long
    DllNamePtr As Long
    FormatDescriptionPtr As Long
    FilenameExtensionPtr As Long
    MimeTypePtr As Long
    Flags As Long
    Version As Long
    SigCount As Long
    SigSize As Long
    SigPatternPtr As Long
    SigMaskPtr As Long
End Type
 
' ----==== GDI+ 5.xx und 6.xx Enumerationen ====----
Private Type ARGB
    Blue As Byte
    Green As Byte
    Red As Byte
    Alpha As Byte
End Type
 
Private Type ColorPalette
    Flags As PaletteFlags
    Count As Long
    Entries As ARGB
End Type
 
Public Enum EncoderValueConstants
    EncoderValueColorTypeCMYK = 0
    EncoderValueColorTypeYCCK = 1
    EncoderValueCompressionLZW = 2
    EncoderValueCompressionCCITT3 = 3
    EncoderValueCompressionCCITT4 = 4
    EncoderValueCompressionRle = 5
    EncoderValueCompressionNone = 6
    EncoderValueScanMethodInterlaced = 7
    EncoderValueScanMethodNonInterlaced = 8
    EncoderValueVersionGif87 = 9
    EncoderValueVersionGif89 = 10
    EncoderValueRenderProgressive = 11
    EncoderValueRenderNonProgressive = 12
    EncoderValueTransformRotate90 = 13
    EncoderValueTransformRotate180 = 14
    EncoderValueTransformRotate270 = 15
    EncoderValueTransformFlipHorizontal = 16
    EncoderValueTransformFlipVertical = 17
    EncoderValueMultiFrame = 18
    EncoderValueLastFrame = 19
    EncoderValueFlush = 20
    EncoderValueFrameDimensionTime = 21
    EncoderValueFrameDimensionResolution = 22
    EncoderValueFrameDimensionPage = 23
End Enum
 
Private Enum PaletteFlags
    PaletteFlagsHasAlpha = &H1
    PaletteFlagsGrayScale = &H2
    PaletteFlagsHalftone = &H4
End Enum
 
Private Enum PixelFormats
    PixelFormatUndefined = &H0&
    PixelFormatDontCare = PixelFormatUndefined
    PixelFormatMax = &HF&
    PixelFormat1_8 = &H100&
    PixelFormat4_8 = &H400&
    PixelFormat8_8 = &H800&
    PixelFormat16_8 = &H1000&
    PixelFormat24_8 = &H1800&
    PixelFormat32_8 = &H2000&
    PixelFormat48_8 = &H3000&
    PixelFormat64_8 = &H4000&
    PixelFormat16bppRGB555 = &H21005
    PixelFormat16bppRGB565 = &H21006
    PixelFormat16bppGrayScale = &H101004
    PixelFormat16bppARGB1555 = &H61007
    PixelFormat24bppRGB = &H21808
    PixelFormat32bppRGB = &H22009
    PixelFormat32bppARGB = &H26200A
    PixelFormat32bppPARGB = &HD200B
    PixelFormat48bppRGB = &H10300C
    PixelFormat64bppARGB = &H34400D
    PixelFormat64bppPARGB = &H1C400E
    PixelFormatGDI = &H20000
    PixelFormat1bppIndexed = &H30101
    PixelFormat4bppIndexed = &H30402
    PixelFormat8bppIndexed = &H30803
    PixelFormatAlpha = &H40000
    PixelFormatIndexed = &H10000
    PixelFormatPAlpha = &H80000
    PixelFormatExtended = &H100000
    PixelFormatCanonical = &H200000
End Enum
 
' ----==== Sonstige Enumerationen ====----
'Public Enum TifCompressionType
'    ' EncoderValueConstants.EncoderValueCompressionLZW
'    TiffCompressionLZW = 2
'    'EncoderValueConstants.EncoderValueCompressionCCITT3
'    TiffCompressionCCITT3 = 3
'    'EncoderValueConstants.EncoderValueCompressionCCITT4
'    TiffCompressionCCITT4 = 4
'    'EncoderValueConstants.EncoderValueCompressionRle
'    TiffCompressionRle = 5
'    'EncoderValueConstants.EncoderValueCompressionNone
'    TiffCompressionNone = 6
'End Enum
' ----==== GDIPlus Enums ====----
Public Enum Status 'GDI+ Status
    OK = 0
    GenericError = 1
    InvalidParameter = 2
    OutOfMemory = 3
    ObjectBusy = 4
    InsufficientBuffer = 5
    NotImplemented = 6
    Win32Error = 7
    WrongState = 8
    Aborted = 9
    FileNotFound = 10
    ValueOverflow = 11
    AccessDenied = 12
    UnknownImageFormat = 13
    FontFamilyNotFound = 14
    FontStyleNotFound = 15
    NotTrueTypeFont = 16
    UnsupportedGdiplusVersion = 17
    GdiplusNotInitialized = 18
    PropertyNotFound = 19
    PropertyNotSupported = 20
    ProfileNotFound = 21
End Enum
' ----==== GDI+ 6.xx Enumerationen ====----
Private Enum DitherType
    DitherTypeNone = 0
    DitherTypeSolid = 1
    DitherTypeOrdered4x4 = 2
    DitherTypeOrdered8x8 = 3
    DitherTypeOrdered16x16 = 4
    DitherTypeOrdered91x91 = 5
    DitherTypeSpiral4x4 = 6
    DitherTypeSpiral8x8 = 7
    DitherTypeDualSpiral4x4 = 8
    DitherTypeDualSpiral8x8 = 9
    DitherTypeErrorDiffusion = 10
End Enum
 
Private Enum PaletteType
    PaletteTypeCustom = 0
    PaletteTypeOptimal = 1
    PaletteTypeFixedBW = 2
    PaletteTypeFixedHalftone8 = 3
    PaletteTypeFixedHalftone27 = 4
    PaletteTypeFixedHalftone64 = 5
    PaletteTypeFixedHalftone125 = 6
    PaletteTypeFixedHalftone216 = 7
    PaletteTypeFixedHalftone252 = 8
    PaletteTypeFixedHalftone256 = 9
End Enum
' ----==== GDI+ 5.xx und 6.xx API Deklarationen ====----
Private Declare Function GdipCloneBitmapArea Lib "gdiplus" _
    (ByVal x As Single, ByVal y As Single, ByVal Width As Single, _
    ByVal Height As Single, ByVal format As PixelFormats, _
    ByVal srcBitmap As Long, ByRef dstBitmap As Long) As Status
 
Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" _
    (ByVal FileName As Long, ByRef BITMAP As Long) As Status
 
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" _
    (ByVal hbm As Long, ByVal hpal As Long, _
    ByRef BITMAP As Long) As Status
 
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" _
    (ByVal BITMAP As Long, ByRef hbmReturn As Long, _
    ByVal background As Long) As Status
 
Private Declare Function GdipDisposeImage Lib "gdiplus" _
    (ByVal image As Long) As Status
 
Private Declare Function GdipGetImageEncoders Lib "gdiplus" _
    (ByVal numEncoders As Long, ByVal Size As Long, _
    ByRef Encoders As Any) As Status
 
Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" _
    (ByRef numEncoders As Long, ByRef Size As Long) As Status
 
Private Declare Function GdipGetImagePixelFormat Lib "gdiplus" _
(ByVal image As Long, ByRef PixelFormat As PixelFormats) As Status
 
Private Declare Function GdipGetImageDimension Lib "gdiplus" _
    (ByVal image As Long, ByRef sngWidth As Single, _
    ByRef sngHeight As Single) As Status
 
Private Declare Function GdiplusShutdown Lib "gdiplus" _
    (ByVal token As Long) As Status
 
Private Declare Function GdiplusStartup Lib "gdiplus" _
    (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, _
    Optional ByRef lpOutput As Any) As Status
 
Private Declare Function GdipSaveImageToFile Lib "gdiplus" _
    (ByVal image As Long, ByVal FileName As Long, _
    ByRef clsidEncoder As GUID, _
    ByRef encoderParams As Any) As Status
 
' ----==== GDI+ 6.xx API Deklarationen ====----
Private Declare Function GdipBitmapConvertFormat Lib "gdiplus" _
    (ByVal pInputBitmap As Long, _
    ByVal PixelFormat As PixelFormats, _
    ByVal DitherType As DitherType, _
    ByVal PaletteType As PaletteType, _
    ByVal palette As Any, _
    ByVal alphaThresholdPercent As Single) As Status
 
Private Declare Function GdipInitializePalette Lib "gdiplus" _
    (ByVal palette As Any, _
    ByVal PaletteType As PaletteType, _
    ByVal optimalColors As Long, _
    ByVal useTransparentColor As Long, _
    ByVal BITMAP As Long) As Status
 
' ----==== OLE API Declarations ====----
Private Declare Function CLSIDFromString Lib "ole32" _
    (ByVal str As Long, id As GUID) As Long
 
Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" _
    (lpPictDesc As PICTDESC, riid As IID, ByVal fOwn As Boolean, _
    lplpvObj As Object)
 
' ----==== Kernel API Declarations ====----
Private Declare Function lstrlenW Lib "kernel32" _
    (lpString As Any) As Long
 
Private Declare Function lstrcpyW Lib "kernel32" _
    (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" _
Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
 
Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
 
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long
 
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long
' ----==== Variablen ====----
Private GdipToken As Long
Private GdipInitialized As Boolean
Public UseGDI6 As Boolean
 
 
Public Function StartUpGDIPlus(ByVal GdipVersion As Long) As Status
    ' Initialisieren der GDI+ Instanz
    Dim GdipStartupInput As GDIPlusStartupInput
    GdipStartupInput.GdiPlusVersion = GdipVersion
    StartUpGDIPlus = GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
End Function
Public Function ShutdownGDIPlus() As Status
    ' Beendet GDI+ Instanz
    ShutdownGDIPlus = GdiplusShutdown(GdipToken)
End Function
Public Function Execute(ByVal lReturn As Status) As Status
    Dim lCurErr As Status
    If lReturn = Status.OK Then
        lCurErr = Status.OK
    Else
        lCurErr = lReturn
        MsgBox GdiErrorString(lReturn) & " GDI+ Error:" & lReturn, _
               vbOKOnly, "GDI Error"
    End If
    Execute = lCurErr
End Function
 
Private Function GdiErrorString(ByVal lError As Status) As String
    Dim s As String
 
Select Case lError
 
Case GenericError:                  s = "Generic Error."
Case InvalidParameter: s = "Invalid Parameter."
Case OutOfMemory:                   s = "Out Of Memory."
Case ObjectBusy:                    s = "Object Busy."
Case InsufficientBuffer: s = "Insufficient Buffer."
Case NotImplemented:                s = "Not Implemented."
Case Win32Error:                    s = "Win32 Error."
Case WrongState:                    s = "Wrong State."
Case Aborted:                       s = "Aborted."
Case FileNotFound:                  s = "File Not Found."
Case ValueOverflow:                 s = "Value Overflow."
Case AccessDenied:                  s = "Access Denied."
Case UnknownImageFormat: s = "Unknown Image Format."
Case FontFamilyNotFound: s = "FontFamily Not Found."
Case FontStyleNotFound:            s = "FontStyle Not Found."
Case NotTrueTypeFont:   s = "Not TrueType Font."
Case UnsupportedGdiplusVersion: s = "Unsupported Gdiplus Version."
Case GdiplusNotInitialized:     s = "Gdiplus Not Initialized."
Case PropertyNotFound: s = "Property Not Found."
Case PropertyNotSupported:      s = "Property Not Supported."
Case Else:                             s = "Unknown GDI+ Error."
 
End Select
 
    GdiErrorString = s
End Function
Public Function LoadPicturePlus(ByVal FileName As String) As StdPicture
    Dim retStatus As Status
    Dim lBitmap As Long
    Dim hBitmap As Long
 
    ' Öffnet die Bilddatei in lBitmap
retStatus = Execute(GdipCreateBitmapFromFile(StrPtr(FileName), lBitmap))
 
If retStatus = OK Then
 
' Erzeugen einer GDI Bitmap lBitmap -> hBitmap
retStatus = Execute(GdipCreateHBITMAPFromBitmap(lBitmap, hBitmap, 0))
 
If retStatus = OK Then
               ' Erzeugen des StdPicture Objekts von hBitmap
Set LoadPicturePlus = HandleToPicture(hBitmap, vbPicTypeBitmap)
End If
 
' Lösche lBitmap
Call Execute(GdipDisposeImage(lBitmap))
 
    End If
End Function
Private Function HandleToPicture(ByVal hGDIHandle As Long, _
    ByVal ObjectType As PictureTypeConstants, _
    Optional ByVal hpal As Long = 0) As StdPicture
 
    Dim tPictDesc As PICTDESC
    Dim IID_IPicture As IID
    Dim oPicture As IPicture
 
    ' Initialisiert die PICTDESC Structur
    With tPictDesc
        .cbSizeOfStruct = Len(tPictDesc)
        .picType = ObjectType
        .hgdiObj = hGDIHandle
        .hPalOrXYExt = hpal
    End With
 
    ' Initialisiert das IPicture Interface ID
    With IID_IPicture
        .Data1 = &H7BF80981
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(3) = &HAA
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
 
    ' Erzeugen des Objekts
    OleCreatePictureIndirect tPictDesc, IID_IPicture, True, oPicture
 
    ' Rückgabe des Pictureobjekts
    Set HandleToPicture = oPicture
 
End Function
Private Function GetEncoderClsid(mimeType As String, pClsid As GUID) _
    As Boolean
 
    Dim num As Long
    Dim Size As Long
    Dim pImageCodecInfo() As ImageCodecInfo
    Dim j As Long
    Dim buffer As String
 
    Call GdipGetImageEncodersSize(num, Size)
    If (Size = 0) Then
        GetEncoderClsid = False  '// fehlgeschlagen
        Exit Function
    End If
 
    ReDim pImageCodecInfo(0 To Size \ Len(pImageCodecInfo(0)) - 1)
    Call GdipGetImageEncoders(num, Size, pImageCodecInfo(0))
 
    For j = 0 To num - 1
        buffer = Space$(lstrlenW(ByVal pImageCodecInfo(j).MimeTypePtr))
 
        Call lstrcpyW(ByVal StrPtr(buffer), ByVal _
               pImageCodecInfo(j).MimeTypePtr)
 
        If (StrComp(buffer, mimeType, vbTextCompare) = 0) Then
               pClsid = pImageCodecInfo(j).Clsid
               Erase pImageCodecInfo
               GetEncoderClsid = True  '// erfolgreich
               Exit Function
        End If
    Next j
 
    Erase pImageCodecInfo
    GetEncoderClsid = False  '// fehlgeschlagen
End Function
Public Function UseGDI_v_6xx() As Boolean
 
    Dim hMod As Long
    Dim Loaded As Boolean
    Dim sFunction As String
    Dim sModule As String
 
    ' GDIPLUS.DLL
    sModule = "GDIPLUS"
 
    ' eine Funktion die erst ab der
    ' GDI+ 6.xx vorhanden ist
    sFunction = "GdipDrawImageFX"
 
    'Handle der DLL erhalten
    hMod = GetModuleHandle(sModule)
 
    ' Falls DLL nicht registriert ...
    If hMod = 0 Then
        ' DLL in den Speicher laden.
        hMod = LoadLibrary(sModule)
        If hMod Then Loaded = True
    End If
 
    If hMod Then
        If GetProcAddress(hMod, sFunction) Then UseGDI_v_6xx = True
    End If
 
    If Loaded Then Call FreeLibrary(hMod)
 
End Function
Public Function SavePictureAsJPG(ByVal Pic As StdPicture, _
    ByVal FileName As String, Optional ByVal Quality As Long = 85) _
    As Boolean
 
    Dim retStatus As Status
    Dim retval As Boolean
    Dim lBitmap As Long
 
    ' Erzeugt eine GDI+ Bitmap vom StdPicture Handle -> lBitmap
    retStatus = Execute(GdipCreateBitmapFromHBITMAP(Pic.Handle, 0, _
        lBitmap))
 
    If retStatus = OK Then
 
        Dim PicEncoder As GUID
        Dim tParams As EncoderParameters
 
        '// Ermitteln der CLSID vom mimeType Encoder
        retval = GetEncoderClsid(mimeJPG, PicEncoder)
        If retval = True Then
 
               If Quality > 100 Then Quality = 100
               If Quality < 0 Then Quality = 0
 
               ' Initialisieren der Encoderparameter
               tParams.Count = 1
               With tParams.Parameter(0) ' Quality
                   ' Setzen der Quality GUID
                   CLSIDFromString StrPtr(EncoderQuality), .GUID
                   .NumberOfValues = 1
                   .type = EncoderParameterValueTypeLong
                   .Value = VarPtr(Quality)
               End With
 
               ' Speichert lBitmap als JPG
               retStatus = Execute(GdipSaveImageToFile(lBitmap, _
                   StrPtr(FileName), PicEncoder, tParams))
 
               If retStatus = OK Then
                   SavePictureAsJPG = True
               Else
                   SavePictureAsJPG = False
               End If
        Else
               SavePictureAsJPG = False
               MsgBox "Konnte keinen passenden Encoder ermitteln.", _
               vbOKOnly, "Encoder Error"
        End If
 
        ' Lösche lBitmap
        Call Execute(GdipDisposeImage(lBitmap))
 
    End If
End Function

En el load inicias dos variables: cx y cy (coordenadas)

Código:

Private Sub Form_Load()
    cx = 0
    cy = 0
End Sub

Luego en el form pones un Picture llamado "PIC1" y un command llamado "CmdCapture_PART", en el boton va esto:

Código

    Dim retStatus As Status
    retStatus = Execute(StartUpGDIPlus(GdiPlusVersion))
 
 
    Me.AutoRedraw = True
    Me.ScaleMode = 1
    aimg = GetDesktopWindow()
    simg = GetDC(aimg)
 
    BitBlt Pic1.hDC, 0, 0, Pic1.Width, Pic1.Height, simg, cx, cy, vbSrcCopy
    SavePictureAsJPG Pic1.image, "c:\parte.jpg", 10
 
 
    retStatus = Execute(ShutdownGDIPlus)

Lo que hace es guardar una parte de la pantalla en un archivo JPG a un grado de compresion elegido por ti que puede ser de 1 a 100, el ejempplo esta con 10 de compresion.

La parte capturada viene dada por la linea

Código:

BitBlt Pic1.hDC, 0, 0, Pic1.Width, Pic1.Height, simg, cx, cy, vbSrcCopy

Te va a tocar hacer pruebas para entenderlo por completo, lo saque del servidor de mi troyanin asi que pueda que falte algo.

Un saludo.