VBNet - Форум - TerminateThread

Вопрос: TerminateThread Добавлено: 02.09.08 12:34

Автор вопроса: ZoomerSD | ICQ: 148640473

Добрый день!
Для создания потоков в своей программе я использую модуль, найденный в одной из статей в интернете:

'clsThreading:
'Simple class that allows you to implement multithreading in your app
'
'(C) 2001 by Philipp Weidmann

'API Declarations
'Creates a new thread
Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
'Terminates a thread
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
'Sets the priority of a thread
Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
'Returns the proirity of a thread
Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
'Enables a disabled Thread
Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
'Disables a thread
Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long
'Returns the handle of the current thread
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
'Returns the ID of the current thread
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'Consts
Private Const MAXLONG = &H7FFFFFFF

'Thread priority consts
Private Const THREAD_BASE_PRIORITY_IDLE = -15
Private Const THREAD_BASE_PRIORITY_LOWRT = 15
Private Const THREAD_BASE_PRIORITY_MAX = 2
Private Const THREAD_BASE_PRIORITY_MIN = -2
Private Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX
Private Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN
Private Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1)
Private Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1)
Private Const THREAD_PRIORITY_ERROR_RETURN = (MAXLONG)
Private Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE
Private Const THREAD_PRIORITY_NORMAL = 0
Private Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT

'Thread creation flags
Private Const CREATE_ALWAYS = 2
Private Const CREATE_NEW = 1
Private Const CREATE_NEW_CONSOLE = &H10
Private Const CREATE_NEW_PROCESS_GROUP = &H200
Private Const CREATE_NO_WINDOW = &H8000000
Private Const CREATE_PROCESS_DEBUG_EVENT = 3
Private Const CREATE_SUSPENDED = &H4
Private Const CREATE_THREAD_DEBUG_EVENT = 2

'Types and Enums
Public Enum ThreadPriority
    tpLowest = THREAD_PRIORITY_LOWEST
    tpBelowNormal = THREAD_PRIORITY_BELOW_NORMAL
    tpNormal = THREAD_PRIORITY_NORMAL
    tpAboveNormal = THREAD_PRIORITY_ABOVE_NORMAL
    tpHighest = THREAD_PRIORITY_HIGHEST
End Enum

'Vars
Private mThreadHandle As Long
Private mThreadID As Long
Private mPriority As Long
Private mEnabled As Boolean

Public Function CreateNewThread(ByVal cFunction As Long, Optional ByVal cPriority As ThreadPriority = tpNormal, Optional ByVal cEnabled As Boolean = True)
    'Creates a new Thread
    Dim mHandle As Long
    Dim CreationFlags As Long
    Dim lpThreadID As Long

    'Look if the thread should be enabled
    If cEnabled = True Then
        CreationFlags = 0
    Else
        'Create a disabled thread, can be enabled later with the
        ''Enabled' property
        CreationFlags = CREATE_SUSPENDED
    End If

    'The CreateThread Function returns the handle of the created thread;
    'if the handle is 0, it failed creating the thread
    mHandle = CreateThread(ByVal 0&, ByVal 0&, cFunction, ByVal 0&, CreationFlags, lpThreadID)

    If mHandle = 0 Then 'Failed creating the thread
        'Insert your own error handling
        'Debug.Print "InitializeThread Function in clsThreading failed creating a new thread"
    Else
        mThreadHandle = mHandle
        mThreadID = lpThreadID
    End If
End Function

Public Function TerminateCurrentThread()
    'Terminates the current thread

    'Ignore errors to prevent crashing if no thread has been created
    On Error Resume Next
    'Terminate the thread to prevent crashing if the app is closed
    'and the thread is still running (dangerous!)
    Call TerminateThread(mThreadHandle, ByVal 0&)
End Function

Public Property Get ThreadHandle() As Long
    'Returns the Handle of the current Thread
    ThreadHandle = mThreadHandle
End Property

Public Property Get ThreadID() As Long
    'Returns the ID of the current thread
    ThreadID = mThreadID
End Property

Public Property Get Priority() As Long
    'Returns a long value because the thread might have other priorities
    'than our five in the enum

    'Ignore errors to prevent crashing if no thread has been created
    On Error Resume Next
    Priority = GetThreadPriority(mThreadHandle)
End Property

Public Property Let Priority(ByVal tmpValue As ThreadPriority)
    'Sets the Thread Priority of the actual thread
    mPriority = tmpValue
    Call SetThreadPriority(mThreadHandle, tmpValue)
End Property

Public Property Get Enabled() As Boolean
    'Returns whether the Thread is enabled or not
    Enabled = mEnabled
End Property

Public Property Let Enabled(ByVal tmpValue As Boolean)
    'Enables/Disables the Thread

    'Ignore errors to prevent crashing if no thread has been created
    On Error Resume Next
    If tmpValue = True Then
        'Enable the thread
        Call ResumeThread(mThreadHandle)
    ElseIf tmpValue = False Then
        'Disable the thread
        Call SuspendThread(mThreadHandle)
    End If
End Property

Private Sub Class_Terminate()
    'Terminate the thread to prevent crashing if the app is closed
    'and the thread is still running (dangerous!)
    Call TerminateCurrentThread
End Sub

Проблема в том, что вызов функции TerminateCurrentThread не останавливает поток, он и дальше продолжает висеть в памяти. Вопрос:как его правельно остановить?
Ответить

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

Номер ответа: 1 Автор ответа: s12 Вопросов: 24 Ответов: 363	Профиль \| \| #1	Добавлено: 02.09.08 22:24
	Как я понял это модуль класса, вроде код правильный. Покажи как ты его используешь? Ответить

Номер ответа: 2 Автор ответа: ZoomerSD ICQ: 148640473 Вопросов: 135 Ответов: 270	Профиль \| \| #2	Добавлено: 02.09.08 22:39
	Примерно так: код модуля: Dim th as clsThread Publiс Sub Main() Set th = New clsThread th.CreateNewThread AddressOf Some 'здесь какой нибудь код th.TerminateCurrentThread Set th = Nothing End End Sub Public Sub Some() While(1) 'Здесь какой нибудь бесконечный цыкл Wend End Sub Ответить

Номер ответа: 3 Автор ответа: s12 Вопросов: 24 Ответов: 363	Профиль \| \| #3	Добавлено: 05.09.08 11:07
	Перекопал кучу литературы, нифига не нашел. Возможно трабла в Public Sub Some() может поменять на Private Sub Some() , а так хз. Ответить

Номер ответа: 4 Автор ответа: ZoomerSD ICQ: 148640473 Вопросов: 135 Ответов: 270	Профиль \| \| #4	Добавлено: 05.09.08 16:01
	а я наоборот разобрался. какого лешего. всё оказалось достаточно просто: в интеренте есть много коментариев по поводу этойй функции, мелкомягкие рекомендуют использовать её ток в экстренных случаях из за её асинхронности и того что она по идее может грохнуть не то,что надо. самый оптимальный выход завершить поток элементарным выходом из процедуры,тобиш: Dim th as clsThread Public Stoper as Boolean Publiс Sub Form_Load() Set th = New clsThread stoper = True th.CreateNewThread AddressOf Some End Sub Private Sub Command1_Click() 'завершаем поток stoper = False 'высвобождам ресурсы Set th = Nothing End Sub Public Sub Some() While(stoper) 'Здесь какой нибудь бесконечный цыкл Wend End Sub если процедура будет Private, то тогда если я не ошибаюсь, нельзя будет вызвать функцию AddressOf Ответить

Номер ответа: 5 Автор ответа: s12 Вопросов: 24 Ответов: 363	Профиль \| \| #5	Добавлено: 05.09.08 22:48
	Пошел вешаться... Ответить

Номер ответа: 6 Автор ответа: LamerOnLine ICQ: 334781088 Вопросов: 108 Ответов: 2822	Профиль \| \| #6	Добавлено: 09.09.08 11:00
	Мусорный код. На АПИ-потоках без OLE с VB можно кое-как работать только при компиляции в p-code. Простейший способ - используй ActiveX.Exe вместо стандартного. Большинство проблем решишь сразу. Либо используй tlb-шки для инициализации OLE в новом потоке и сам занимайся синхронизацией, но это геморней... Ответить

Номер ответа: 7 Автор ответа: ZoomerSD ICQ: 148640473 Вопросов: 135 Ответов: 270	Профиль \| \| #7	Добавлено: 09.09.08 12:10
	Простейший способ - используй ActiveX.Exe вместо стандартного. Большинство проблем решишь сразу. А можно поподробнее? Ответить

Номер ответа: 8 Автор ответа: LamerOnLine ICQ: 334781088 Вопросов: 108 Ответов: 2822	Профиль \| \| #8	Добавлено: 09.09.08 13:45
	Что именно? Создаешь вместо standard.exe ActiveX.Exe. Задаешь режим standalone, thread per object model. Далее запускается программа через sub_main, оттуда отображаешь основную форму. С этого момента любой экземпляр класса, созданный тобой через CreateObject(не через new) будет создаваться в отдельном потоке. Синхронизацию COM обеспечит сам. Тебе нужно будет только обеспечить развязку (неявный вызов процедуры) для асинхронности. Для этого запускаешь методы класса не напрямую, а через создание и последующее удаление АПИ таймера (в обработчике которого и вызываешь нужный метод). Все довольно просто и надежно. Ответить

Номер ответа: 9 Автор ответа: ZoomerSD ICQ: 148640473 Вопросов: 135 Ответов: 270	Профиль \| \| #9	Добавлено: 09.09.08 21:33
	Всё рано глухо. может гдето ошибся. я пробовал так для отладки: кода модуля: Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long Dim tmr As Long Public cls As Object Public Sub Main() Form1.Show Set cls = CreateObject("Project1.Class1" tmr = SetTimer(0, 0, 1, AddressOf tmrEnd) End Sub Public Sub tmrEnd() cls.ShellMe KillTimer 0, tmr End Sub код класса: Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private num As Long Public Sub ShellMe() Open App.Path & "/1.txt" For Append As #1 Print #1, num Close #1 num = num + 1 Sleep 1000 End Sub при запуске подвисает весь проект. свойстав проекта standalone и thread per object выставлены. Ответить

Номер ответа: 10 Автор ответа: ZoomerSD ICQ: 148640473 Вопросов: 135 Ответов: 270	Профиль \| \| #10	Добавлено: 09.09.08 21:35
	вот блин ток отправил и.. если устновить свойство thread pool на два потока, этот кода работает как надо... нечего не понимаю.. Ответить

Номер ответа: 11 Автор ответа: ZoomerSD ICQ: 148640473 Вопросов: 135 Ответов: 270	Профиль \| \| #11	Добавлено: 09.09.08 21:40
	понял почему работало "как надо" я допустил ошибку в классе. там должен быть бесконечный цикл: Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private num As Long Public Sub ShellMe() While 1 Open App.Path & "/1.txt" For Append As #1 Print #1, num Close #1 num = num + 1 Sleep 1000 Wend End Sub Ответить

Номер ответа: 12 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #12	Добавлено: 09.09.08 21:55
	(между while 1..wend и do..loop есть разница?) Ответить

Номер ответа: 13 Автор ответа: ZoomerSD ICQ: 148640473 Вопросов: 135 Ответов: 270	Профиль \| \| #13	Добавлено: 09.09.08 23:50
	(между while 1..wend и do..loop есть разница?) помоему нет, просто мне так привычней Ответить

Номер ответа: 14 Автор ответа: LamerOnLine ICQ: 334781088 Вопросов: 108 Ответов: 2822	Профиль \| \| #14	Добавлено: 10.09.08 10:47
	1. После запуска метода через SetTimer нужно убивать таймер, иначе труба. 2. Проект будет подвисать, ибо IDE шестой студии не держит многопоточность. Работать будет только скомпиленный проект. 3. Форму желательно отображать модальной, и создавать объекты через модуль оттуда. Если нужно - давай мыло, накидаю и скину пример. Ответить

Номер ответа: 15 Автор ответа: ZoomerSD ICQ: 148640473 Вопросов: 135 Ответов: 270	Профиль \| \| #15	Добавлено: 10.09.08 12:54
	Пиши на zoomer_sd@mail.ru Скомпилированный проект всёравно виснет Ответить

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