全球首创? 再次突破VB极限!VB真正稳定多线程(不用tlb,tls,ax,pcode)

download

没玩过多线程。能否做过实际例子？例如：文件搜索，Load/Insert multi images from/to Database?
VBAdvisor 发表于 2010-4-26 11:14

你找个例子加到线程函数的第一行试试.

就不需要TLB了...有什么问题请留言.

connile

做个标记,回头再细细研究..

gxght1122

觉得还是用tlb好

acme_pjz

哦，这么先进？本来我还想叫你帮我调试一下这个的……我昨天晚上花了一个小时写了个线程切换的汇编代码，经调试发现不非法操作了，但是“打印预览”里面什么都不显示了……点“适应页宽”那个按钮就有显示了，但是只显示第一幅图片，而且显示得不对……估计是IE内部创建了多个类实例造成的，但是不确定……你先下载那个山寨Wiki源代码，然后用这个新的压缩包中的文件覆盖掉已有代码再调试……

PS：调试起来可不简单，要面对写在Byte数组里面的汇编……

VBAdvisor

11# download

'Module

1. Option Explicit
   
2. Public Declare Function CreateIExprSrvObj Lib "msvbvm60.dll" (ByVal p1_0 As Long, ByVal p2_4 As Long, ByVal p3_0 As Long) As Long
   
3. 
   
4. Public 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
   
5. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
   
6. Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
   
7. Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
   
8. Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
   
9. 
   
10. Public Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
    
11. Public Declare Function CreateEvent& Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpname As String)
    
12. Public Declare Function SetEvent Lib "kernel32" (hEvent As Long) As Long
    
13. Public lThreadHandle1 As Long
    
14. Public lThreadHandle2 As Long
    
15. Public lThreadHandle3 As Long
    
16. Public lThreadHandle4 As Long
    
17. Public lEventHandle As Long
    
18. 
    
19. 'Public objdata As New clsSQLFileObject
    
20. 
    
21. Public Sub Main()
    
22. 
    
23.     Form1.Show
    
24. 
    
25. End Sub
    
26. 
    
27. Public Sub test_function1()
    
28. 
    
29.     CreateIExprSrvObj 0, 4, 0
    
30. 
    
31. Dim objdata As clsSQLFileObject
    
32. Set objdata = New clsSQLFileObject
    
33.   objdata.DatabaseName = "Assets"
    
34.   objdata.DataSource = "(local)\SQLEXPRESS"
    
35.   objdata.Password = "sa"
    
36.   objdata.UserName = "sa1"
    
37.   objdata.ConnectionType = ejvSQLServer
    
38.   
    
39.   objdata.ImportFile = App.Path & "\Assets.mdb"
    
40.   objdata.AssetsID = 1
    
41.   objdata.AddedBy = "Zhu"
    
42.   objdata.Remarks = "Test"
    
43.   objdata.wwWindowName = "Form1"
    
44.   objdata.InsertObject
    
45.   
    
46. 
    
47. End Sub
    
48. 
    
49. Public Sub test_function2()
    
50. 
    
51.     CreateIExprSrvObj 0, 4, 0
    
52.    
    
53.     Dim objdata As clsSQLFileObject
    
54. Set objdata = New clsSQLFileObject
    
55.     objdata.DatabaseName = "Assets"
    
56.   objdata.DataSource = "(local)\SQLEXPRESS"
    
57.   objdata.Password = "sa"
    
58.   objdata.UserName = "sa2"
    
59.   objdata.ConnectionType = ejvSQLServer
    
60.   
    
61.   objdata.ImportFile = "C:\Documents and Settings\MF\My Documents\Word2003RTFSpec.pdf"
    
62.   objdata.AssetsID = 1
    
63.   objdata.AddedBy = "Zhu"
    
64.   objdata.Remarks = "Test"
    
65.   objdata.wwWindowName = "Form1"
    
66.   objdata.InsertObject
    
67. 
    
68. End Sub
    
69. 
    
70. Public Sub test_function3()
    
71. 
    
72.     CreateIExprSrvObj 0, 4, 0
    
73.    
    
74.     Dim objdata As clsSQLFileObject
    
75.    Set objdata = New clsSQLFileObject
    
76.   objdata.DatabaseName = "Assets"
    
77.   objdata.DataSource = "(local)\SQLEXPRESS"
    
78.   objdata.Password = "sa"
    
79.   objdata.UserName = "sa3"
    
80.   objdata.ConnectionType = ejvSQLServer
    
81.   
    
82.   'ABCIP_DASERVER_41.zip
    
83.   objdata.ImportFile = "C:\Documents and Settings\MF\My Documents\ABCIP_DASERVER_41.zip"
    
84.   objdata.AssetsID = 1
    
85.   objdata.AddedBy = "Zhu"
    
86.   objdata.Remarks = "Test"
    
87.   objdata.wwWindowName = "Form1"
    
88.   objdata.InsertObject
    
89. 
    
90. End Sub
    
91. 
    
92. 
    
93. Public Sub test_function4()
    
94.   
    
95.    CreateIExprSrvObj 0, 4, 0
    
96.    
    
97.    Dim objdata As clsSQLFileObject
    
98.    Set objdata = New clsSQLFileObject
    
99.    
    
100.   objdata.DatabaseName = "Assets"
     
101.   objdata.DataSource = "(local)\SQLEXPRESS"
     
102.   objdata.Password = "sa"
     
103.   objdata.UserName = "sa4"
     
104.   objdata.ConnectionType = ejvSQLServer
     
105.   
     
106.    objdata.SaveAsFileName = App.Path & "\test.jpg"
     
107.    objdata.ID = "8"
     
108.    objdata.wwWindowName = "Form1"
     
109.    objdata.SaveToFile
     
110. 
     
111. End Sub
     

复制代码

1. 'Form1
   
2. Option Explicit
   
3. 
   
4. Private Sub Command1_Click()
   
5. 
   
6. Dim lpThreadID As Long
   
7. 
   
8.     lThreadHandle1 = CreateThread(ByVal 0&, ByVal 0&, AddressOf test_function1, ByVal 0&, 0, lpThreadID)
   
9.     lThreadHandle2 = CreateThread(ByVal 0&, ByVal 0&, AddressOf test_function2, ByVal 0&, 0, lpThreadID)
   
10.     lThreadHandle3 = CreateThread(ByVal 0&, ByVal 0&, AddressOf test_function3, ByVal 0&, 0, lpThreadID)
    
11.     lThreadHandle4 = CreateThread(ByVal 0&, ByVal 0&, AddressOf test_function4, ByVal 0&, 0, lpThreadID)
    
12.     lEventHandle = CreateEvent(ByVal 0&, False, False, ByVal 0&)
    
13.   
    
14.   
    
15. End Sub
    
16. 
    
17. Private Sub Command2_Click()
    
18. 
    
19. 
    
20.    Dim lRC As Long
    
21. 
    
22.     lRC = SetEvent(lEventHandle)
    
23. 
    
24.     If lThreadHandle1 > 0 Then
    
25.         Call TerminateThread(lThreadHandle1, ByVal 0&)
    
26.     End If
    
27.     If lThreadHandle2 > 0 Then
    
28.         Call TerminateThread(lThreadHandle2, ByVal 0&)
    
29.     End If
    
30.     If lThreadHandle3 > 0 Then
    
31.         Call TerminateThread(lThreadHandle3, ByVal 0&)
    
32.     End If
    
33.     If lThreadHandle4 > 0 Then
    
34.         Call TerminateThread(lThreadHandle4, ByVal 0&)
    
35.     End If
    
36. 
    
37.     lThreadHandle1 = 0
    
38.     lThreadHandle2 = 0
    
39.     lThreadHandle3 = 0
    
40.     lThreadHandle4 = 0
    
41. 
    
42. End Sub
    
43. 
    
44. Private Sub Form_Unload(Cancel As Integer)
    
45. 
    
46.     If lThreadHandle1 > 0 Then
    
47.         Call TerminateThread(lThreadHandle1, ByVal 0&)
    
48.     End If
    
49.     If lThreadHandle2 > 0 Then
    
50.         Call TerminateThread(lThreadHandle2, ByVal 0&)
    
51.     End If
    
52.    
    
53.     If lThreadHandle3 > 0 Then
    
54.         Call TerminateThread(lThreadHandle3, ByVal 0&)
    
55.     End If
    
56.     If lThreadHandle4 > 0 Then
    
57.        Call TerminateThread(lThreadHandle4, ByVal 0&)
    
58.     End If
    
59. 
    
60.     Call TerminateProcess(GetCurrentProcess, ByVal 0&)
    
61. 
    
62. End Sub
    

复制代码

崩溃。不知是否我运用错误？

msflexgrid

觉得还是用tlb好
gxght1122 发表于 2010-4-26 11:47

TLB你要自己写大部份的VB函数。。。
用TLB跟用VC+SDK差不多的劳力，体现不出VB快速编 程的优势

msflexgrid

11# download
'Module
VBAdvisor 发表于 2010-4-26 12:16

Set objdata = New clsSQLFileObject


这是什么东东？里面有什么东东？

VBAdvisor

17# msflexgrid

clsSQLFileObject是个VB ActiveX DLL.用来连接，操作SQLSERVER中的Table.

崩溃，即使使用一个线程。clsSQLFileObject绝对没问题。

msflexgrid

哦，这么先进？本来我还想叫你帮我调试一下这个的……我昨天晚上花了一个小时写了个线程切换的汇编代码，经调试发现不非法操作了，但是“打印预览”里面什么都不显示了……点“适应页宽”那个按钮就有显示了，但是只 ...
acme_pjz 发表于 2010-4-26 11:49

。。。你这汇编是什么汇编？F？N？偶不会编 译。。。能不能用宏汇编来写？
看不明白你写的什么，太牛了吧。。。是不是先切回主线程执行完再切回子线程？


打印预览不显示*猜想*是IQ执行没正确，所以就空白了。你把IQ里面清空，网页也就空白了。。。


上面的“本来”。。。是不是你现在又有新的尝试了？


PS：己下载，不懂怎么编译你那个汇编……

msflexgrid

PS：似乎只有版主才能评“金钱”？