Soyez le premier à donner votre avis sur cette source.
Vue 23 424 fois - Téléchargée 1 598 fois
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
5 avril 2006 à 14:01
L'idée semble bonne mais effectivememt ça ne fonctionne pas en vb6...
Alors en quelle version de vb cela fonctionne-t-il ? (car cela ne ressemble pas à du vb.net...)
5 avril 2006 à 14:06
bref sans grand interer ,a part que je dirait que : le multi tread c est vraiment a eviter dans la mesure du possible. si dans certaine situation on ne peut faire autrement par ex une boucle infinie velontaire pour faire un control sur quelque chose.
sinon doevents est peut etre un peut lent mai a ce moment la on peut faire un teste par exemple faire 1 doevents sur 100 passage de boucle
de plus un tread c est pas vraiment bien decharger un foit terminer
5 avril 2006 à 14:10
J'ajoute par la même occasion qu'il est possible de débugguer la source avec l'IDE de vb5, mais pas step by step. alors vous me direz quelle utilité? ben en mode debug vous aurez au moins le message d'erreur de vb avant que l'IDE plante donc on peut quand même fixer. en compilé, une erreur dans la thread et c'est un plantage sans aucune forme de remerciement. Il vaut mieux etre sur a 100% de sa foncton avant de la threader.
5 avril 2006 à 14:14
5 avril 2006 à 14:21
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.