在线程内不能调用ActiveX控件的问题

Question

我想开一个线程来加载一个ActiveX控件以加快速度，但不知道为什么不能实现，代码如下
Private Sub Form_Load()
Successful = False
With myThread
   .Initialize AddressOf Connect
   .Enabled = True
End With
End SubPublic Sub Connect()
On Error Resume Next
    Set myObj = CreateObject("MyApplication")
    Successful = True
 End Sub如果不用线程可以调用，用了线程没有任何效果也不报错，但Successful的确给设了True.
求救！！

Answer 1

Form_Load之后,使用控件之前,你确认控件已经初始化完成了?

Answer 2

On Error Resume Next 
无论是否出错都会执行 Successfull = True 语句。

Answer 3

谢谢两位提醒，去掉On Error Resume Next后出现自动化错误，而且一停止整个VB6都关闭了。请问这是为什么呢。

Answer 4

另外我试了一下用vs.net 2005，同样的代码可以运行，是不是VB6的线程天生缺陷？

Answer 5

信息不足，无法分析。
关于 VB6 与多线程建议阅读《高级 Visual Baisc 编程》(Advanced Visual Basic)

Answer 6

myThread 是包装的 CreateThread? 有没有做什么技术处理？
在form_load前加一个 CoInitializeEx byref 0，byval 0 的调用试试

Answer 7

不好意思啊，我把代码发全
TO PctGL能详细说一下吗，这句怎么用Private Type udtThread
    Handle As Long
    Enabled As Boolean
End Type    Private uThread As udtThread
    Private Const CREATE_SUSPENDED As Long = &H4
    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
    Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
    Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long
    Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As LongPublic Sub Initialize(ByVal lpfnBasFunc As Long)
    Dim lStackSize As Long, lCreationFlags As Long, lpThreadId As Long, lNull As Long
    On Error Resume Next
    lNull = 0
    lStackSize = 0
    lCreationFlags = CREATE_SUSPENDED
    uThread.Handle = CreateThread(lNull, lStackSize, lpfnBasFunc, lNull, lCreationFlags, lpThreadId)
    If uThread.Handle = lNull Then MsgBox "Create thread failed!"
End SubPublic Property Get Enabled() As Boolean
    On Error Resume Next
    Enabled = uThread.Enabled
End PropertyPublic Property Let Enabled(ByVal vNewvalue As Boolean)
    On Error Resume Next
    If vNewvalue And (Not uThread.Enabled) Then
        ResumeThread uThread.Handle
        uThread.Enabled = True
    ElseIf uThread.Enabled Then
        SuspendThread uThread.Handle
        uThread.Enabled = False
    End If
End PropertyPrivate Sub Class_Terminate()
    On Error Resume Next
    Call TerminateThread(uThread.Handle, 0)
End Sub

Answer 8

Private Declare Function CoInitializeEx Lib "ole32.dll" (vReserved As Long, ByVal dwCoInit As Long) As LongCoInitializeEx 0，0在程序入口就先调用一下这个，然后再执行你的代码，试试

Answer 9

线程被创建以后，要在线程里使用CoInitializeEx 0,COINIT_APARTMENTTHREADED指定该线程模为STA（公寓线程）后，才能创建和使用COM对象，如果是距线程的COM对象，还需要进行列集和散集。其中：COINIT_APARTMENTTHREADED=2。

Answer 10

即:
Public Sub Connect() 
    CoInitializeEx 0,COINIT_APARTMENTTHREADED
    Set myObj = CreateObject("MyApplication") 
    Successful = True 
End Sub 
另外,最好不要直接使用VB的全局变量.

Answer 11

Public Sub Connect() 
    CoInitializeEx 0,COINIT_APARTMENTTHREADED 
    Set myObj = CreateObject("MyApplication") 
    Successful = True 
    CoUninitialize()
End Sub 

Answer 12

ls 误会我的意思了lz 还是按照我说的在程序入口而非线程入口加载 CoInitializeEx  函数，然后测试吧而且大多数的vb控件也不要用 CoInitializeEx 来初始化 STA/MTA ，因为很多vb控件是固化的只支持 STA ，使用 MTA 来初始化线程，有可能导致线程根本无法正常运行

Answer 13

我贴个代码吧，一个多线程启用类，本机XP sp1～sp3 的环境，经测试，能够基本稳定
能够支持大多数的vb内建函数的跨线程调用，外部调用特别是api的调用，没有过多的修饰过，
只是简单的抹掉了 调用api后的错误检查。这个代码我最先发在我在vbgood的blog上，想发出来让大家帮忙测试 
但没人回我目前在vb6中使用 CreateThread 等标准api函数实现的基本稳定多线程貌似只有 Copy TLS，对于vb6来讲，多线程并非单一的 TLS 限制，这其中还涉及到oop内部的 STA/MTA等概念所有以 Copy Tls 实现的多线程，个人愚昧观点，都为非正常手段，但本人也同意，实现改造vb支持多线程，CopyTLS 或者 Hook TLS APi 为必须的步骤，只不过重点不要都放在 TLS 上另外， RtlCreateUserThread 之所以能够实现多线程，是因为这个函数就象 CreateRemoteThread(Nt 内核内部， CreateThread --> CreateRemoteThread --> NtCreateThread) 一样，是系统包装函数，所不同之处， CreateRemoteThread 用自己构造 ThreadContext 实现，而 RtlCreateUserThread 用 Copy Current ThreadContext 实现，而并非什么特殊的线程上下文，总而言之， RtlCreateUserThread 也是 Copy TLS ，所以他也不可能100％稳定实现vb多线程
这是我写的一个类，调用方法：dim mulThread1 as new clsThread
mulThread1.CreateThread(模块中的函数，函数参数，是否初始化线程后立刻暂停，线程优先级)
以下是 clsThread 类的代码Option ExplicitPrivate Declare Function CreateWin32Thread Lib "kernel32" Alias "CreateThread" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, Optional ByVal Length As Long = 4)
Private Declare Function CoInitializeEx Lib "ole32.dll" (ByVal pvReserved As Long, ByVal dwCoInit As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Enum CreateOperation
  CREATE_SUSPENDED = &H4
  CREATE_ENABLED = 0
End EnumEnum ThreadPriority
  THREAD_PRIORITY_LOWEST = -2
  THREAD_PRIORITY_BELOW_NORMAL = -1
  THREAD_PRIORITY_NORMAL = 0
  THREAD_PRIORITY_ABOVE_NORMAL = 1
  THREAD_PRIORITY_HIGHEST = 2
End EnumPrivate Type ThisClassSet
  t_ThreadHandle   As Long
  t_ThreadID       As Long
  t_ThreadPriority As Long
  c_ThdEnabled  As Boolean
End TypePrivate PG As ThisClassSet
Private LinkProc() As LongFunction CreateThread(ByVal LocalProcAddress As Long, Optional ByVal lParam As Long, Optional cEnabled As CreateOperation = CREATE_ENABLED, Optional ByVal cPriority As ThreadPriority = THREAD_PRIORITY_NORMAL) As Long
  Dim lngThreadCallBack As Long
  If PG.t_ThreadID Then Exit Function
  PG.t_ThreadHandle = CreateWin32Thread(0, 0, LocalProcAddress, lParam, cEnabled, PG.t_ThreadID)
  If PG.t_ThreadHandle Then CreateThread = PG.t_ThreadHandle: PG.c_ThdEnabled = CBool(cEnabled)
End FunctionFunction TerminateCurrentThread()
  TerminateThread PG.t_ThreadHandle, ByVal 1&
End FunctionProperty Get ThreadHandle() As Long
  ThreadHandle = PG.t_ThreadHandle
End PropertyProperty Get ThreadID() As Long
  ThreadID = PG.t_ThreadID
End PropertyProperty Get Priority() As ThreadPriority
  Priority = GetThreadPriority(PG.t_ThreadPriority)
End PropertyProperty Let Priority(ByVal tmpValue As ThreadPriority)
  PG.t_ThreadPriority = tmpValue
  Call SetThreadPriority(PG.t_ThreadHandle, tmpValue)
End PropertyProperty Get Enabled() As Boolean
  Enabled = PG.c_ThdEnabled
End PropertyProperty Let Enabled(ByVal tmpValue As Boolean)
  PG.c_ThdEnabled = tmpValue
  If tmpValue = True Then
    ResumeThread (PG.t_ThreadHandle)
  ElseIf tmpValue = False Then
    SuspendThread (PG.t_ThreadHandle)
  End If
End PropertyPrivate Sub Class_Initialize()
CoInitializeEx 0, 0
Dim i As Long
i = GetModuleHandle("msvbvm60.dll")
i = GetProcAddress(i, "__vbaSetSystemError")
WriteProcessMemory -1&, ByVal i&, &HC3, 1&, 0&
End SubPrivate Sub Class_Terminate()
  Call TerminateCurrentThread
End Sub请大家测试一下吧， 我不敢保证成功率， 这个代码主要的研究方向是以 线程模型的方向去做
有关 TLS 方面还没有加进去，由于我对vb的兴趣已经大减，所以研究出来这个东西之后，就基本扔到一边去了。。一些常见的极端vb函数，还是不行，我认为是代码还不够深入，最起码 TLS 还没合并测试
比如 msgbox, form.show 等 其他的，还是看有兴趣的朋友的测试结果吧建议做个简单的多线程绘图过程，测试下

Answer 14

感谢PCtGL,lyserver,试过你们的方法还是不行呢, 而且只要一报错,无论按调试还是关闭VB6都整个关掉了. 在.NET环境下面就轻而易举地实现了,嗷嗷地. 看来要放弃VB6多线程了,无论怎样分还是给的.

Answer 15

vb6还是可以完成activex的方式的多线程的