Судя по размещению темы, к высоким умам ты причисляешь и себя любимого.
keks-n писал(а):Нет там никакой компрессии - шлются GDI-команды.
А вообще, есть стандартные средства. Remote Desktop(я даж с КПК-хи подключался, встроенной прогой).
sosed213 писал(а):радминовцы также используют систему клиет-сервер.
ALX_2002 писал(а):P.S Можно ли задать человеку вопрос если спрашивать некого ???
Dim TheBytes() As Byte
Dim inFile As String
Dim LenInFile As Long
inFile = "C:\!Qtest\VB\06.jpg "
LenInFile = FileLen(inFile)
ReDim TheBytes(LenInFile - 1)
Open inFile For Binary Access Read As #3
Get #3, , TheBytes()
Close #3
sosed213 писал(а):Хочу сделать скришот, загнать его в масив типа Byte (пока незнаю как), и при помощи фунции OleLoadPicture(уже умею делать) распаковать обратно из массива.
tyomitch писал(а):Их никогда не удастся упаковать даже близко так же плотно, как GDI-команды.
По хорошому надо создать модуль для конвертирования буфера програмного принскрина в байтовую переменную.
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As GUID, ppvObj 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 GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GetHGlobalFromStream Lib "ole32" (ByVal pstm As IStream, phglobal As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Type GUID ' 16 bytes (128 bits)
dwData1 As Long ' 4 bytes
wData2 As Integer ' 2 bytes
wData3 As Integer ' 2 bytes
abData4(7) As Byte ' 8 bytes, zero based
End Type
Private Type PictureHeader
Magic As Long
Size As Long
End Type
Private Const GMEM_FIXED = &H0
Private Const GMEM_MOVEABLE = &H2
Private Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Const S_OK = 0
Public Function PictureFromBits(abPic() As Byte) As IPicture ' not a StdPicture!!
Dim nLow As Long
Dim cbMem As Long
Dim lpMem As Long
Dim IID_IPicture As GUID
Dim istm As stdole.IUnknown ' IStream
Dim ipic As IPicture
On Error GoTo Out
nLow = LBound(abPic)
On Error GoTo 0
cbMem = (UBound(abPic) - nLow) + 1
lpMem = GlobalAlloc(0, cbMem)
MoveMemory ByVal lpMem, abPic(nLow), cbMem
CreateStreamOnHGlobal lpMem, 1, istm
CLSIDFromString StrPtr(sIID_IPicture), IID_IPicture
OleLoadPicture ByVal ObjPtr(istm), cbMem, 0, IID_IPicture, PictureFromBits
GlobalFree lpMem
Out:
End Function
Public Sub PictureToBits(ByVal oObj As StdPicture, aBytes() As Byte)
Dim oIPS As IPersistStream
Dim oStream As IStream, hGlobal As Long, lPtr As Long
Dim lSize As Long, Hdr As PictureHeader
Dim lRes As Long
Set oIPS = oObj
CreateStreamOnHGlobal 0, True, oStream
oIPS.Save oStream, True
GetHGlobalFromStream oStream, hGlobal
lSize = GlobalSize(hGlobal)
lPtr = GlobalLock(hGlobal)
lSize = lSize - Len(Hdr)
ReDim aBytes(0 To lSize - 1)
MoveMemory aBytes(0), ByVal lPtr + Len(Hdr), lSize
GlobalUnlock hGlobal
Set oStream = Nothing
End Sub
Public Sub WriteFile(path As String, r() As Byte)
Open path For Binary As #1
Put #1, , r
Close #1
End Sub
Private Sub Form_Load()
Dim x() As Byte
Dim pic As StdPicture
Set pic = Clipboard.GetData
PictureToBits pic, x
WriteFile "c:\1.bmp", x
End Sub
Antonariy писал(а):Совсем авторы обленились, даже гугльнуть в лом
Antonariy писал(а):Оптимизируй на здоровье:
Сейчас этот форум просматривают: AhrefsBot и гости: 28