Посылка сообщений в чужой процесс

[tyomitch]

Хотел написать Кирпич, но чего-то он получился очень сырой. Выложу пока тут

Суть: мессаги больше WM_USER - а именно такие используют, например, все Common Controls - по умолчанию не маршалятся, т.е. передаваемый в них указатель должен указывать на данные в АП получателя. Значит, надо как-то внедрять туда свой участок памяти и передавать указатель на него.

Эта техника не нова, она использовалась Оловянниковым в его примере "Who lives in my system tray" (правда, он у меня так и не заработал ни на одной Винде) и мной в теме "Расширить часики в трее". Здесь я хотел построить реюзабельный компонент для этого дела, чтобы не изобретать велосипед каждый раз.

Структура компонента: 2 файла - modMarshal.bas и cMarshal.cls
CreateMarshal создаёт по hWnd маршалер (объект cMarshal) заданного размера (по умолчанию - 1024 байта).
cMarshal::MarshalInto передаёт данные в процесс получателя
cMarshal::MarshalFrom получает данные из процесса получателя

Объект cMarshal при своём уничтожении сам закроет все хэндлы, об этом заботиться не надо.

Совместимость: проверено на Win2000, скорее всего будет работать в WinNT4+
Если кому-то не лень приделать поддержку Win9x, милости прошу

[приложение удалено]

[hCORe]

VarPtrByVal - Sub Or Function Not Defined

[alibek]

Да, работает зашибись
Только для кирпичей их следует отсоединять от других кирпичей
hCORe, замени на VarPtr и пойдет.


Только пример отказался у меня понимать функцию Left$(), это локальный глюк или последствия вмешательства?

[alibek]

Если бы ты еще к нему добавил надежный алгоритм нахождения координат значка в трее, тебе бы цены не было

[hCORe]

hCORe, замени на VarPtr и пойдет

DILLAF? (расшифруй сам ) На VarPtr я заменял. При этом программа загружается, но работает неправильно. Пишет, что в трее 0 значков, а в "Быстром запуске" - пять и все с надписью "Запустить оборзеватель Internet Explorer"

[alibek]

А система какая? У меня все правильно показывал.
И под каким аккаунтом ты логинишься, админским или обычным?

[tyomitch]

Прежде всего, всем спасибо за тестирование

VapPtrByVal у меня объявлена отдельно следующим образом:

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

Public Declare Function VarPtrByVal Lib "msvbvm60" Alias "VarPtr" (Data As Any) As Long

, как-то забыл приложить её к проекту

Про Left не понял. Что значит - "отказался понимать"?

Ещё всех прошу указывать систему, где проверяете.

[tyomitch]

Да, кирпич действительно сырой... На WinXP не работал совсем

Вот обновлённая версия:

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

Option Explicit
Private Type TBBUTTON
   iBitmap As Long
   idCommand As Long
   fsState As Byte
   fsStyle As Byte
   bReserved1 As Byte
   bReserved2 As Byte
   dwData As Long
   iString As Long
End Type
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem 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 FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Const TB_GETBUTTONTEXT = &H400& + 75&
Private Const TB_BUTTONCOUNT = &H400& + 24&
Private Const TB_GETBUTTON = &H400& + 23&
Private Const TBSTATE_HIDDEN = &H8

Private Sub Form_Load()
Dim hWnd As Long, n As Long, hWndPager As Long
    hWnd = GetDlgItem(FindWindow("Shell_TrayWnd", vbNullString), &H12F)
    hWndPager = FindWindowEx(hWnd, 0, "SysPager", vbNullString): If hWndPager = 0 Then hWndPager = hWnd
    hWnd = FindWindowEx(hWndPager, 0, "ToolbarWindow32", vbNullString)
    n = SendMessage(hWnd, TB_BUTTONCOUNT, 0, 0)
    Print "Â òðåå îáíàðóæåíî " & n & " èêîíîê."
    DumpToolbar hWnd, n

    hWnd = FindWindowEx(FindWindowEx(FindWindow("Shell_TrayWnd", vbNullString), 0, "ReBarWindow32", vbNullString), 0, "ToolbarWindow32", vbNullString)
    n = SendMessage(hWnd, TB_BUTTONCOUNT, 0, 0)
    Print "Â ïàíåëè áûñòðîãî çàïóñêà îáíàðóæåíî " & n & " èêîíîê."
    DumpToolbar hWnd, n
End Sub

Private Sub DumpToolbar(ByVal hWnd As Long, ByVal n As Long)
Dim i As Long, Caption As String
Dim m As cMarshal: Set m = CreateMarshal(hWnd)
Dim tb As TBBUTTON
    For i = 0 To n - 1
    With m
        .MarshalInto VarPtr(tb), Len(tb)
        SendMessage hWnd, TB_GETBUTTON, i, .rpMarshal
        .MarshalFrom VarPtr(tb), Len(tb)
        If tb.iString <> -1 Then
            Caption = Space(256)
            .MarshalInto StrPtr(Caption), 256
            n = SendMessage(hWnd, TB_GETBUTTONTEXT, tb.idCommand, .rpMarshal)
            .MarshalFrom StrPtr(Caption), 256
            Print Left(Caption, n)
        End If
    End With
    Next
    Print
End Sub


Ссылок на VarPtrByVal больше нет.

[alibek]

"Отказывается понять" означает что VB не знает такую функцию. Видимо забыл из-за шоковой терапии, которая пишет в процессы.

P.S. А зачем тебе VarPtrByVal? Ведь VarPtr понимает и UDT?

[alibek]

P.P.S. Сорри, обманул я. Left$() глючит из-за того, что n=-1.

[alibek]

3P.S. У меня второй вариант работает замечательно. Думаю, своровать у тебя кое-что

[tyomitch]

VarPtrByVal у меня оставался от других частей проекта. Эти два модуля вырваны из большого-большого проекта. Там он был нужен

Раз теперь всё работает, может мне перекинуть прогу в Кирпичи?

[tyomitch]

Если бы ты еще к нему добавил надежный алгоритм нахождения координат значка в трее, тебе бы цены не было

Оценивай

[A.A.Z.]

Пришел Я Увидел незнакомую тему, открыл, прокрутил вниз Смотрю - пример от Тёмыча, 0 скачек! Непорядок Скачал, посмотрел... Да это же то, что мне сейчас нужно!!! Пасиба!

[GSerg]

Блин, как невовремя сетка порвалась

Ща, заценим и будем критиковать

[alibek]

Оценивай

Рулез!
Респект!

[tyomitch]

Совместимость с Win9x приделал, но там отдельная проблема: в Win98 трей - не тулбар

Сейчас перепишу демо-пример на Быстрый Запуск, и выложу в Кирпичах.