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

Posted 2021-04-06

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返回0而不是有效的余数。

我一直无法弄清楚如何将如此大的值转换为十六进制字符串？

答案

我能够自己编写代码。由于数字大小的vb6限制，我不得不以不同的方式去做。我需要这个能够将非常大的数字转换为二进制和十六进制。

这段代码，您可以使用三种功能。 1）十进制2十六进制2）二进制到十六进制3）十进制2二进制

代码工作，并给我非常大数字的CORRECT返回。

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

另一答案

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

还有处理有符号值的问题，并且就此而言需要多少字节的精度，是否应该抑制前导零，以及可能是其他的。

在实际应用中很难想象出对此的需求。

即使我们假设你正在做“特别特别”的事情，或者某些教练给你这个问题作为一般理解的帮助......

...如果没有某种类型的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 

另一答案

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