Форум программистов, компьютерный форум, киберфорум
The trick
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск  

Обмен данными между своими прогами через WM_COPYDATA

Запись от The trick размещена 16.12.2013 в 19:22
Показов 3673 Комментарии 1
Метки basic, vb, winapi

Как в приложенном проекте, если запустить две копии приложения, можно устанавливать переменную mRadius в другом приложении.
Модуль:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Option Explicit
Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type
Private Const WM_COPYDATA = &H4A
Private Const GWL_WNDPROC& = (-4&)
 
Private Const SET_RADIUS = 1
 
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
 
Dim pPrevWndProc As Long, fndHwnd As Long, Disable As Boolean
 
Public Sub Hook(hwnd As Long)
    pPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHook(hwnd As Long)
    Call SetWindowLong(hwnd, GWL_WNDPROC, pPrevWndProc)
End Sub
Public Function SendRadius() As Boolean
    Dim CDRec As COPYDATASTRUCT, Value As Long
    If fndHwnd = 0 Then EnumWindows AddressOf EnumWnd, 0
    If fndHwnd Then
        Value = frmMain.Radius
        CDRec.dwData = SET_RADIUS
        CDRec.cbData = 4
        CDRec.lpData = VarPtr(Value)
        Disable = True
        SendMessageA fndHwnd, WM_COPYDATA, frmMain.hwnd, CDRec
        Disable = False
    End If
End Function
Private Function EnumWnd(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
    Dim Cap As String, L As Long
    L = GetWindowTextLength(hwnd)
    Cap = Space$(L)
    GetWindowText hwnd, Cap, L + 1
    If Cap = "Circle" And hwnd <> frmMain.hwnd Then fndHwnd = hwnd: Exit Function
    If hwnd = 0 Then Stop
    EnumWnd = True
End Function
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
    Case WM_COPYDATA
        Dim CDRec As COPYDATASTRUCT, Value As Long
        CopyMemory CDRec, ByVal lParam, LenB(CDRec)
        Select Case CDRec.dwData
        Case SET_RADIUS
            If CDRec.cbData <> 4 Or Disable Then Exit Function
            GetMem4 CDRec.lpData, VarPtr(Value)
            frmMain.Radius = Value
            frmMain.hsbRadius.Value = frmMain.Radius
            WindowProc = True
        End Select
    Case Else
        WindowProc = CallWindowProcA(pPrevWndProc, hwnd, uMsg, wParam, lParam)
    End Select
End Function
Форма:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Option Explicit
Dim mRadius As Long, fndHwnd As Long, Tmp As Boolean
 
Public Property Get Radius() As Long
    Radius = mRadius
End Property
Public Property Let Radius(ByVal Value As Long)
    If Value > 100 Then Value = 100
    If Value < 1 Then Value = 1
    Tmp = True
    mRadius = Value
    hsbRadius.Value = mRadius
    Me.Cls
    Me.Circle (Me.ScaleWidth / 2, Me.ScaleHeight / 2), mRadius
    Me.Refresh
    SendRadius
End Property
 
Private Sub Form_Load()
    Hook Me.hwnd
End Sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    UnHook Me.hwnd
End Sub
 
Private Sub hsbRadius_Change()
    If Not Tmp Then Me.Radius = hsbRadius.Value Else Tmp = False
End Sub
Private Sub hsbRadius_Scroll()
    Call hsbRadius_Change
End Sub
Метки basic, vb, winapi
Размещено в Без категории
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Всего комментариев 1
Комментарии
  1. Старый комментарий
    Аватар для HackerVlad
    Не знал про WM_COPYDATA, я придумывал свою из головы, WM_СВОЁЧТОУГОДНО и у меня работало фантазийное значение)
    Свою константу придумывал из головы помню, но я по моему делал WM_APP + своё выдуманное число
    Запись от HackerVlad размещена 17.01.2025 в 15:01 HackerVlad вне форума
 
Новые блоги и статьи
Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0.
Maks 31.08.2026
При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .
Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм
anaschu 30.08.2026
Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .
Оттачиваю умение писать js программы.
russiannick 30.08.2026
Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .
мат медиц модель 30. презентация проекта
anaschu 27.08.2026
хоп хоп хоп хидахоп, а я кладую))
Как у меня протекала болезнь
zorxor 27.08.2026
Здравствуйте, друзья! Эта запись блога предназначена именно для вас - для моих дорогих друзей, которые знали меня лично. Чтобы ответить на вопрос - а что же со мной произошло на самом деле? Я учился. . .
Нашел вот забавное видео о измерениях. Лучшее что я видел на эту тему
kumehtar 26.08.2026
ILETXiw9bMQ Основная суть и тезисы по измерениям: 0D (Нулевое измерение): точка, не имеющая длины, ширины, высоты или объема. Объект не может перемещаться в 0D. 1D (Первое измерение):. . .
[EasyBuilder Pro] Памятка по разработке для панелей Weintek
ФедосеевПавел 26.08.2026
Памятка по разработке для панелей Weintek ВВЕДЕНИЕ Ранее, при реализации проектов основное внимание уделял разработке управляющей программы для контроллера, а панели оператора доставалось время. . .
Модель по догадкам
anaschu 25.08.2026
Прошло две недели. Я уже рассказывал, как разговаривал с сотрудниками у сортировки и как понял, что главная ветка — не про приёмку, а про отбор. Но тогда я думал, что понял механику. На этой неделе я. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru