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

时间:2015-06-15 03:29:50

标签: vb6

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

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

4 个答案:

答案 0 :(得分:1)

我能够自己编写代码。由于数字大小的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

答案 1 :(得分:0)

VB6中唯一能够准确表示10009335357561071方便数据类型是Variant的Decimal子类型。 Double和Currency原生类型都缺乏所需的精度。

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

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

即使我们假设你正在做某事&#34;特别特别&#34;或者如果某位导师给你这个问题作为对一般理解的帮助......

...如果没有某种类型的BigNum库,你可以做很多事情,或possibly使用Decimal时要小心谨慎,尽管它只能获得更多的精度数字。

答案 2 :(得分:0)

这是一个工作样本(使用修复),这不是我的,归功于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 

答案 3 :(得分:0)

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