Это почему это?TimVTimV писал(а):а вот вызвать форму из полученной длл нельзя!
Если руки кривые, то ни в чем.TimVTimV писал(а):Смысл всей этой поделки в чём?
Модератор: BV
Это почему это?TimVTimV писал(а):а вот вызвать форму из полученной длл нельзя!
Если руки кривые, то ни в чем.TimVTimV писал(а):Смысл всей этой поделки в чём?
arthur2 писал(а):Это почему это?
arthur2 писал(а):Значит, чтобы форма не выгрузилась, при её показе нужно просто запустить бесконечный цикл, а при закрытии цикл прерывать. Всё.
Отчего?библиотека выгрузится
Это стандартный метод. Просто нужен не бессмысленный цикл, а GetMessage->(TranslateMessage)->DispatchMessage. Это же самое происходит и в экзешнике при показе экземпляра формы, просто остается за кулисами. А здесь за нас никто цикл обработки сообщений не запустит - нужно запускать самим.Qwertiy писал(а):Это очень подозрительный метод.
Мы вообще не можем вернуться в вызывающее приложение, если форма ещё жива, хоть модальная, хоть не модальная. Чем лучше? Да ни чем не лучше. А отличаться будет только тем, что форма не будет блокировать другие окна в программе.Qwertiy писал(а):Вероятно, за жизнь формы в таком случае должо отвечать вызывающее приложение, нет?
И чем вообще вечный цикл лучше модального показа?
Вот и я о нем же - о цикле обработки сообщений. В потоке-то он есть, а вот в вызываемой библиотеке он откуда возьмется, если его самому не написать?Кривоус Анатолий писал(а):Если в потоке, в котором вызывается форма, есть процедура обработки сообщений
Оттого, что код процедуры, в которой показывается форма, закончился.Кривоус Анатолий писал(а):Отчего?
public sub test()
form1.show
'и стразу же:
end sub
arthur2 писал(а):Мы вообще не можем вернуться в вызывающее приложение, если форма ещё жива, хоть модальная, хоть не модальная. Чем лучше? Да ни чем не лучше. А отличаться будет только тем, что форма не будет блокировать другие окна в программе.
Ну это понятно, но библиотека не выгружается после этого.После чего мы возвращаемся в вызывающую программу.
Что-то я тебя не пойму. Для каждого потока - своя очередь сообщений. Если экспортируемая функция вызывается из потока в котором есть цикл обработки сообщений, то, если окно внутри функции создается в этом же потоке, то DispatchMessage из вызывающего отправит нужные сообщения этому окну, и все должно работать.В потоке-то он есть, а вот в вызываемой библиотеке он откуда возьмется, если его самому не написать?
Ну так я и не претендую на то, что всё именно так Дождемся ХакераQwertiy писал(а):Что-то тут не так...
Я и не сказал, что выгружается. Я сказал, "я так полагаю" Собственно, сейчас проверил - немодальная форма вполне показывается вообще без ухищрений.Кривоус Анатолий писал(а):Ну это понятно, но библиотека не выгружается после этого.
Qwertiy писал(а):Но вообще, я тут реакцию Хакера на это утверждение ждал, а он что-то молчит...
arthur2 писал(а):Это стандартный метод. Просто нужен не бессмысленный цикл, а GetMessage->(TranslateMessage)->DispatchMessage. Это же самое происходит и в экзешнике при показе экземпляра формы, просто остается за кулисами. А здесь за нас никто цикл обработки сообщений не запустит - нужно запускать самим.
Ну да, возврат в вызывающую программу произойдет только после того, как окно закроется. Но это, по-моему, нормально и вполне логично, так и планировалось. Собственно, ведь показ модального окна в бейсике этим способом организован? или нет? Говорю же, отличие от модальной формы будет только в том, что останутся доступны другие окна программы.Хакер писал(а):В твоём решении с циклом становится непонятно, когда такой вторичный цикл должен завершиться? Если при закрытии окна, то значит возврат к вызывающей стороне произойдёт только после закрытия окна. Что вряд ли является тем, что хочет рядовой писатель вызывающей стороны. Так что нет.
arthur2 писал(а):это ведь значит то, что я предположил? что библиотека-таки выгружается, выгрузив за собой попутно все свои существующие экземпляры классов?
arthur2 писал(а):Но это, по-моему, нормально и вполне логично, так и планировалось.
arthur2 писал(а):Собственно, ведь показ модального окна в бейсике этим способом организован? или нет?
arthur2 писал(а):В любом случае - если экземпляр формы создается, но по какой-то независящей от нас причине сразу выгружается - мой способ, по-моему, единственно возможный, чтобы форму удержать.
Option Explicit
'
'Необходимые элементы и информация взяты из этого сайта
'http://bbs.vbstreets.ru/viewtopic.php?f=15&t=34902&start=0&sid=87e484977a0dfc6f7acc19c4b03a668b
'Правообладателем и автором болшей части текста является администратор этого сайта под ником
'© Хакер (Конференция VBStreets)
'и моя скромная модификация
'© FelixMacintosh (CiberForum.ru) ,2014
'
'Точка входа в библиотеку.
'
Private Const DLL_PROCESS_ATTACH As Long = 1
Private Const DLL_PROCESS_DETACH As Long = 0
Private Const DLL_THREAD_ATTACH As Long = 2
Private Const DLL_THREAD_DETACH As Long = 3
Public Function DllEntryPoint(ByVal.............
FelixMacintosh писал(а):да ерунда это всё, это вообще была личная переписка, которую вы выложили на картинке
FelixMacintosh писал(а):я там еще одно приложение выложил
Содержимое сайта является интеллектуальной собственностью. Материалы сайта не подлежат распространению без согласования с авторами. (с) "Первые шаги", 1999-2012
FelixMacintosh писал(а):Сейчас меня забанили, на том форуме
Option Explicit
'
' © Антихакер32™ Нативная DLL создаваемая по необходимости +Стильная иконка
' И пример использования модуля SubClass
' P.S Ничего устанавливать не нужно, требуется пустая форма
'
Const HTCAPTION = 2
Const WM_MOVE = &H3
Const WM_SIZE = &H5
Const WM_LBUTTONDOWN = &H201
Const WM_NCLBUTTONDOWN = &HA1
Dim WithEvents tx1 As TextBox
Dim WithEvents cm1 As CommandButton
Dim WithEvents cm2 As CommandButton
Private Declare Function Hooks Lib "MHook.dll" () As Object
'Экспортируемые функции
'Function AddChildHook(Child As Object, ByVal ParentProcName$, ByVal Message&) As Long
' 'Добавление хука для отлова сообщений от дочернего контрола
' 'Арг: Дочерний объект// вызываемое имя отцовой процедуры // сообщения окна
' '
'Function AddParentHook(Child As Object, ByVal ChildProcName$, ByVal Message&) As Long
' 'Добавление хука для отлова сообщений от родительского окна
' 'Арг: Дочерний объект// вызываемое имя дочерней процедуры // сообщения окна
' '
'Function AddHook(Obj As Object, ByVal ProcName$, ByVal Message&) As Long
' 'Добавление хука для отлова сообщений от указанного окна
' 'Арг: Объект// вызываемое имя процедуры // сообщения окна
' '
'Function CloseHook(ByVal hwnd&) As Long
' 'Закрывает все хуки связанные с этим окном
' 'После этого можно останавливать программу
' '
'Function CloseAllHooks() As Long
' 'Закрывает все ранее открытые хуки, и возвращает их число
'
Dim h&, h1&
Dim mHooks As Object
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef IpdwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'
Function CheckFiles(ByVal ZipUrl$, ByVal Folder$, ParamArray ParseNames()) As Long
'Проверяет наличие файлов, указанных в аргументах ParseNames
'И при необходимости докачивает их в указанную папку Folder
'Если папка не указанна, то отсутствующие файлы будут скопированны в текущую папку
'© Антихакер32™ ...2014
'
Const Promt0 = "Отсутствуют необходимые компоненты" & vbCrLf
Const Promt1 = Promt0 & "Отсутствует соединение с интернетом, для того чтоб их скачать"
Const Promt2 = Promt0 & "Указанный URL не является ZIP-папкой с компонентами"
Const Promt3 = Promt0 & "URL Zip-папки, не указан"
Dim vEach, OldDir$, ArcName$, f&, zExists As Boolean, s$, i&, b() As Byte
Dim ShellApp As Object, Fso As Object, Zip As Object
Set Fso = CreateObject("Scripting.FileSystemObject"): OldDir = CurDir$
If Fso.FolderExists(Folder) Then ChDir Folder Else Folder = OldDir
For Each vEach In ParseNames
If Fso.FileExists(vEach) Or Fso.FolderExists(vEach) Then
CheckFiles = CheckFiles + 1: GoTo NextEach
ElseIf Len(ZipUrl) Then On Error Resume Next
If Not zExists Then 'Обращение к интернету и закачка необходимых файлов
If InternetGetConnectedState(0&, 0&) = 0 Then MsgBox Promt1, vbInformation: End
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", ZipUrl, False '--или--.Open "GET", ZipUrl, False, Имя, Пароль
.send: s = LCase(Split(.getResponseHeader("Content-Type"), "/")(1))
If s <> "zip" Then MsgBox Promt2, vbInformation: End
ArcName = .getResponseHeader("Content-disposition")
b = .responseBody: .abort 'Завершить соединение
End With
i = InStr(1, ArcName, "filename=") + 10: ArcName = Mid$(ArcName, i, Len(ArcName) - i)
f = FreeFile: Open ArcName For Binary As #f: Put #f, 1, b: Close #f 'Копирование байт
Set ShellApp = CreateObject("Shell.Application")
Set Zip = ShellApp.NameSpace(Fso.GetAbsolutePathName(ArcName))
End If: 'On Error GoTo 0
If Zip.ParseName((vEach)) Is Nothing Then GoTo NextEach
ShellApp.NameSpace((Folder)).CopyHere Zip.ParseName((vEach))
f = FreeFile: Open CStr(vEach) For Binary As #f: ReDim b(LOF(f) - 1)
Do: DoEvents: s = b: Get #f, 1, b: Sleep 100: Loop While s <> CStr(b) 'пока есть разница данных
Close #f: CheckFiles = CheckFiles + 1 'Файл из архива успешно скопирован, переход к следующему файлу
Else: MsgBox Promt3, vbInformation: End
End If
NextEach:
Next: If Folder <> OldDir Then ChDir OldDir 'Если папка была изменена, то возврат в прежнюю папку
If Len(ArcName) Then Kill ArcName
End Function
Private Sub Form_Load()
Dim c(1) As CommandButton, f&
Call CheckFiles( _
"http://www.cyberforum.ru/blog_attachment.php?attachmentid=2468&d=1402890085" _
, "", "MHook.dll", "PlasticFantastic Icon 13.ico")
'-------------------------------------------------------------
Me.Icon = LoadPicture("PlasticFantastic Icon 13.ico")
Set mHooks = Hooks 'Загружаем класс
Set tx1 = Controls.Add("vb.TextBox", "tx1")
tx1.Move 100, 100, 4000, 500: tx1.Text = "Сдвинь меня !, и посмотри на стильную иконку"
tx1.Visible = 1
Set c(0) = Controls.Add("vb.CommandButton", "cm1")
Set c(1) = Controls.Add("vb.CommandButton", "cm2")
For f = 0 To 1: c(f).Move 100, 100 + (500 * f), 1500, 500
c(f).Visible = 1: c(f).Caption = Choose(f + 1, "Закрыть хук", "Активировать хук")
Next
Set cm1 = c(0): Set cm2 = c(1)
h1 = mHooks.AddHook(Me, "WMove", WM_MOVE)
End Sub
Private Sub cm2_Click()
h1 = mHooks.AddChildHook(tx1, "TXMove", WM_LBUTTONDOWN)
End Sub
Private Sub cm1_Click()
mHooks.CloseHook h1
End Sub
Public Function WMove(ParamArray Arg())
Debug.Print Me.Left, Me.Top
End Function
Public Function TXMove(ParamArray Arg())
Arg(2) = WM_NCLBUTTONDOWN
Arg(3) = HTCAPTION
TXMove = 1
End Function
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 30