64位无符号整数
本帖最后由 tlwh163 于 2024-12-4 19:39 编辑Option Explicit
''=====================================
''无符号64位整数 类模块
''=====================================
''Decimal类型 :{ 64-95位(4Byte), 00-31位(4Byte), 32-63位(4Byte) }
''Variant类型 :{ 类型符, 小数位, 符号位, 数值区 }
Private Q_100 As Variant 'CDec("18446744073709551616")'0x1_00000000_00000000
Private D_100 As Variant 'CDec("4294967296") '0x1_00000000
Private Q_7FF As Variant 'CDec("9223372036854775807") '0x7FFFFFFF_FFFFFFFF
Private D_7FF As Variant 'CDec("2147483647") '0x7FFFFFFF
Private Q_Ptr As Long 'QWord数值区低64位首地址
Private Q_VAR As Variant 'QWord缓存区(16字节的Variant)
Private Sub Class_Initialize()
Q_100 = CDec("18446744073709551616"): D_100 = CDec("4294967296")
Q_7FF = CDec("9223372036854775807"):D_7FF = CDec("2147483647")
Q_VAR = CDec(0): Q_Ptr = VarPtr(Q_VAR) + 8
End Sub
Private Sub Class_Terminate()
Q_Ptr = 0: Q_VAR = Empty: Q_100 = Empty
End Sub
''赋值(将参数传来的数据,导入为64位无符号数值)
Public Property Let ValueOf(w As Variant)
Dim x As Variant: x = w
CheckString x: CheckDecimal x: Q_VAR = x
End Property
''将传入的数据Variant转换为64位无符号整数形式的Decimal
Private Sub CheckDecimal(w As Variant)
If (VarType(w) And vbDecimal) <> vbDecimal Then
w = CDec(w)
End If: w = Fix(w) + 0'去掉小数部分并清除-0
If w < 0 Then
Select Case w '如果是负数
Case Is > -D_100: w = w + D_100 '取32位补码
Case Is > -Q_100: w = w + Q_100 '取64位补码
Case Else: Err.Raise 6 '溢出报错
End Select
End If '已经是正数
If w <= D_7FF Then GetMem2 VarPtr(3), w:Exit Sub '改为Long
If w <= Q_7FF Then GetMem2 VarPtr(20), w: Exit Sub '改为LongLong
If w >= Q_100 Then Err.Raise 6 '溢出报错
End Sub
''返回值(将64位无符号整数(Decimal或VT_I8)导出为Variant
Public Property Get ValueOf() As Variant
ValueOf = Q_VAR
End Property
Public Property Get VType() As VbVarType
GetMem2 Q_Ptr - 8, VType
End Property
Public Property Get VarPtrOf() As Long
VarPtrOf = Q_Ptr
End Property
Public Property Get toString() As String
toString = LTrim(Me.ValueOf)
End Property
''返回QWord的16进制字符串(Hex函数不支持超过32位 可以任意指定返回长度)
Public Property Get toHex(Optional ByVal n As Long = 0) As String
Dim a As String, x As Long, k1 As Long, k2 As Long: toHex = String(256, "0")
GetMem4 Q_Ptr + 0, x: If x Then a = Hex(x): k1 = Len(a): Mid(toHex, 257 - k1, k1) = a
GetMem4 Q_Ptr + 4, x: If x Then a = Hex(x): k2 = Len(a): Mid(toHex, 249 - k2, k2) = a
If n > 0 And n <= 256 Then k2 = n Else k2 = IIf(k2, k2 + 8, IIf(k1, k1, 1))
toHex = Mid(toHex, 257 - k2, k2)
End Property
''检测参数wVar类型,如果是字符串需要判断进制并提取出有效字符
Private Sub CheckString(w As Variant)
If (VarType(w) And vbString) <> vbString Then Exit Sub
If IsArray(w) Then w = Join(w)
If Len(w) = 0 Then w = 0: Exit Sub
Dim m As Long, c As Integer: m = StrPtr(w): GetMem2 m, c
While (c = 32 Or c = 9)
m = m + 2: GetMem2 m, c '跳过前导空白
Wend
Dim r As Long, s As Long
If c = 38 Then ' "&"
m = m + 2: GetMem2 m, c '猜测字符串数据的进制和正负
Select Case c
Case 72, 104: r = 16: m = m + 2: GetMem2 m, c
Case 79, 111: r = 8: m = m + 2: GetMem2 m, c
End Select
ElseIf c = 45 Or c = 43 Then ' "+" "-"
r = 10: s = (44 - c): m = m + 2: GetMem2 m, c
End If '跳过前导0
While c = 48: m = m + 2: GetMem2 m, c: Wend
Dim a() As Byte, k As Long: ReDim a(0 To Len(w))
Do'扫描数字部分,获得有效长度(避免类型不匹配)
Select Case c
Case 48 To 57:c = c - 48
Case 65 To 70:c = c - 55: If r = 0 Then r = 16
Case 97 To 102: c = c - 87: If r = 0 Then r = 16
Case Else: Exit Do
End Select
If (r > 0) And (c >= r) Then Exit Do
a(k) = c: k = k + 1: m = m + 2: GetMem2 m, c
Loop
w = CDec(0): If k = 0 Then Exit Sub
If r = 0 Then r = 10
For k = 0 To k - 1: w = w * r + a(k): Next
If s < 0 Then w = -w
End Sub 本帖最后由 tlwh163 于 2024-12-4 19:35 编辑
先留着再说吧
想了想 其实目标定错了 应该是弄一个能装下 ULong 的类型出来就够了 ,,, 本帖最后由 tlwh163 于 2024-12-4 19:33 编辑
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3030
ClientLeft = 120
ClientTop = 450
ClientWidth = 4560
LinkTopic = "Form1"
ScaleHeight = 3030
ScaleWidth = 4560
StartUpPosition = 3'窗口缺省
Begin VB.CommandButton Command5
Caption = "Command5"
Height = 345
Left = 1830
TabIndex = 5
Top = 1515
Width = 1170
End
Begin VB.CommandButton Command4
Caption = "Command4"
Height = 375
Left = 1875
TabIndex = 4
Top = 900
Width = 1110
End
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 375
Left = 405
TabIndex = 3
Top = 1905
Width = 975
End
Begin VB.CommandButton Command2
Caption = "Command2"
Height = 345
Left = 315
TabIndex = 2
Top = 1335
Width = 1125
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 375
Left = 375
TabIndex = 1
Top = 780
Width = 1125
End
Begin VB.TextBox Text1
Height = 345
Left = 1140
TabIndex = 0
Text = "Text1"
Top = 225
Width = 1440
End
Begin VB.Label Label1
Caption = "Label1"
Height = 270
Left = 660
TabIndex = 6
Top = 2595
Width = 1005
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
Command1.Enabled = False
Dim x As New QWord
x.ValueOf = Text1.Text
Print "UINT64 (DEC)", x.toString, "VT_" & x.VType
Print "UINT64 (HEX)", x.toHex
Me.Refresh
Command1.Enabled = True: Command1.SetFocus
End Sub
Private Sub Command2_Click()
Command2.Enabled = False
Dim x As New QWord
x.ValueOf = Text1.Text: Print "x = ", x.ValueOf, "VT_" & x.VType
x.ValueOf = Text1.Text: Print "x + 10 ", x.ValueOf + 10
x.ValueOf = Text1.Text: Print "x - 10 ", x.ValueOf - 10
x.ValueOf = Text1.Text: Print "x * 1.23 ", x.ValueOf * 1.23
x.ValueOf = x.ValueOf * 1.23: Print "x = x * 1.23", x.ValueOf
x.ValueOf = Text1.Text: Print "x / 13 ", x.ValueOf / 13
x.ValueOf = x.ValueOf / 13: Print "x = x / 13", x.ValueOf
Me.Refresh
Command2.Enabled = True: Command2.SetFocus
End Sub
Private Sub Command3_Click()
Command3.Enabled = False
Dim x As New QWord
x.ValueOf = Text1.Text: Print "x = ", x.ValueOf, "VT_" & x.VType
x.ValueOf = Text1.Text: Print "x Mod 10 ", x.ValueOf Mod 10
x.ValueOf = x.ValueOf Mod 10: Print "x = x Mod 10", x.ValueOf
x.ValueOf = Text1.Text: Print "x And 10 ", x.ValueOf And 10
x.ValueOf = x.ValueOf And 10: Print "x = x And 10", x.ValueOf
x.ValueOf = Text1.Text: Print "x Or 10 ", x.ValueOf Or 10
x.ValueOf = x.ValueOf Or 10: Print "x = x Or 10", x.ValueOf
x.ValueOf = Text1.Text: Print "x Xor 10 ", x.ValueOf Xor 10
x.ValueOf = x.ValueOf Xor 10: Print "x = x Xor 10", x.ValueOf
x.ValueOf = Text1.Text: Print "Not x ", Not x.ValueOf
x.ValueOf = Not x.ValueOf: Print "x = Not x ", x.ValueOf
Me.Refresh
Command3.Enabled = True: Command3.SetFocus
End Sub
Private Sub Form_DblClick()
Me.Cls
End Sub
Private Sub Form_Load()
Me.Width = Me.Width - Me.ScaleWidth + 640 * Screen.TwipsPerPixelX
Me.Height = Me.Height - Me.ScaleHeight + 480 * Screen.TwipsPerPixelY
Me.Caption = "unsigned int / int64 test"
Dim x As Integer, y As Integer, w As Integer, h As Integer
h = 300: w = 1800: x = Me.ScaleWidth - w - 180: y = 180
Text1.Move x, y, w, h: Text1.Text = "BCDEF0198765432": y = y + h + 180: h = 450
Command1.Move x, y, w, h: Command1.Caption = "Convert DEC/HEX": y = y + h + 180
Command2.Move x, y, w, h: Command2.Caption = "Add/Sub/Mul/Div": y = y + h + 180
Command3.Move x, y, w, h: Command3.Caption = "Mod/And/Or/Xor/Not": y = y + h + 180
Command4.Move x, y, w, h: Command4.Caption = "ToDo...": y = y + h + 180
Command5.Move x, y, w, h: Command5.Caption = "ToDo...": y = y + h + 180
Label1.Move 360, Me.ScaleHeight - 480, 3000, 300
Label1.Caption = "Double_Click to Cls Print...": Label1.ForeColor = vbRed
Me.AutoRedraw = True
End Sub
学习一下!
页:
[1]