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

Vb6 将非常大的数字转换为十六进制字符串,vb6,Vb6,这段代码不起作用,因为它没有正确地显示剩余部分,因此无法计算十六进制 正确:100093357561071/16=62558345984756.69 VB6 MyMod返回0而不是有效的余数 我一直不知道如何将如此大的值转换为十六进制字符串?VB6中唯一方便的数据类型是变量的十进制子类型,它可以准确地表示100093357561071。Double和Currency本机类型都缺少所需的精度 还有处理有符号值的问题,以及需要多少字节的精度,是否应抑制前导零,以及其他可能的问题 很难想象在实际应用中

这段代码不起作用,因为它没有正确地显示剩余部分,因此无法计算十六进制

正确:100093357561071/16=62558345984756.69 VB6 MyMod返回0而不是有效的余数

我一直不知道如何将如此大的值转换为十六进制字符串?

VB6中唯一方便的数据类型是变量的十进制子类型,它可以准确地表示
100093357561071
。Double和Currency本机类型都缺少所需的精度

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

很难想象在实际应用中会有这样的需求

即使我们假设你正在做一些“特别特别”的事情,或者如果某个讲师给你这个问题作为对一般理解的帮助

。。。如果没有某种类型的BigNum库,或者
可能
谨慎地使用Decimal,尽管它只会让您多获得几位数的精度,您就无法处理这个问题。

这是一个工作示例(使用Fix),它不是我的,这要归功于


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

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

代码可以工作,并为非常大的数字提供正确的返回

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 
公共函数Dec2Hex(Dec作为字符串)作为字符串
Dec2Hex=Binary2Hex(Dec2Bin(Dec))
端函数
公共函数Binary2Hex(二进制为字符串,可选位置为Long=0)为字符串
昏昏欲睡
暗Sz一样长
暗x等长
暗z一样长
暗淡无光
变暗Hx为长
Dim HxB As字符串
只要长一点就好
我的上衣和我的一样长
HxB=vbNullString
如果InStrB(Binary,“”)0,则Binary=Replace(Binary,“”,“”)
Sz=Len(二进制)
xstart=Sz
xstop=xstart-3
做
AT=0
Hx=0
如果xstop<1,则xstop=1
对于x=xstart到xstop步骤-1
AT=AT+1
如果AscB(Mid$(二进制,x,1))=49,则
选择案例在
案例1:Hx=Hx+1
案例2:Hx=Hx+2
案例3:Hx=Hx+4
案例4:Hx=Hx+8
结束选择
如果结束
下一个x
HxB=Digit2Hex(CStr(Hx))+HxB
如果x 0,则Tmp=Mid(Tmp,1,p-1)
如果Len(Tmp)=1,则
如果CLng(Tmp)=0,则退出Do
如果结束
环
Dec2Bin=Bin
端函数
公共函数isEven(Dec作为字符串)作为布尔值
只要
Dim-myDec作为变体
OE=CLng(右$(CStr(12月),1))
isEven=(OE=0或OE=2或OE=4或OE=6或OE=8)
端函数
Private声明子CopyMemory Lib“kernel32”别名“rtlmovemory”(目标为任意,源为任意,ByVal长度为任意)
私有函数Dec2Hex(ByVal strDec作为变量)作为字符串
将mybyte(0到19)设置为字节
变暗lp为长
CopyMemory mybyte(0),ByVal VarPtr(CDec(strDec)),16
“快速重组,这样我们就可以在一个循环中完成整个过程
对于lp=7到4,步骤-1
mybyte(12+lp)=mybyte(lp)
下一个
'构建十六进制字符串
对于lp=19到8步骤-1
如果(不是Len(Dec2Hex)和mybyte(lp)0)或Len(Dec2Hex),则
'Dec2Hex=Dec2Hex&格式(hex(mybyte(lp)),IIf(Len(Dec2Hex),“00”,“0”))
Dec2Hex=Dec2Hex&IIf(Len(Dec2Hex),Right$(“0”和hex(mybyte(lp)),2),hex(mybyte(lp)))
如果结束
下一个
端函数

我已编辑了您的标题。请参阅“”,其中的共识是“不,他们不应该”。使用
Fix
代替
Int
。Fix没有任何区别。我发现了这一点。它不适用于非常大的数字。示例:10009710016061665 to Hex应为238FC739CFE0E1,但上述函数输出:238FC739CFE0E0Hey,如果您可以使用较少的代码使is工作,我将非常乐意查看它。每次我使用VB6函数,比如fix或mod或任何类似的数学函数时,VB6都会将数字转换为指数值,从而使某件事情变得一团糟。要么余数不起作用,要么除法或匹配法计算不正确。谢谢。我必须在Dec2Bin函数中的循环之后添加以下内容:SizeOfBin=Len(Bin)OddNumberOfBits=SizeOfBin Mod 4 MissingBits=4-ExtraBits Bin=String(MissingBits,“0”)&BinI在我的上一个注释中犯了一个错误:SizeOfBin=Len(Bin)OddNumberOfBits=SizeOfBin Mod 4 MissingBits=4-oddnumberbits-Bin=String(MissingBits,“0”)&在原始代码中,402408974843904给出的是6DFD24000000,而不是16DFD24000000。
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 
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