Remote Administrator своими руками"

[Antonariy]

В stg нет никакой начинки, только описание интерфейса IStream. Весь функционал у тебя перед глазами. Таскать ее после компиляции не надо.

Пилите, Шура, пилите.

[tyomitch]

Сложно что то сделать когда вся начинка хранится в STG.tlb...

Там только объявления.

За скомпилированной прогой его таскать не нужно.

Только ты всё равно в тупик идёшь.

[Lumen]

А ведь в JPEG можно конвертнуть используя GDI+. В FAQ есть пример

[CodeName33]

Хочу сделать скришот, загнать его в масив типа Byte (пока незнаю как), и при помощи фунции OleLoadPicture(уже умею делать) распаковать обратно из массива.

Гнать по сети скриншоты -- тупик.
Их никогда не удастся упаковать даже близко так же плотно, как GDI-команды.

Я, в своё время, использовал формат LDF (это что-то близое к DjVu). Скриншот получался килобайт на 30-40 и текст на нём был прекрасно читаем, но всё это не бесплатно...

[sosed213]

Только ты всё равно в тупик идёшь.

И почему в меня никто никогда не верит?! Наверное с первого взгляда невнушаю доверия! Но не в далёком скором я надеюсь вас удевить!

[Antonariy]

Дело не в доверии, а в том, что мы этот путь так или иначе прошли до конца, постучались разными частями тела в глухую стену и пошли обратно, предупреждая встречных, что там делать нечего. Люди, которым жалко своего времени, сразу поворачивают вспять, остальные прутся дальше, чтобы в лучшем случае нацарапать в тупике "Здесь был Вася".

Однако отрицательный опыт - тоже опыт. Успехов на обратном пути.

[sosed213]

Стена твёрдая не спорю! Но если каждый начнет отковыривать по кирпичику то стена станет кучкой мусора позади наших путей!

В идеале должно быть так:

Код: Выделить всё


Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
Private Declare Function IsEqualGUID Lib "ole32" (rguid1 As GUID, rguid2 As GUID) As Boolean

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long

'Private Const GMEM_FIXED = &H0
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) 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 Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As GUID, ppvObj As Any) As Long

Public Function PictureFromBits(abPic() As Byte) As IPicture  ' not a StdPicture!!
    Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
    Const S_OK = 0     ' indicates successful HRESULT
   
    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
   
    ' Get the size of the picture's bits
    On Error GoTo Out
    nLow = LBound(abPic)
    On Error GoTo 0
    cbMem = (UBound(abPic) - nLow) + 1
 
    ' Allocate a global memory object
    lpMem = GlobalAlloc(0, cbMem)
    If lpMem Then
            ' Copy the picture bits to the memory pointer
            MoveMemory ByVal lpMem, abPic(nLow), cbMem
            ' Create an ISteam from the pictures bits (we can explicitly free hMem
            ' below, but we'll have the call do it here...)
            If (CreateStreamOnHGlobal(lpMem, 1, istm) = S_OK) Then
                If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then
                    ' Create an IPicture from the IStream (the docs say the call does not
                    ' AddRef its last param, but it looks like the reference counts are correct..)
                    OleLoadPicture ByVal ObjPtr(istm), cbMem, 0, IID_IPicture, PictureFromBits
                End If   ' CLSIDFromString
            End If   ' CreateStreamOnHGlobal
    End If   ' lpMem
    GlobalFree lpMem
   
Out:
End Function




Private Sub Command1_Click()

  Dim bByte() as Byte
  Dim x as Integer

  Call ScreenShootToArray (bByte(), x)
 
  'Сделать скриншот и зжав его загнать в массив
  'X - степень сжатия (типо 4, 8, 16, 24 и 32 бита)
  '

  Picture1.Picture = PictureFromBits(TheBytes())

End Sub


На писать отдельный модуль с основной функцией ScreenShootToArray.

[sosed213]

Не теряйте меня! Я в поте лица тружусь над кодом! О результатах ещё рано сообщать!

[Хакер]

sosed213
Ты похож на строителя вечного двигателя. Который тоже пробивает стену.

[Antonariy]

- Доктор, мы его теряем!!!
- Без паники!! Дифибриллятор! Разряд!
БДЫЩЩЩ!
- Доктор, я в него потыкала, он не шевелится!..
- Эээ, извините, что отрываю, друзья и роственники справляются о результатах...
- Кто впустил? Еще рано что либо сообщать! Вы что, не видите, я тружусь в поте лица? Сестра, дайте спирт. Себе тоже.
- Ик.. Дифибрллятр?
- Нне, мне не надо. Ааа! Ну да.
БДЫЩЩЩ!

Который тоже пробивает стену.

И не знает, что стена эта - часть скального массива Гималаев.

[Viper]

sosed213, дабы не долбиться в стену вернись сюда и прочитай заново оттуда и до обеда (наличие бубна в руках и пялски вокруг горящего костра, равно ак и настой из мухоморов необязательны).

[|kerish|]

Всё, автор дошел до стены