A por un MultiThread Decente!

[F3B14N]

Hola gente, hago este thread para ver si alguien puede hacer un codigo decente para crear threads y que se pueda acceder a todos los recursos normales de VB6 sin que crashe.

-Este es el codigo que utilizo algún tiempo, pero tiene limitaciones, al crear un thread con un nuevo FORM VISIBLE crashea (.Show,.Visible=True, de cualquier manera, inluyendo el api.).
-Tambien la simple llamada a MsgBox crashea, pero se puede solucionar llamando al api.

Yo creo que esos dos problemas estan relacionados, si alguien tiene el conocimiento y tiempo, le agradecería que intentara crear un codigo para crear varios threads sin problemas. Seria el UNICO en toda la internet, porque no lo hay, almenos en VB6

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Declare Function CreateThread Lib "KERNEL32" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByRef lpParameter As Any, ByVal dwCreationFlags As Long, ByRef lpThreadId As Long) As Long
Private Declare Sub ExitThread Lib "KERNEL32" (ByVal dwExitCode As Long)
Private Declare Function TlsGetValue Lib "KERNEL32" (ByVal dwTlsIndex As Long) As Long
Private Declare Function TlsSetValue Lib "KERNEL32" (ByVal dwTlsIndex As Long, ByRef lpTlsValue As Any) As Long

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Declare Function GetProcAddress Lib "KERNEL32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibrary Lib "KERNEL32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "KERNEL32" (ByVal hLibModule As Long) As Long

Private MemAddress As Long
Private TlsAddress As Long
Private TlsIndex As Long

Public Function CreateNewThread(ByVal hThreadProc As Long, Optional ByVal Param As Long = 0) As Long
   If (MemAddress + TlsIndex) = 0 Then
       Call InitTlsIndex: Call CopyMemory(TlsIndex, ByVal TlsAddress, Len(TlsIndex)) 'Retrieve TlsIndx from TlsAddress
       MemAddress = TlsGetValue(TlsIndex)
   End If

   CreateNewThread = CreateThread(0, 0, hThreadProc, ByVal Param, 0, 0)
End Function

Public Sub InitThread()
   Call TlsSetValue(TlsIndex, ByVal MemAddress) 'VB will use this address to store DLL error information and etcs.
End Sub

Private Sub InitTlsIndex()
   'Tls Index's address of our thread.
   Dim bB(40) As Byte, St As String
   Dim hProc As Long, hLib As Long, i As Integer, j As Integer

   hLib = LoadLibrary("MSVBVM60")
   hProc = GetProcAddress(hLib, "__vbaSetSystemError")
   Call CopyMemory(bB(0), ByVal (hProc), 40)
   
   While bB(i) <> &HC3 'RETN
       If bB(i) = &HFF And bB(i + 1) = &H35 Then
           For j = i + 2 To i + 5
               St = Hex(bB(j)) & St
           Next
           TlsAddress = Val("&H" & St): Exit Sub
       End If
       i = i + 1
   Wend
   
   Call FreeLibrary(hProc)
End Sub

Public Sub TerminateThread(ByVal dwExitCode As Long)
   Call ExitThread(dwExitCode)
End Sub

Abrazo

[F3B14N]

Vamos chicas!! 

[Karcrack]

Código [Seleccionar] Expandir

http://advancevb.com.ar/?p=521

[F3B14N]

Código [Seleccionar] Expandir

http://advancevb.com.ar/?p=521

Ya lo había visto, tenia un conflictos al iniciar el form con un control, pero puse el control en otro form que nunca se muestra y no hay problema, gracias Karcrack

EDITO:
El problema con el control sigue , aca subo un zip con un ejemplo del error por si alguien quiere ayudarme

http://www.box.net/shared/pdhdchnqc4

Gracias

[F3B14N]

.