Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 | 2 | 3 |

 

  Вопрос: FindWindow Добавлено: 21.09.09 14:56  

Автор вопроса:  Winand | Web-сайт: winandfx.narod.ru

Ответить

  Ответы Всего ответов: 35  

Номер ответа: 16
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
 Web-сайт: winandfx.narod.ru
 Профиль | | #16
Добавлено: 21.09.09 21:50
А кто-то крутой ведь выкладывал правильный мультитрединг для VB6 на форуме) что-то такое было
Ну вот, я наконец осилил передачу сообщений между инстанциями. даже без проверки PrevInstance отлично работает.
  1. Option Explicit
  2. Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
  3. Private Const WM_COPYDATA As Long = &H4A
  4. Public Type COPYDATASTRUCT
  5.     dwData As Long
  6.     cbData As Long
  7.     lpData As Long
  8. End Type
  9. Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
  10. Private Type WNDCLASS
  11.     style As Long
  12.     lpfnwndproc As Long
  13.     cbClsextra As Long
  14.     cbWndExtra2 As Long
  15.     hInstance As Long
  16.     hIcon As Long
  17.     hCursor As Long
  18.     hbrBackground As Long
  19.     lpszMenuName As String
  20.     lpszClassName As String
  21. End Type
  22. Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  23. Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
  24. Private Declare Function RegisterClass Lib "user32.dll" Alias "RegisterClassA" (ByRef Class As WNDCLASS) As Long
  25. Private Declare Function UnregisterClass Lib "user32.dll" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
  26. Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  27. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
  28. Private Const WINDOW_CLASS As String = "Audica_Dummy"
  29. Private wnd As Long, dummy As Long, serverChecked As Boolean
  30.  
  31. Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  32.     If uMsg = WM_COPYDATA Then
  33.         Dim cds As COPYDATASTRUCT, str As String
  34.         Call CopyMemory(cds, ByVal lParam, Len(cds))
  35.         ReDim buf(cds.cbData - 1) As Byte
  36.         Call CopyMemory(buf(0), ByVal cds.lpData, cds.cbData)
  37.         str = buf 'StrConv(buf, vbUnicode)
  38.         Call gotMessageFromClient(str, wParam)
  39.     End If
  40.     WindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
  41. End Function
  42.  
  43. Private Function reg_class() As Long
  44.     Dim classinfo As WNDCLASS ' holds info about the class
  45.     classinfo.lpfnwndproc = PtrToFun(AddressOf WindowProc)
  46.     classinfo.hInstance = App.hInstance
  47.     classinfo.lpszClassName = WINDOW_CLASS
  48.     reg_class = RegisterClass(classinfo) ' receives an atom to new class
  49. End Function
  50.  
  51. Private Function unreg_class() As Long
  52.     unreg_class = UnregisterClass(WINDOW_CLASS, App.hInstance)
  53. End Function
  54.  
  55.  
  56. Private Function PtrToFun(ptr As Long) As Long
  57.     PtrToFun = ptr
  58. End Function
  59.  
  60. 'Если не найден сервер
  61. Public Function isClient() As Boolean
  62.     If Not serverChecked Then
  63.         wnd = FindWindow(ByVal WINDOW_CLASS, vbNullString)
  64.         serverChecked = True 'Флаг проверки
  65.     End If
  66.     isClient = wnd
  67. End Function
  68.  
  69. 'Стать сервером
  70. Public Sub becomeServer()
  71.     Call reg_class
  72.     dummy = CreateWindowEx(0, WINDOW_CLASS, vbNullString, 0, 0, 0, 0, 0, 0, 0, 0, ByVal 0)
  73. End Sub
  74.  
  75. 'Отправить строку серверу
  76. Public Sub sendStrToServer(ByVal str As String)
  77.     Dim dat As COPYDATASTRUCT
  78.     dat.cbData = LenB(str)
  79.     dat.lpData = StrPtr(str)
  80.     SendMessage wnd, WM_COPYDATA, 0, dat
  81. End Sub
  82.  
  83. 'Выключить сервер (если serverIsRunning = false)
  84. Public Sub destroyServer()
  85.     DestroyWindow dummy
  86.     unreg_class
  87. End Sub
  88.  
  89. 'Прием и обработка сообщений------------------------------------------------
  90. Private Sub gotMessageFromClient(ByVal str As String, Optional hwnd As Long)
  91.     Form1.Print Time, str 'Mid(str, i, 1) & " " & Asc(Mid(str, i, 1))
  92. End Sub '-------------------------------------------------------------------

  1. Option Explicit
  2.  
  3. Private Sub Command1_Click()
  4.     Cls
  5. End Sub
  6.  
  7. Private Sub Command2_Click()
  8.     If isClient Then _
  9.         sendStrToServer Text1.Text
  10. End Sub
  11.  
  12. Private Sub Form_Load()
  13.     If isClient Then
  14.         Caption = "Client"
  15.     Else
  16.         Caption = "Server"
  17.         Call becomeServer
  18.     End If
  19. End Sub
  20.  
  21. Private Sub Form_Unload(Cancel As Integer)
  22.     If Not isClient Then _
  23.         Call destroyServer
  24. End Sub

Ответить

Номер ответа: 17
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
 Профиль | | #17 Добавлено: 21.09.09 22:13
Както Артем в теме какогото нуба пристебался к мсвбвм60.длл, типа вот такая она жалкая, видишли нет никакого шанса ею попонтоваться, и по традиции вознес хвалу богу Дотнэту.
Я тогда прочитал, улыбнулся и промолчал, а щас вот вспомнил.
Фрэймворк по сути меганадстройка над АПИ, а мсвбвм тоже позволяет к нему обращаться и к КОМу тоже, так что ничтожность её возможностей весьма относительна.

Ответить

Номер ответа: 18
Автор ответа:
 Sharp


Лидер форума

ICQ: 216865379 

Вопросов: 106
Ответов: 9979
 Web-сайт: sharpc.livejournal.com
 Профиль | | #18
Добавлено: 21.09.09 22:24
фреймворк это еще сборщик мусора и машина для исполнения байткода :)

Ответить

Номер ответа: 19
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
 Профиль | | #19 Добавлено: 22.09.09 00:15
Winand пишет:
А кто-то крутой ведь выкладывал правильный мультитрединг для VB6 на форуме) что-то такое было

"кто-то крутой" - речь идет о пане Executioner?
Да, было такое, я даже лично видел как данный пример работает.
Я, собственно, и не отрицал возможность реализации многопоточности в VB6, я только упомянул о определенных сложностях, с которыми прийдется столкнуться, и которые смогут решить только несколько крутых.

Smith пишет:
Както Артем в теме какогото нуба пристебался к мсвбвм60.длл, типа вот такая она жалкая, видишли нет никакого шанса ею попонтоваться, и по традиции вознес хвалу богу Дотнэту.

пруфлинк

Smith пишет:
Фрэймворк по сути меганадстройка над АПИ

Только часть компонентов .NET Framework являются оболочкой над Win32API.
К примеру, Windows Forms, GDI, IO и часть системы криптографии практически полностью завязаны на Win32API.
В то же время, ASP .NET, ADO .NET, WCF, WWF, большая часть WPF, функции работы с XML практически полностью реализованы на управляемом коде и напрямую функции Win32API не используют.

а мсвбвм тоже позволяет к нему обращаться и к КОМу тоже, так что ничтожность её возможностей весьма относительна.

VB6 это не единственный (далеко не единсветнный и далеко не самый лучший) язык который имеет возможности работы с COM. .NET, например, также имеет возможности для работы с COM

VB6 не может использовать библитоеку классов .NET Framework, он может использовать (причем с существенными ограничениями) только управляемые сборки, которые скомпилированы с поддержкой COM.

Ответить

Номер ответа: 20
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
 Профиль | | #20 Добавлено: 22.09.09 05:36
VBD пишет:
PS: Топики про то, что COM устарел, VB6 г**но, дотнет рулит, простыни Бранда про правоту мелкомягких и т.п. весьма предсказуемы ))) И вообще, спорить не собираюсь, ибо жутко лень по 500 кругу спорить.

гг, сколько тут ясновидящих развелось!

VBD, официально заявляю что я 15 марта 2003 года в точности предвидел что ты напишешь этот пост под номером 14 в 21:01 по московскому времени. Информацию абсолютно достоверная, можешь мне верить, я гарантирую это!

Что скажешь? Кто теперь из нас весьма предсказуем?

Ответить

Номер ответа: 21
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
 Web-сайт: winandfx.narod.ru
 Профиль | | #21
Добавлено: 22.09.09 11:03
Это всё очень занимательно, всякие дотнетовские штуки и всё такое.
А до меня тут неожиданно дошло - на кой хрен я регистрирую класс окна, если могу просто дать ему уникальный заголовок) всё равно создаю новое окно. опять ТУПОТА напала

UPD. Хотя, стоп. Или мне надо обязательно регить класс, чтоб задать окну процедуру обработки событий?
  1. classinfo.lpfnwndproc = PtrToFun(AddressOf WindowProc)

Ответить

Номер ответа: 22
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
 Профиль | | #22 Добавлено: 22.09.09 14:28
Артем, я шучу вообщето, но упомянутый мной пост действительно существует если ты ещё не удалил его, видимо их так много, что ты неспособен запомнить каждый.
Думаю никто тут не оспаривает тот факт, что современная студия несравнимо богаче в возможностях чем вб6.
И надеюсь никто не хочет меня убедить, что для написания миниатюрной консольной утилитки я обязан был использовать фрэймворк только потому, что он содержит только управляемый код и ещё кучу божественых чудес :)

Ответить

Номер ответа: 23
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
 Профиль | | #23 Добавлено: 22.09.09 15:30
Smith пишет:
Артем, я шучу вообщето, но упомянутый мной пост действительно существует если ты ещё не удалил его, видимо их так много, что ты неспособен запомнить каждый.

Сделать это действительно сложно, потому что очень многие посты слишком часто дублируются, некоторые бесследно исчезают до того как я их прочитаю, а некоторые прямо противоречат друг другу (например как этот и предыдущий - "что ты способен запомнить каждый" vs "что ты неспособен запомнить каждый"

Думаю никто тут не оспаривает тот факт, что современная студия несравнимо богаче в возможностях чем вб6.

К сожалению, реальность с тобой не совсем согласна.

И надеюсь никто не хочет меня убедить, что для написания миниатюрной консольной утилитки я обязан был использовать фрэймворк только потому, что он содержит только управляемый код и ещё кучу божественых чудес :)

Для консольной утилитки есть смысл использовать .NET хотя бы потому что в нем есть встроенная поддержка консоли (а не через разных чуваков, которые все-таки научились это делать)

Ответить

Номер ответа: 24
Автор ответа:
 VβÐUηìt



Вопросов: 246
Ответов: 3333
 Web-сайт: смекаешь.рф
 Профиль | | #24
Добавлено: 22.09.09 15:42
Лучше на VB6 уметь делать все, чем на .NET кусочек этого.

PS. Злостная провокация в адрес дотнечиков.

Ответить

Номер ответа: 25
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
 Web-сайт: winandfx.narod.ru
 Профиль | | #25
Добавлено: 22.09.09 16:04
<Вырезанные оскорбления в адрес каждого писавшего в данной теме>
>я обязан был использовать фрэймворк
Никто ничего не обязан. То есть если я скажу ".NET не нужен", это ни на что не повлияет.

Ответить

Номер ответа: 26
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
 Web-сайт: winandfx.narod.ru
 Профиль | | #26
Добавлено: 22.09.09 17:55
Дубль два. Без регистрации класса.
  1. Option Explicit
  2. Public WithEvents interact As Interaction
  3.  
  4. Private Sub Command2_Click()
  5.     If interact.isClient Then _
  6.         interact.sendData Text1.Text
  7. End Sub
  8.  
  9. Private Sub Form_Load()
  10.     Set interact = New Interaction
  11.     Caption = IIf(interact.isClient, "Client", "Server")
  12.     If interact.isClient Then interact.sendWnd = hwnd
  13. End Sub
  14.  
  15. Private Sub interact_dataArrived(ByVal data As String)
  16.     Print Time, data
  17. End Sub
  1. Option Explicit
  2. Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  3. Private Const WM_COPYDATA As Long = &H4A
  4.  
  5. Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  6.   Debug.Print uMsg
  7.     If uMsg = WM_COPYDATA Then _
  8.         Form1.interact.PostWindowProc hwnd, uMsg, wParam, lParam
  9.     WindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
  10. End Function
  1. Option Explicit
  2. Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
  3. Private Const WM_COPYDATA As Long = &H4A
  4. Private Type COPYDATASTRUCT
  5.     dwData As Long
  6.     cbData As Long
  7.     lpData As Long
  8. End Type
  9. Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
  10. Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  11. Private Const GWL_WNDPROC As Long = -4
  12. Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  13. Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
  14. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
  15. Private wnd As Long, dummy As Long, serverChecked As Boolean
  16.  
  17. Event dataArrived(ByVal data As String)
  18. Private Const WINDOW_NAME As String = "Audica_Dummy"
  19. Public sendWnd As Long '&#213;&#229;&#237;&#228;&#235; &#238;&#234;&#237;&#224;, &#232;&#231; &#234;&#238;&#242;&#238;&#240;&#238;&#227;&#238; &#238;&#242;&#241;&#251;&#235;&#224;&#229;&#242;&#241;&#255; &#241;&#238;&#238;&#225;&#249;&#229;&#237;&#232;&#229; (&#237;&#229; &#238;&#225;&#255;&#231;&#224;&#242;&#229;&#235;&#252;&#237;&#238;)
  20.  
  21. '&#197;&#241;&#235;&#232; &#237;&#229; &#237;&#224;&#233;&#228;&#229;&#237; &#241;&#229;&#240;&#226;&#229;&#240;
  22. Public Function isClient() As Boolean
  23.     If Not serverChecked Then
  24.         wnd = FindWindow(vbNullString, WINDOW_NAME)
  25.         serverChecked = True '&#212;&#235;&#224;&#227; &#239;&#240;&#238;&#226;&#229;&#240;&#234;&#232;
  26.     End If
  27.     isClient = wnd
  28. End Function
  29.  
  30. '&#209;&#242;&#224;&#242;&#252; &#241;&#229;&#240;&#226;&#229;&#240;&#238;&#236;
  31. Private Sub becomeServer()
  32.     dummy = CreateWindowEx(0, "STATIC", WINDOW_NAME, 0, 0, 0, 0, 0, 0, 0, 0, ByVal 0)
  33.     SetWindowLong dummy, GWL_WNDPROC, AddressOf WindowProc
  34. End Sub
  35.  
  36. '&#206;&#242;&#239;&#240;&#224;&#226;&#232;&#242;&#252; &#241;&#242;&#240;&#238;&#234;&#243; &#241;&#229;&#240;&#226;&#229;&#240;&#243;
  37. Public Sub sendData(ByVal str As String)
  38.     Dim dat As COPYDATASTRUCT
  39.     dat.cbData = LenB(str)
  40.     dat.lpData = StrPtr(str)
  41.     SendMessage wnd, WM_COPYDATA, sendWnd, dat
  42. End Sub
  43.  
  44. '&#194;&#251;&#234;&#235;&#254;&#247;&#232;&#242;&#252; &#241;&#229;&#240;&#226;&#229;&#240; (&#229;&#241;&#235;&#232; isClient = false)
  45. Private Sub destroyServer()
  46.     DestroyWindow dummy
  47. End Sub
  48.  
  49. Public Sub PostWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
  50.     Dim cds As COPYDATASTRUCT
  51.     Call CopyMemory(cds, ByVal lParam, Len(cds))
  52.     ReDim buf(cds.cbData - 1) As Byte
  53.     Call CopyMemory(buf(0), ByVal cds.lpData, cds.cbData)
  54.     RaiseEvent dataArrived(buf)
  55. End Sub
  56.  
  57. Private Sub Class_Initialize()
  58.     If Not isClient Then _
  59.         Call becomeServer
  60. End Sub
  61.  
  62. Private Sub Class_Terminate()
  63.     If Not isClient Then _
  64.         Call destroyServer
  65. End Sub

Ответить

Номер ответа: 27
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
 Профиль | | #27 Добавлено: 22.09.09 18:37
Очередное мегаразоблачение от великого мастера разоблачений Артема :)?
Назнач фильтр на почте и не смеши людей.
Объясняю, первый пост содержал опечатку очевидную любому вменяемому человеку, это понятно по общему смыслу предложения.
Ну так и быть делаю скидку ведь русский язык для тебя иностранный и посты действительно бывало противоречили один другому.
И ещё, если ктото умеет писать консольные проги, а ты нет, то не стоит цепляться к нему и прятаться за Чуваков из мс, лучше просто промолчать.
Winаnd извини за оффтоп, ты какбудто никак не выберешь способ, попробую сварганить своё решение, думаю ближе к ночи покажу вариант.

Ответить

Номер ответа: 28
Автор ответа:
 Artyom



Разработчик

Вопросов: 130
Ответов: 6602
 Профиль | | #28 Добавлено: 22.09.09 19:36
Smith пишет:
И ещё, если ктото умеет писать консольные проги, а ты нет, то не стоит цепляться к нему и прятаться за Чуваков из мс, лучше просто промолчать.

Ну и кто тебе сказал что я не умею писать консольные проги? Поспрашивай ради интереса у знакомых дотнетчиков что они думают о Console Application

Ответить

Номер ответа: 29
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
 Web-сайт: winandfx.narod.ru
 Профиль | | #29
Добавлено: 22.09.09 19:36
Smith, да я так подумал, что второй способ наилучший. По сути то же, что ты мне советовал, только hwnd не пишется в файл первым инстансом, а ищется вторым инстансом по заголовку окна.

Ответить

Номер ответа: 30
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
 Профиль | | #30 Добавлено: 22.09.09 21:28
Ну тогда я сочинять небуду, :) файл это на вскидку для примера было сказано, понятно что не то.
В твой код я не вчитывался, но кажется какойто он громоздкий.
Ну главное чтоб с работой справлялся, ты проверял? Сколько файлов открывал проводником?

Ответить

Страница: 1 | 2 | 3 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам