Salut, Comme vous le savez tous, le multithreading n'est pas une chose facile en vb, voir quelque chose d'impossible(comme je l'ai souvent lu). Je precise que ce code ne fonctionnera pas si compilé en vb6.
L'avantage du multithread: éviter le freeze de l'application lorsque vous gerer de lourdes procedures, Ca permet a l'application de garder la main sur les differents events(souris, clavier etc).
Cet exemple simple vous permettras de mieux comprendre: vous avez deux listview. vous y ajouter des items en boucle (5000 dans l'exemple). En tant normal, c'est fini votre application va freezer le temps que ça soit fini (à moins d'utiliser doevents, mais vous savez que l'effet de cet opérateur peut etre catastrophique selon la maniere dont on l'utilise). Avec le threading, ça vous permet d'executer d'autres taches en même temps sans aucun ennui ce type.
Precision: il faut synchroniser les access à l'édition des objets. En théorie (j'ai pas tester) on ne peux pas editer un objet de deux threads distinctes => access violation.
Plus precisement, cette source utilise l'api CreateThread_ByValParam() pour creer les threads, et LocalAlloc() couplé a Copymemory() pour lui passer des parametres de la fonction a executée, appelée elle même par l'opérateur Adressof().
Source / Exemple :
Option Explicit
'Declaration
Private Const MAXLONG = 256
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function CreateThread_ByValParam Lib "kernel32" Alias "CreateThread" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Any, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, ByRef lpThreadId As Long) As Long
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
Private Const CREATE_SUSPENDED = &H4
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
Dim lPtr As Long
Public Function malloc(sParam As String) As Long
Dim Ptr As Long, lSize As Long
lSize = LenB(sParam) 'on recupere la taille de la valeur de la variable a passer en parametre
'on alloue un emplacement mémoire, ptr nous retourne la position
Ptr = LocalAlloc(lPtr, lSize + 4)
'si success
If Ptr <> 0 Then
'on copie la taille (4 bytes = long)
CopyMemory ByVal Ptr, lSize, 4
'on copie la valeur de la variables. StrPtr pointe a l'adresse du premier chr
If lSize > 0 Then CopyMemory ByVal Ptr + 4, ByVal StrPtr(sParam), lSize
End If
'on attribue sa valeur a la fonction
malloc = Ptr
End Function
Public Function GetStrFromMemory(lParam As Long) As String
Dim lSize As Long
Dim sBuf As String
'si le pointeur de la variable est null la valeur retournée de la fonction est null
If lParam = 0 Then
GetStrFromMemory = ""
Else
'on récupere la taille
CopyMemory lSize, ByVal lParam, 4
If lSize > 0 Then
'on prepare un buffer
sBuf = String(lSize \ 2, 0)
'on récupere le string (lParam)
CopyMemory ByVal StrPtr(sBuf), ByVal lParam + 4, lSize
'on retourne sa valeur
GetStrFromMemory = sBuf
End If
End If
End Function
Public Sub FreeMemory(lParam As Long)
'on libere la memoire
LocalFree lParam
End Sub
Public Function CreateNewThread(ByVal lFunction As Long, Optional ByVal lParam As Long, Optional ByVal lPriority As Long = tpNormal, Optional ByVal lEnabled As Boolean = True)
Dim lFlags As Long
Dim lpThreadId As Long
Dim lHandle As Long
'on verifie la valeur du flag pour définir la propriété de la thread a creer
If lEnabled = True Then lFlags = 0 Else lFlags = CREATE_SUSPENDED
'on crée la thread (lHandle retourne son handle lol)
lHandle = CreateThread_ByValParam(ByVal 0&, ByVal 0&, lFunction, ByVal lParam, lFlags, lpThreadId)
'on retourne la valeur du handle
CreateNewThread = lHandle
End Function
Public Function TerminateCurrentThread(lParam As Long)
On Error Resume Next
'on termine la thread
TerminateThread lParam, ByVal 0&
End Function
Conclusion :
tout est dans le zip :)
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.