用VB6写的CPU性能测试工具

90999 · 发表于 2016-2-24 13:04:02

本帖最后由 90999 于 2016-2-24 13:05 编辑

源于百度这三帖：
http://tieba.baidu.com/p/3753425942
http://tieba.baidu.com/p/3871481362
http://tieba.baidu.com/p/3894610906

文中说到，根据贴主migeyusu的说法 CORE DUO 相对 i3-4 的在老软件性能仅有后者50-60%。
而AMD 的APU和FX 整数效能凭借高主频稍强于老旧的CORE DUO，
其中贴出了部分代码，我照抄了部分，做出来玩玩。

PS: 其中基本排序算法我不懂是啥，那贴主说是二分查找我就照弄了.........

代码
Form1部分

Private times As Integer
Private INTY, SFOY, DFOY, SCIY, MSY, BSY As Long
‘-------------------------------------------------------------------------------------------------------------------
Private Function valTran(a As Single) As Integer
valTran = Int(1000000 / (a * 100))
End Function
‘-------------------------------------------------------------------------------------------------------------------
Private Sub form_load()
times = 0
Form1.BorderStyle = 1 '窗体大小不可变
'Command1.Default = True '默认回车就是按下按钮
Command1.Caption = "开始(START)"
End Sub
‘-------------------------------------------------------------------------------------------------------------------
Private Sub Command1_Click()
Command1.Enabled = False '禁止按下，变灰色
Command1.Caption = "运行中(PROCESSING)"
MsgBox "本次测试下需要较长时间，请勿关闭或操作程序"
Label1(0).Caption = "最大可用整数性能：计算中"
DoEvents
INTY = valTran(intCal())
Label1(0).Caption = "最大可用整数性能：" + Str(INTY)
DoEvents
Label2(0).Caption = "最大可用单精度浮点：计算中"
DoEvents
SFOY = valTran(sfoCal())
Label2(0).Caption = "最大可用单精度浮点：" + Str(SFOY)
DoEvents
Label3(0).Caption = "最大可用双精度浮点：计算中"
DoEvents
DFOY = valTran(dfoCal())
Label3(0).Caption = "最大可用双精度浮点：" + Str(DFOY)
DoEvents
Label4(0).Caption = "科学计算效能：计算中"
DoEvents
SCIY = valTran(sciCal())
Label4(0).Caption = "科学计算效能：" + Str(SCIY)
DoEvents
Label5(0).Caption = "常用排序算法性能：计算中"
DoEvents
MSY = valTran(MS())
Label5(0).Caption = "常用排序算法性能：" + Str(MSY)
DoEvents
Label6(0).Caption = "基本排序算法性能：计算中"
DoEvents
BSY = valTran(BS())
Label6(0).Caption = "基本排序算法性能：" + Str(BSY)
DoEvents
times = times + 1
Text1.Text = Text1.Text & "第" & Str(times) & "次数值运算成绩是" & Str(INTY) + "/" & Str(SFOY) & "," & Chr(13) & Chr(10) & "归并排序成绩是 " & Str(MSY) & Chr(13) & Chr(10)
Command1.Caption = "开始(START)"
Command1.Enabled = True
End Sub

复制代码

MODULE1部分

Public Function intCal9() '整数计算自写的，丢弃
Dim i As Long, j As Single, n As Long
j = Timer
For i = 1 To 30000000
n = i + 97
n = n / 177
n = n * 11
n = n - 182 '加减乘除8bit
n = i + 13497
n = n / 4277
n = n * 1351
n = n - 9851 '加减乘除16bit
n = i + 1300497
n = n / 420077
n = n * 100351
n = n - 5529851 '加减乘除24bit
n = i + 667555000
n = n - 322111500
n = n / 23335123
n = n * 32132355 '加减乘除32bit
Next i
intCal = (Timer - j) / 4
End Function
‘-------------------------------------------------------------------------------------------------------------------
Public Function intCal() '整数计算
Dim i As Long, j As Single, s As Long
Dim a1, a2, a3, a4, a5, a6, a7, a8, a9, a10 As Long
a1 = Rnd
a2 = Rnd
a3 = Rnd
a4 = Rnd
a5 = Rnd
a6 = Rnd
a7 = Rnd
a8 = Rnd
a9 = Rnd
a10 = Rnd
j = Timer
For i = 1 To 4000000
a1 = a1 + 1
a2 = a2 - 1
a3 = a3 * (a1 + a2) * a4
a4 = (a4 + a3) Mod 10
a5 = a5 ^ a4
a6 = (a5 + a6) / 2
a7 = Not (a7 * a4)
a8 = a8 Or a7
a9 = a9 And a8
a10 = a10 ^ a9
Next i
intCal = (Timer - j) / 4
s = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10
End Function
‘-------------------------------------------------------------------------------------------------------------------
Public Function sfoCal9() '单精度浮点计算自写的，丢弃
Dim i As Long, j As Single, n As Single
j = Timer
For i = 1 To 30000000
n = 1.672298 ^ 23 - 3.31425231 + i ^ 1.2
Next i
sfoCal9 = Timer - j
End Function
‘-------------------------------------------------------------------------------------------------------------------
Public Function sfoCal() '单精度浮点计算
Dim i As Long, j As Single, s As Single
Dim a1, a2, a3, a4, a5, a6, a7, a8, a9, a10 As Single
a1 = Rnd / 3.14
a2 = 2 + a1
a3 = 3 + a1
a4 = 4 + a1
a5 = 5 + a1
a6 = 6 + a1
a7 = 7 + a1
a8 = 8 + a1
a9 = 9 + a1
a10 = 10 + a1
j = Timer
For i = 1 To 10000000
a1 = a1 + 1.1
a2 = a1 - 1.3
a3 = a3 + 1.1
a4 = a4 - 1.2
a5 = a1 + a2 + a3 + a4
a6 = a6 + 3.1
a7 = a7 - 1
a8 = a8 + 1.4
a9 = a9 - 1.5
a10 = a6 + a7 + a8 + a9
a10 = a10 * a5
a10 = a10 ^ 0.5
a5 = a5 / 2
a6 = Cos(Sin(a10))
a2 = Abs(a2)
a4 = Abs(a4)
a7 = Abs(a7)
a9 = Abs(a9)
a10 = 2 ^ (a10 ^ 0.13)
Next i
sfoCal = Timer - j
s = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10
End Function
‘-------------------------------------------------------------------------------------------------------------------
Public Function dfoCal9() '双精度浮点计算自写的，丢弃
Dim i As Long, j As Single, n As Double
j = Timer
For i = 1 To 30000000
n = 1.672298 ^ 52 - 19.314252231 + 999.22999 + i ^ 1.2
Next i
dfoCal9 = Timer - j
End Function
‘-------------------------------------------------------------------------------------------------------------------
Public Function dfoCal() '双精度浮点计算
Dim i As Long, j As Single, s As Double
Dim a1, a2, a3, a4, a5, a6, a7, a8, a9, a10 As Double
a1 = Rnd / 3.14
a2 = 2 + a1
a3 = 3 + a1
a4 = 4 + a1
a5 = 5 + a1
a6 = 6 + a1
a7 = 7 + a1
a8 = 8 + a1
a9 = 9 + a1
a10 = 10 + a1
j = Timer
For i = 1 To 10000000
a1 = a1 + 1.1
a2 = a1 - 1.3
a3 = a3 + 1.1
a4 = a4 - 1.2
a5 = a1 + a2 + a3 + a4
a6 = a6 + 3.1
a7 = a7 - 1
a8 = a8 + 1.4
a9 = a9 - 1.5
a10 = a6 + a7 + a8 + a9
a10 = a10 * a5
a10 = a10 ^ 0.5
a5 = a5 / 2
a6 = Cos(Sin(a10))
a2 = Abs(a2)
a4 = Abs(a4)
a7 = Abs(a7)
a9 = Abs(a9)
a10 = 2 ^ (a10 ^ 0.13)
Next i
dfoCal = Timer - j
s = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10
End Function
‘-------------------------------------------------------------------------------------------------------------------
Public Function sciCal() '科学计算
Dim i As Long, j As Single, n As Double
j = Timer
For i = 1 To 30000000
n = 10
n = i
n = n ^ 10
n = 1 / n
n = Sqr(n)
n = Sin(n)
n = Cos(n)
n = Tan(n)
n = Log(n)
n = Abs(n)
n = Int(n)
n = 100!
n = n Mod i
n = True And n
n = True Or n
n = Not n
Next i
sciCal = Timer - j
End Function
‘-------------------------------------------------------------------------------------------------------------------
Public Sub mergesort(ary1() As Long) '归并排序
Dim LEN1 As Long
Dim L1 As Long, L2 As Long
LEN1 = UBound(ary1)
Dim ary2() As Long
Dim j As Long, i As Long
Dim x As Long
x = 0
Dim LEN2 As Long
i = 1
j = 0
x = 0
LEN2 = 1
L1 = 0
L2 = 0
LEN2 = 1
Do While LEN1 \ LEN2 >= 2
Do While i <= LEN1
If i + LEN2 * 2 - 1 <= LEN1 Then
L1 = i + LEN2 - 1
j = L1 + 1
L2 = L1 + LEN2
ElseIf i - 1 + LEN2 * 1 < LEN1 Then
L1 = i - 1 + LEN2
j = L1 + 1
L2 = LEN1
Else
L1 = LEN1
j = LEN1 + 1
L2 = LEN1
End If
ReDim ary2(LEN2 * 2)
Call aryGet(i, L1, j, L2, ary2, LEN2 * 2, ary1)
i = L2 + 1
Loop
x = x + 1
LEN2 = 2 ^ x
i = 1
Loop
ReDim ary2(LEN1)
L1 = LEN2
i = 1
L2 = LEN1
j = L1 + 1
Call aryGet(i, L1, j, L2, ary2, LEN1, ary1)
End Sub
‘-------------------------------------------------------------------------------------------------------------------
Public Sub aryGet(i As Long, ls1 As Long, j As Long, ls2 As Long, arys() As Long, lst As Long, aryk() As Long)
Dim k As Long, ii As Long
ii = i
k = 1
Do While i <= ls And j <= ls2
If aryk(i) <= aryk(j) Then
arys(k) = aryk(i)
i = i + 1
Else
arys(k) = aryk(j)
j = j + 1
End If
k = k + 1
Loop
If i > ls1 Then
For j = j To ls2
arys(k) = aryk(i)
k = k + 1
Next j
Else
For i = i To ls1
arys(k) = aryk(i)
k = k + 1
Next i
End If
For k = 1 To lst
If ii <= ls2 Then
aryk(ii) = arys(k)
ii = ii + 1
Else
Exit For
End If
Next k
End Sub
‘-------------------------------------------------------------------------------------------------------------------
Public Function MS() '归并排序自写的
Dim i As Long, j As Single
Dim aaa(16) As Long
j = Timer
For i = 1 To 200000
aaa(1) = Fix(Rnd * (2 ^ 8))
aaa(2) = Fix(Rnd * (2 ^ 8))
aaa(3) = Fix(Rnd * (2 ^ 8))
aaa(4) = Fix(Rnd * (2 ^ 8))
aaa(5) = Fix(Rnd * (2 ^ 8))
aaa(6) = Fix(Rnd * (2 ^ 8))
aaa(7) = Fix(Rnd * (2 ^ 8))
aaa(8) = Fix(Rnd * (2 ^ 8))
aaa(9) = Fix(Rnd * (2 ^ 8))
aaa(10) = Fix(Rnd * (2 ^ 8))
aaa(11) = Fix(Rnd * (2 ^ 8))
aaa(12) = Fix(Rnd * (2 ^ 8))
aaa(13) = Fix(Rnd * (2 ^ 8))
aaa(14) = Fix(Rnd * (2 ^ 8))
aaa(15) = Fix(Rnd * (2 ^ 8))
aaa(16) = Fix(Rnd * (2 ^ 8))
Call mergesort(aaa)
Next i
MS = Timer - j
End Function
‘-------------------------------------------------------------------------------------------------------------------
Public Function BS() '二分查找自写的
Dim aaa(10000) As Integer
Dim goal As Integer
Dim j As Single
Dim i As Long
Dim p As Integer
p = 0
For i = 1 To 10000
aaa(i) = Int(Rnd * 50 + 50)
Next i
goal = 0
j = Timer
For i = 1 To 13000000
goal = Int(Rnd * 50 + 50)
p = binary_search(aaa, 10000, goal)
Next i
BS = Timer - j
End Function
‘-------------------------------------------------------------------------------------------------------------------
Public Function binary_search(ary2() As Integer, LEN1 As Integer, goal As Integer) 移植于 http://www.cnblogs.com/shuaiwhu/archive/2011/04/15/2065062.html
Dim low As Integer
Dim high As Integer
Dim middle As Integer
Dim t As Integer
t = 0
low = 0
high = LEN2 - 1
Do While (low <= high)
middle = (low + high) / 2
If ary2(middle) = goal Then
t = middle
Exit Do
ElseIf ary2(middle) > goal Then
high = middle - 1
t = 0
Else
low = middle + 1
t = 0
End If
Loop
binary_search = t
End Function

复制代码

十多年没写VB6了，不足请提出。

附件中 Test1.2(i5) vb6 为原版测试工具，工程2为以上代码生成的，体积小的是加了UPX壳的。

censtar · 发表于 2016-2-24 13:47:55

这样的测试方法不客观吧。

AllEle · 发表于 2016-2-24 14:43:58

mk一下慢慢看

zhaoyi821103 · 发表于 2016-2-25 14:16:53

I7-2600的，单线程3.8G，貌似调用强度根本不够大，性能超出老酷睿应该不止这点，

90999 · 发表于 2016-2-25 19:00:39

zhaoyi821103 发表于 2016-2-25 14:16
I7-2600的，单线程3.8G，貌似调用强度根本不够大，性能超出老酷睿应该不止这点， ...

请你用Test1.2(i5) vb6跑一下看看效果。

zhaoyi821103 · 发表于 2016-2-25 20:23:08

90999 发表于 2016-2-25 19:00
请你用Test1.2(i5) vb6跑一下看看效果。

这个貌似差多了

90999 · 发表于 2016-2-25 20:36:32

zhaoyi821103 发表于 2016-2-25 20:23
这个貌似差多了

可能是你运行时候后台东西太多或者开了自动睿频，这个单核性能和456带差好远， E3和4160基本整数都有2万出头，不过三代和四代性能是差10-15%的。

用VB6写的CPU性能测试工具

本帖子中包含更多资源

阿莫论坛20周年了！感谢大家的支持与爱护！！

本帖子中包含更多资源

本帖子中包含更多资源