64位无符号整数

tlwh163

Option Explicit

''=====================================
''  无符号64位整数 类模块
''=====================================

''Decimal  类型 :  { 64-95位(4Byte), 00-31位(4Byte), 32-63位(4Byte) }
''Variant  类型 :  { 类型符[2Byte,固定=14], 小数位[1Byte], 符号位[1Byte], 数值区[Decimal,12Byte] }

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位 可以任意指定返回长度[1-256])
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

先留着  再说吧

想了想 其实目标定错了 应该是弄一个能装下 ULong 的类型出来就够了 ,,,

tlwh163

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
    Print
    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
    Print
    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
    Print
    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

nayiye00

学习一下!