Как передать скриншот (принтскрин) по TCP ?

Option Explicit
 
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 GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs 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 As EncoderParameter
End Type
 
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function GetHGlobalFromStream Lib "ole32" (ByVal ppstm As Long, hGlobal As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem 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 GdipSaveImageToStream Lib "GDIPlus" (ByVal Image As Long, ByVal Stream As IUnknown, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal Filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
 
Private Const OBJ_BITMAP = 7
 
Private Sub Form_Load()
    Dim dDc As Long, dhWnd As Long
    Dim tBmp As Long
    Dim iBmp As BITMAPINFO
    Dim Pix() As Long
    Dim IStream As IUnknown
    Dim hMem As Long
    Dim lSize As Long
    Dim lPt As Long
    Dim Dat() As Byte
    Dim fNum As Integer
    
    Dim X As Long, Y As Long
    
    dhWnd = GetDesktopWindow()
    dDc = GetDC(dDc)
    tBmp = GetCurrentObject(dDc, OBJ_BITMAP)
    
    iBmp.bmiHeader.biSize = Len(iBmp.bmiHeader)
    GetDIBits dDc, tBmp, 0, 0, 0&, iBmp, 0
    
    iBmp.bmiHeader.biBitCount = 32
    ReDim Pix(iBmp.bmiHeader.biWidth - 1, iBmp.bmiHeader.biHeight - 1)
    
    iBmp.bmiHeader.biHeight = -iBmp.bmiHeader.biHeight          ' Для нисходящих рисунков
    iBmp.bmiHeader.biCompression = 0                            ' Убираем компрессию если она есть
    
    GetDIBits dDc, tBmp, 0, -iBmp.bmiHeader.biHeight, Pix(0, 0), iBmp, 0
    ' В массиве Pix содержатся пиксели рисунка делай с ними что захочешь
    ' в моем примере инвертируем их
    
    For X = 0 To iBmp.bmiHeader.biWidth - 1: For Y = 0 To -iBmp.bmiHeader.biHeight - 1
        Pix(X, Y) = Pix(X, Y) Xor &HFFFFFF
    Next: Next
    
    ' Записываем в промежуточный Bitmap изменения
    tBmp = CreateCompatibleBitmap(dDc, iBmp.bmiHeader.biWidth, -iBmp.bmiHeader.biHeight)
    SetDIBits dDc, tBmp, 0, -iBmp.bmiHeader.biHeight, Pix(0, 0), iBmp, 0
       
    Erase Pix
    
    ReleaseDC dhWnd, dDc
     
    If CreateStreamOnHGlobal(0&, 1&, IStream) Then MsgBox "Ошибка создание потока": Exit Sub
    If Not SaveJPG(tBmp, IStream) Then MsgBox "Ошибка сохранение файла в поток": DeleteObject (tBmp): Exit Sub
    
    DeleteObject tBmp
    
    If GetHGlobalFromStream(ObjPtr(IStream), hMem) Then MsgBox "Ошибка получения хендла памяти": Exit Sub
    lSize = GlobalSize(hMem)
    If lSize Then
        lPt = GlobalLock(hMem)
        ReDim Dat(0 To lSize - 1)
        CopyMemory Dat(0), ByVal lPt, lSize
        GlobalUnlock hMem
    End If
    
'    ' Проверка
'    fNum = FreeFile
'    Open "D:\Temp.jpg" For Binary As fNum
'    Put fNum, , Dat
'    Close fNum
    
End Sub
Private Function SaveJPG(hBitmap As Long, Stream As IUnknown, Optional Quality As Byte = 50) As Boolean
    Dim SI As GdiplusStartupInput
    Dim token As Long, lBmp As Long
    Dim JpgEnc As GUID, Res As Long
    Dim Par As EncoderParameters
    
    SI.GdiplusVersion = 1
    If GdiplusStartup(token, SI) Then Exit Function
    If GdipCreateBitmapFromHBITMAP(hBitmap, 0, lBmp) Then GdiplusShutdown (token): Exit Function
    CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), JpgEnc
    Par.Count = 1
    Par.Parameter.NumberOfValues = 1
    Par.Parameter.type = 4
    Par.Parameter.Value = VarPtr(Quality)
    CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), Par.Parameter.GUID
    Res = GdipSaveImageToStream(lBmp, Stream, JpgEnc, Par)
    GdipDisposeImage lBmp
    GdiplusShutdown token
    If Res Then Exit Function
    SaveJPG = True
End Function

Private Sub Form_Load()
    Dim dDc As Long, dhWnd As Long
    Dim tBmp As Long
    Dim iBmp As BITMAPINFO
    Dim Pix() As Long
    Dim IStream As IUnknown
    Dim hMem As Long
    Dim lSize As Long
    Dim lPt As Long
    Dim Dat() As Byte
    Dim fNum As Integer
    Dim tDc As Long
    Dim oBmp As Long
    
    Dim x As Long, y As Long
    
    dhWnd = GetDesktopWindow()
    dDc = GetDC(dDc)
    tDc = CreateCompatibleDC(dDc)
    tBmp = CreateCompatibleBitmap(dDc, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY)
    oBmp = SelectObject(tDc, tBmp)
    BitBlt tDc, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, dDc, 0, 0, vbSrcCopy
    SelectObject tDc, oBmp
    DeleteDC tDc
    
    iBmp.bmiHeader.biSize = Len(iBmp.bmiHeader)
    GetDIBits dDc, tBmp, 0, 0, 0&, iBmp, 0
    
    iBmp.bmiHeader.biBitCount = 32
    ReDim Pix(iBmp.bmiHeader.biWidth - 1, iBmp.bmiHeader.biHeight - 1)
    
    iBmp.bmiHeader.biHeight = -iBmp.bmiHeader.biHeight          ' Для нисходящих рисунков
    iBmp.bmiHeader.biCompression = 0                            ' Убираем компрессию если она есть
    
    GetDIBits dDc, tBmp, 0, -iBmp.bmiHeader.biHeight, Pix(0, 0), iBmp, 0
    ' В массиве Pix содержатся пиксели рисунка делай с ними что захочешь
    ' в моем примере инвертируем их
    
    For x = 0 To iBmp.bmiHeader.biWidth - 1: For y = 0 To -iBmp.bmiHeader.biHeight - 1
        Pix(x, y) = Pix(x, y) Xor &HFFFFFF
    Next: Next
    
    ' Записываем в промежуточный Bitmap изменения
    SetDIBits dDc, tBmp, 0, -iBmp.bmiHeader.biHeight, Pix(0, 0), iBmp, 0
       
    Erase Pix
    
    ReleaseDC dhWnd, dDc
     
    If CreateStreamOnHGlobal(0&, 1&, IStream) Then MsgBox "Ошибка создание потока": Exit Sub
    If Not SaveJPG(tBmp, IStream) Then MsgBox "Ошибка сохранение файла в поток": DeleteObject (tBmp): Exit Sub
    
    DeleteObject tBmp
    
    If GetHGlobalFromStream(ObjPtr(IStream), hMem) Then MsgBox "Ошибка получения хендла памяти": Exit Sub
    lSize = GlobalSize(hMem)
    If lSize Then
        lPt = GlobalLock(hMem)
        ReDim Dat(0 To lSize - 1)
        CopyMemory Dat(0), ByVal lPt, lSize
        GlobalUnlock hMem
    End If
    
    ' Проверка
    fNum = FreeFile
    Open "D:\Temp.jpg" For Binary As fNum
    Put fNum, , Dat
    Close fNum
    
End Sub

Option Explicit
 
Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type
 
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem 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 GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal Stream As IUnknown, image As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, Graphics As Long) As Long
Private Declare Function GdipDrawImage Lib "gdiplus" (ByVal Graphics As Long, ByVal image As Long, ByVal X As Single, ByVal Y As Single) As Long
 
Private Const GMEM_MOVEABLE = &H2
 
Private Sub Form_Load()
    Dim IStream As IUnknown
    Dim hMem As Long
    Dim lPt As Long
    Dim Dat() As Byte
    Dim fNum As Integer
    Dim SI As GdiplusStartupInput
    Dim token As Long, lBmp As Long, Gr As Long
    
    Me.AutoRedraw = True
    
    ' Открытие
    fNum = FreeFile
    Open "D:\Temp.jpg" For Binary As fNum
    ReDim Dat(LOF(fNum) - 1)
    Get fNum, , Dat
    Close fNum
    
    hMem = GlobalAlloc(GMEM_MOVEABLE, UBound(Dat) + 1)
    If hMem = 0 Then MsgBox "Ошибка выделения памяти": Exit Sub
    lPt = GlobalLock(hMem)
    If lPt = 0 Then MsgBox "Ошибка блокировки памяти": GlobalFree hMem: Exit Sub
    CopyMemory ByVal lPt, Dat(0), UBound(Dat) - 1
    Call GlobalUnlock(hMem)
    If CreateStreamOnHGlobal(hMem, 1&, IStream) Then MsgBox "Ошибка создание потока": GlobalFree hMem: Exit Sub
    
    SI.GdiplusVersion = 1
    If GdiplusStartup(token, SI) = 0 Then
        If GdipLoadImageFromStream(IStream, lBmp) = 0 Then
            Call GdipCreateFromHDC(Me.hdc, Gr)
            Call GdipDrawImage(Gr, lBmp, 0, 0)
            Call GdipDisposeImage(lBmp)
        Else
            MsgBox "Ошибка загрузки файла"
        End If
        GdiplusShutdown token
    Else
        MsgBox "Ошибка инициализации GDI+"
    End If
    Set IStream = Nothing
End Sub

 tDc = CreateCompatibleDC(dDc)

Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long