将非常大的数字转换为十六进制字符串

Converting VERY large number to a hex string

Public Function MyMod(a As Double, b As Double) As Double
MyMod = a - Int(a / b) * b
End Function

此代码不起作用,因为它没有正确显示余数,然后可以计算 HEX。

正确:10009335357561071 / 16 = 62558345984756.69 VB6 MyMod returns 0 而不是有效余数。

我一直想不通如何将这么大的值转换成十六进制字符串?

VB6 中唯一方便 可以准确表示10009335357561071 的数据类型是 Variant 的 Decimal 子类型。 Double 和 Currency 本机类型都缺乏所需的精度。

还有处理有符号值的问题以及需要多少字节的精度,是否应抑制前导零,以及可能的其他问题。

很难想象在实际应用中需要这样做。

即使我们假设您正在做某事"especially special",或者如果某些讲师给您这个问题以帮助您进行一般理解...

...如果没有某种 BigNum 库,或者 possibly 谨慎使用 Decimal,您将无能为力,尽管它只会让您获得更多的精度。

这是一个工作示例(使用 Fix),不是我的,归功于 http://visualbasic.ittoolbox.com/groups/technical-functional/visualbasic-l/vb60-hex-function-overflow-error-2744358

Private Function MyHex(ByVal TempDec As Double) As String 
    Dim TNo As Integer 

    MyHex = "" 
    Do 
        TNo = TempDec - (Fix(TempDec / 16) * 16) 
        If TNo > 9 Then 
            MyHex = Chr(55 + TNo) & MyHex 
        Else 
            MyHex = TNo & MyHex 
        End If 
        TempDec = Fix(TempDec / 16) 
    Loop Until (TempDec = 0) 
End Function 

我能够自己编写代码。由于 vb6 对数字大小的限制,我不得不以不同的方式处理它。我需要它能够将非常大的整数转换为二进制和十六进制。

这段代码,你可以使用三个函数。 1) 十进制 2 十六进制 2) 二进制转十六进制 3) 十进制 2 二进制

该代码有效并为非常大的数字提供了正确的 returns。

Public Function Dec2Hex(Dec As String) As String
 Dec2Hex = Binary2Hex(Dec2Bin(Dec))
End Function

Public Function Binary2Hex(Binary As String, Optional Pos As Long = 0) As String
 Dim tic As Long
 Dim Sz As Long
 Dim x As Long
 Dim z As Long
 Dim AT As Long
 Dim Hx As Long
 Dim HxB As String
 Dim xstart As Long
 Dim xstop As Long

 HxB = vbNullString
 If InStrB(Binary, " ") <> 0 Then Binary = Replace(Binary, " ", "")
 Sz = Len(Binary)

 xstart = Sz
 xstop = xstart - 3

 Do
 AT = 0
 Hx = 0
 If xstop < 1 Then xstop = 1
 For x = xstart To xstop Step -1
   AT = AT + 1
   If AscB(Mid$(Binary, x, 1)) = 49 Then
     Select Case AT
        Case 1: Hx = Hx + 1
        Case 2: Hx = Hx + 2
        Case 3: Hx = Hx + 4
        Case 4: Hx = Hx + 8
     End Select
   End If
 Next x
 HxB = Digit2Hex(CStr(Hx)) + HxB
 If x <= 1 Then Exit Do
 xstart = x
 xstop = xstart - 3
 Loop
 Binary2Hex = HxB
End Function

Private Function Digit2Hex(digit As String) As String
 Select Case digit
   Case "0": Digit2Hex = "0"
   Case "1": Digit2Hex = "1"
   Case "2": Digit2Hex = "2"
   Case "3": Digit2Hex = "3"
   Case "4": Digit2Hex = "4"
   Case "5": Digit2Hex = "5"
   Case "6": Digit2Hex = "6"
   Case "7": Digit2Hex = "7"
   Case "8": Digit2Hex = "8"
   Case "9": Digit2Hex = "9"
   Case "10": Digit2Hex = "A"
   Case "11": Digit2Hex = "B"
   Case "12": Digit2Hex = "C"
   Case "13": Digit2Hex = "D"
   Case "14": Digit2Hex = "E"
   Case "15": Digit2Hex = "F"
   Case Else: Digit2Hex = vbNullString
 End Select
End Function

Public Function Dec2Bin(Dec As String) As String
 Dim Bin As String
 Dim Var As Variant
 Dim p As Long
 Dim Tmp As String

 Bin = vbNullString
 Tmp = Dec
 Do
  Bin = IIf(isEven(Tmp), "0", "1") + Bin
  Var = CDec(Tmp)
  Var = Var / 2
  Tmp = CStr(Var)
  p = InStr(Tmp, ".")
  If p > 0 Then Tmp = Mid(Tmp, 1, p - 1)
  If Len(Tmp) = 1 Then
   If CLng(Tmp) = 0 Then Exit Do
  End If
 Loop
 Dec2Bin = Bin
End Function

Public Function isEven(Dec As String) As Boolean
 Dim OE As Long
 Dim myDec As Variant

 OE = CLng(Right$(CStr(Dec), 1))
 isEven = (OE = 0 Or OE = 2 Or OE = 4 Or OE = 6 Or OE = 8)

End Function
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Function Dec2Hex(ByVal strDec As Variant) As String

Dim mybyte(0 To 19) As Byte
Dim lp As Long

CopyMemory mybyte(0), ByVal VarPtr(CDec(strDec)), 16

' Quick reorganise so we can then just step through the entire thing in one loop
For lp = 7 To 4 Step -1
    mybyte(12 + lp) = mybyte(lp)
Next

' Build the hex string
For lp = 19 To 8 Step -1
    If (Not Len(Dec2Hex) And mybyte(lp) <> 0) Or Len(Dec2Hex) Then
        'Dec2Hex = Dec2Hex & Format(hex(mybyte(lp)), IIf(Len(Dec2Hex), "00", "0"))
        Dec2Hex = Dec2Hex & IIf(Len(Dec2Hex), Right$("0" & hex(mybyte(lp)), 2), hex(mybyte(lp)))
    End If
Next

End Function