仿C语言中的联合体union高效取高低字方法(VB6.0)

马大哈

在CSDN的一个帖子( 求高效的取高字节VB6的函数 )里见到问题,说是想要高效的方式取得一个Long的高低字.

原帖子里用计算的方式来得到高字值,但还想要再快.

于是我就想到了C里面的联合体union,要是VB6里有这玩意该多好,直接赋值就能取高低字....

不过想想以前好象写过这玩意,就翻了一下之前写的一个与单片机通讯的代码,里面也有用到这功能,于是整理一下吧 {:soso_e113:}

以下代码,新建一个EXE工程,再拖个按钮,复制进去就可以了.

1. Option Explicit
   
2. '仿C语言中的联合体union高效取高低字方法
   
3. '
   
4. '实现思路:
   
5. '通过操作SafeArray来使一个数组的pvData指向目标变量,然后直接访问高低字,就像C里面的union一样
   
6. '
   
7. 'By 嗷嗷叫的老马
   
8. 'http://www.m5home.com/
   
9. 
   
10. Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
    
11. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
    
12.      ByRef Destination As Any, _
    
13.      ByRef Source As Any, _
    
14.      ByVal Length As Long)
    
15. 
    
16. Dim myIntegerArr() As Integer, myLong As Long
    
17. Dim ppSA As Long, pSA As Long, pvDataOld As Long
    
18. 
    
19. Private Sub Command1_Click()
    
20.     myLong = &HAABBCCDD     '赋值.此变量已与数组"绑定"了.
    
21.      
    
22.     MsgBox Hex(myIntegerArr(0)) & vbCrLf & Hex(myIntegerArr(1))     '直接取得高低字
    
23. End Sub
    
24. 
    
25. Private Sub Form_Load()
    
26.     Call initArray
    
27. End Sub
    
28. 
    
29. Private Sub Form_Unload(Cancel As Integer)
    
30.     Call FreeArray
    
31. End Sub
    
32. 
    
33. Private Sub initArray()
    
34.     '初始化数组及指针.
    
35.     '
    
36.     '将SafeArray结构的pvDara指针改为myLong变量的地址,这样就可以直接访问高低字了.
    
37.     '
    
38.     '简单来说就是"绑定"数组与myLong变量,让它们实际上使用同一个地址,相当于C里面的union
    
39.     '
    
40.     ReDim myIntegerArr(1)                           '与要访问的变量的长度相同.这里是要把Long分成两个Integer来访问,那就是0,1两个成员.
    
41.     myLong = VarPtr(myLong)                         '把自己的地址放在自己里面
    
42.      
    
43.     ppSA = VarPtrArray(myIntegerArr)                '得到指向SafeArray结构指针的指针(有点绕,就是指针的指针...- -!!)
    
44.     Call CopyMemory(pSA, ByVal ppSA, 4)             '得到SafeArray指针
    
45.      
    
46.     MsgBox "pSA=" & Hex(pSA)
    
47.      
    
48.     Call CopyMemory(pvDataOld, ByVal pSA + 12, 4)   '保存之前真数组的指针
    
49.     Call CopyMemory(ByVal pSA + 12, myLong, 4)      '设置myLong的指针为真数组指针
    
50. End Sub
    
51. 
    
52. Private Sub FreeArray()
    
53.     '恢复原来申请的真数组指针,并释放数组
    
54.     '
    
55.     Call CopyMemory(ByVal pSA + 12, pvDataOld, 4)   '恢复myLong的指针为之前申请的真数组指针
    
56.     Erase myIntegerArr()
    
57. End Sub

复制代码

马大哈

性能测试.

代码:

1. Option Explicit
   
2. '仿C语言中的联合体union高效取高低字方法
   
3. '
   
4. '实现思路:
   
5. '通过操作SafeArray来使一个数组的pvData指向目标变量,然后直接访问高低字,就像C里面的union一样
   
6. '
   
7. 'By 嗷嗷叫的老马
   
8. 'http://www.m5home.com/
   
9. 
   
10. Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
    
11. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
    
12.      ByRef Destination As Any, _
    
13.      ByRef Source As Any, _
    
14.      ByVal Length As Long)
    
15. Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
    
16. 
    
17. Private Const UB As Long = 100000000
    
18. 
    
19. Dim myIntegerArr() As Integer, myByteArr() As Integer, myLong As Long
    
20. Dim ppSA As Long, pSA As Long, pvDataOld As Long
    
21. Dim ppSAByte As Long, pSAByte As Long, pvDataOldByte As Long
    
22. 
    
23. Dim rndList() As Long, HiWords() As Integer
    
24. 
    
25. Private Sub Command1_Click()
    
26.     Dim I As Long, K As Long
    
27.    
    
28.     ReDim rndList(UB)
    
29.    
    
30.     K = GetTickCount
    
31.    
    
32.     For I = 0 To UB
    
33.         myByteArr(0) = Rnd * 255
    
34.         myByteArr(1) = Rnd * 255
    
35.         myByteArr(2) = Rnd * 255
    
36.         myByteArr(3) = Rnd * 255
    
37.         
    
38.         rndList(I) = myLong
    
39.     Next
    
40.    
    
41.     MsgBox "生成随机数组时间=" & GetTickCount - K & "ms"
    
42. End Sub
    
43. 
    
44. Private Sub Command2_Click()
    
45.     Dim I As Long, K As Long
    
46.    
    
47.     Erase HiWords()
    
48.     ReDim HiWords(UB)
    
49.    
    
50.     K = GetTickCount
    
51.    
    
52.     For I = 0 To UB
    
53.         myLong = rndList(I)
    
54.         HiWords(I) = myIntegerArr(0)
    
55.     Next
    
56.    
    
57.     MsgBox "模拟union方案时间=" & GetTickCount - K & "ms"
    
58. End Sub
    
59. 
    
60. Private Sub Command3_Click()
    
61.     Dim I As Long, K As Long
    
62.    
    
63.     Erase HiWords()
    
64.     ReDim HiWords(UB)
    
65.    
    
66.     K = GetTickCount
    
67.    
    
68.     For I = 0 To UB
    
69.         HiWords(I) = zGetLngHigh(rndList(I))
    
70.     Next
    
71.    
    
72.     MsgBox "zGetLngHigh方案时间=" & GetTickCount - K & "ms"
    
73. End Sub
    
74. 
    
75. Private Sub Command4_Click()
    
76.     Dim I As Long, K As Long
    
77.    
    
78.     Erase HiWords()
    
79.     ReDim HiWords(UB)
    
80.    
    
81.     K = GetTickCount
    
82.    
    
83.     For I = 0 To UB
    
84.         HiWords(I) = GetHiWord(rndList(I))
    
85.     Next
    
86.    
    
87.     MsgBox "GetHiWord方案时间=" & GetTickCount - K & "ms"
    
88. End Sub
    
89. 
    
90. Private Sub Command5_Click()
    
91.     Dim I As Long, K As Long
    
92.    
    
93.     Erase HiWords()
    
94.     ReDim HiWords(UB)
    
95.    
    
96.     K = GetTickCount
    
97.    
    
98.     For I = 0 To UB
    
99.         HiWords(I) = aGetLongHigh(rndList(I))
    
100.     Next
     
101.    
     
102.     MsgBox "aGetLongHigh方案时间=" & GetTickCount - K & "ms"
     
103. End Sub
     
104. 
     
105. Public Function zGetLngHigh(ByVal zLong As Long) As Integer
     
106.     zGetLngHigh = (zLong And &H7FFF0000) \ &H10000 Or (((zLong And &H80000000) <> 0) And &H8000)
     
107. End Function
     
108. 
     
109. Public Function GetHiWord(ByRef lThis As Long) As Integer
     
110.     If (lThis And &H80000000) = &H80000000 Then
     
111.         GetHiWord = ((lThis And &H7FFF0000) \ &H10000) Or &H8000
     
112.     Else
     
113.         GetHiWord = (lThis And &HFFFF0000) \ &H10000
     
114.     End If
     
115. End Function
     
116. 
     
117. Private Function aGetLongHigh(ByRef mLong As Long) As Integer
     
118.     Dim MyBit(3) As Byte
     
119.    
     
120.     Call CopyMemory(MyBit(0), mLong, 4)
     
121.     Call CopyMemory(aGetLongHigh, MyBit(2), 2)
     
122.     Erase MyBit
     
123. End Function
     
124. 
     
125. Private Sub Form_Load()
     
126.     Command1.Caption = "生成" & UB & "个随机数"
     
127.     Command2.Caption = "模拟union方案"
     
128.     Command3.Caption = "zGetLngHigh方案"
     
129.     Command4.Caption = "GetHiWord方案"
     
130.     Command5.Caption = "aGetLongHigh方案"
     
131.    
     
132.     Call initArray
     
133. End Sub
     
134. 
     
135. Private Sub Form_Unload(Cancel As Integer)
     
136.     Call FreeArray
     
137. End Sub
     
138. 
     
139. Private Sub initArray()
     
140.     '初始化数组及指针.
     
141.     '
     
142.     '将SafeArray结构的pvDara指针改为myLong变量的地址,这样就可以直接访问高低字了.
     
143.     '
     
144.     '简单来说就是"绑定"数组与myLong变量,让它们实际上使用同一个地址,相当于C里面的union
     
145.     '
     
146.     ReDim myIntegerArr(1)                           '与要访问的变量的长度相同.这里是要把Long分成两个Integer来访问,那就是0,1两个成员.
     
147.     myLong = VarPtr(myLong)                         '把自己的地址放在自己里面
     
148.    
     
149.     ppSA = VarPtrArray(myIntegerArr)                '得到指向SafeArray结构指针的指针(有点绕,就是指针的指针...- -!!)
     
150.     Call CopyMemory(pSA, ByVal ppSA, 4)             '得到SafeArray指针
     
151.      
     
152.     MsgBox "pSA=" & Hex(pSA)
     
153.      
     
154.     Call CopyMemory(pvDataOld, ByVal pSA + 12, 4)   '保存之前真数组的指针
     
155.     Call CopyMemory(ByVal pSA + 12, myLong, 4)      '设置myLong的指针为真数组指针
     
156.    
     
157.     ReDim myByteArr(3)                              '与要访问的变量的长度相同.
     
158.     myLong = VarPtr(myLong)                         '把自己的地址放在自己里面
     
159.    
     
160.     ppSAByte = VarPtrArray(myByteArr)               '得到指向SafeArray结构指针的指针(有点绕,就是指针的指针...- -!!)
     
161.     Call CopyMemory(pSAByte, ByVal ppSAByte, 4)     '得到SafeArray指针
     
162.      
     
163.     MsgBox "pSAByte=" & Hex(pSAByte)
     
164.      
     
165.     Call CopyMemory(pvDataOldByte, ByVal pSAByte + 12, 4)   '保存之前真数组的指针
     
166.     Call CopyMemory(ByVal pSAByte + 12, myLong, 4)          '设置myLong的指针为真数组指针
     
167. End Sub
     
168. 
     
169. Private Sub FreeArray()
     
170.     '恢复原来申请的真数组指针,并释放数组
     
171.     '
     
172.     Call CopyMemory(ByVal pSA + 12, pvDataOld, 4)   '恢复myLong的指针为之前申请的真数组指针
     
173.     Erase myIntegerArr()
     
174.    
     
175.     Call CopyMemory(ByVal pSAByte + 12, pvDataOldByte, 4)   '恢复myLong的指针为之前申请的真数组指针
     
176.     Erase myByteArr()
     
177. End Sub
     

复制代码

结果:

1. 把电脑设置为自动性能模式,不做编译优化,结果如下:
   
2. 
   
3. 生成1亿个LONG随机数=53045ms
   
4. 模拟union方案=1462ms
   
5. zGetLngHigh方案=5703ms
   
6. GetHiWord方案=9453ms
   
7. aGetLongHigh方案=64188ms

复制代码

1. 把电脑设置为最高性能模式,不做编译优化,结果如下:
   
2. 
   
3. 生成1亿个LONG随机数=45047ms,提速17%
   
4. 模拟union方案=1203ms,提速21%
   
5. zGetLngHigh方案=4469ms,提速27%
   
6. GetHiWord方案=6531ms,提速44%
   
7. aGetLongHigh方案=46797ms,提速37%

复制代码

1. 电脑性能设置为自动性能模式,再把编译选项中的高级优化全勾上,结果如下:
   
2. 
   
3. 生成1亿个LONG随机数=54719ms,降低3%
   
4. 模拟union方案=1094ms,提速33%
   
5. zGetLngHigh方案=5281ms,提速7%
   
6. GetHiWord方案=8015ms,提速17%
   
7. aGetLongHigh方案=59641ms,提速7%

复制代码

1. 电脑性能设置为最高性能,再把编译选项中的高级优化全勾上,火力全开了,结果如下:
   
2. 
   
3. 生成1亿个LONG随机数=41015ms,提速29%
   
4. 模拟union方案=703ms,提速107%
   
5. zGetLngHigh方案=4094ms,提速39%
   
6. GetHiWord方案=5890ms,提速60%
   
7. aGetLongHigh方案=46515ms,提速37%

复制代码

有点意思,哈哈.

看来编译优化对于性能的提高还是很明显的啊.

不过对函数的调用几乎就没什么用了,比如生成随机数组时,RND函数是VB6内部已经编译好的,不会再二次编译了,所以没什么效果.