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

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

.