7,763
社区成员
发帖
与我相关
我的任务
分享进制转换问题
如何将一个16位甚至更大的十进制数转成十六进制，比如把123456789123456789，转成16进制，给出可行算法即可。
PS：也许问题的解决方法很简单，可是我没想到，只好高分悬赏了。
PS：必须用vb
PS：up有分
PS：也许问题的解决方法很简单，可是我没想到，只好高分悬赏了。
PS：必须用vb
PS：up有分
...全文
请发表友善的回复…
发表回复
ricemaster 2003-03-25
- 打赏
- 举报
恩，研究一下，不过，谢谢捧场先：）
yjplus 2003-03-21
- 打赏
- 举报
其实这是一个没有必要做的事情，当然Cooly(Lazy)给出的代码是不错的，直接用内存存储的数据进行转换的思路真挺好，但是是否可以用迭代的方法？除16求余的方法？
fbmsf 2003-03-21
- 打赏
- 举报
用数组来做大的数，然后用辗转相除的方法来实现
Tenner 2003-03-21
- 打赏
- 举报
Public Function Bin2Oct(BinNum As String) As String
'二进制数转八进制数
Dim m_lngCounter As Long '计数器
Dim m_strInteger As String '整数部分
Dim m_strFloat As String '小数部分
Dim m_strIntegerA As String '转换后的整数部分
Dim m_strFloatA As String '转换后的小数部分
If IsLegal(BinNum, 2) = False Then Exit Function '不合法数据
Call SeparatePoint(BinNum, m_strInteger, m_strFloat)
m_strInteger = FillZero(m_strInteger, 3, False)
m_strFloat = FillZero(m_strFloat, 3, True)
For m_lngCounter = 1 To Len(m_strInteger) Step 3
m_strIntegerA = m_strIntegerA & BinByte2OctByte(Mid(m_strInteger, m_lngCounter, 3))
Next m_lngCounter
For m_lngCounter = 1 To Len(m_strFloat) Step 3
m_strFloatA = m_strFloatA & BinByte2OctByte(Mid(m_strFloat, m_lngCounter, 3))
Next m_lngCounter
Bin2Oct = m_strIntegerA & c_strPoint & m_strFloatA
End Function
Public Function Hex2Bin(HexNum As String) As String
'十六进制数转二进制数
Dim m_lngCounter As Long '计数器
Dim m_strInteger As String '整数部分
Dim m_strFloat As String '小数部分
Dim m_strIntegerA As String '转换后的整数部分
Dim m_strConv As String '中间转换字串
Dim m_strFloatA As String '转换后的小数部分
If IsLegal(HexNum, 16) = False Then Exit Function '不合法数据
Call SeparatePoint(HexNum, m_strInteger, m_strFloat)
For m_lngCounter = 1 To Len(m_strInteger)
m_strConv = Byte2BinByte(Mid(m_strInteger, m_lngCounter, 1))
If m_lngCounter <> 1 Then m_strConv = String(4 - Len(m_strConv), "0") & m_strConv
m_strIntegerA = m_strIntegerA & m_strConv
Next m_lngCounter
For m_lngCounter = 1 To Len(m_strFloat)
m_strConv = Byte2BinByte(Mid(m_strFloat, m_lngCounter, 1))
m_strConv = String(4 - Len(m_strConv), "0") & m_strConv
m_strFloatA = m_strFloatA & m_strConv
Next m_lngCounter
Hex2Bin = m_strIntegerA & IIf(m_strFloat = vbNullString, vbNullString, c_strPoint) & RTrimZero(m_strFloatA)
End Function
Public Function Oct2Bin(OctNum As String) As String
'八进制数转二进制数
Dim m_lngCounter As Long '计数器
Dim m_strInteger As String '整数部分
Dim m_strFloat As String '小数部分
Dim m_strIntegerA As String '转换后的整数部分
Dim m_strConv As String '中间转换字串
Dim m_strFloatA As String '转换后的小数部分
If IsLegal(OctNum, 8) = False Then Exit Function '不合法数据
Call SeparatePoint(OctNum, m_strInteger, m_strFloat)
For m_lngCounter = 1 To Len(m_strInteger)
m_strConv = Byte2BinByte(Mid(m_strInteger, m_lngCounter, 1))
If m_lngCounter <> 1 Then m_strConv = String(3 - Len(m_strConv), "0") & m_strConv
m_strIntegerA = m_strIntegerA & m_strConv
Next m_lngCounter
For m_lngCounter = 1 To Len(m_strFloat)
m_strConv = Byte2BinByte(Mid(m_strFloat, m_lngCounter, 1))
m_strConv = String(3 - Len(m_strConv), "0") & m_strConv
m_strFloatA = m_strFloatA & m_strConv
Next m_lngCounter
Oct2Bin = m_strIntegerA & IIf(m_strFloat = vbNullString, vbNullString, c_strPoint) & RTrimZero(m_strFloatA)
End Function
Public Function Hex2Dec(HexNum As String) As Double
'十六进制数转十进制数
If IsLegal(HexNum, 16) = False Then Exit Function '不合法数据
Hex2Dec = Bin2Dec(Hex2Bin(HexNum))
End Function
Public Function Oct2Dec(OctNum As String) As Double
'八进制数转十进制数
If IsLegal(OctNum, 8) = False Then Exit Function '不合法数据
Oct2Dec = Bin2Dec(Oct2Bin(OctNum))
End Function
Private Function IsLegal(Number As String, Base As Integer) As Boolean
'判断数据是否合法
Dim m_lngCounter As Long '计数器
Dim m_lngCounterA As Long '计数器
Dim m_strChar As String '字符
'判断长度
If Number = vbNullString Then
IsLegal = False
Exit Function
End If
'判断小数点是否合法
m_lngCounter = InStr(1, Number, c_strPoint)
If m_lngCounter <> 0 Then
If InStr(m_lngCounter + 1, Number, c_strPoint) <> 0 Or _
Left(Number, 1) = c_strPoint Or _
Right(Number, 1) = c_strPoint Then
IsLegal = False
Exit Function
End If
End If
'判断数字是否合法
For m_lngCounter = 1 To Len(Number)
For m_lngCounterA = 1 To Base
m_strChar = UCase(Mid(Number, m_lngCounter, 1))
If GetCharNum(m_strChar) > Base - 1 Then
IsLegal = False
Exit Function
End If
Next m_lngCounterA
Next m_lngCounter
IsLegal = True
End Function
Private Function GetNumChar(Number As Integer) As String
'数字对应位
If Number < 10 Then
GetNumChar = CStr(Number)
Else
GetNumChar = Chr(vbKeyA + Number - 10)
End If
End Function
Private Function GetCharNum(Char As String) As Integer
'位对应数字
If Asc(Char) >= vbKey0 And Asc(Char) <= vbKey9 Then
GetCharNum = CInt(Char)
Else
GetCharNum = Asc(Char) - vbKeyA + 10
End If
End Function
Private Sub SeparatePoint(Number As String, IntegerPart As String, FloatPart As String)
'分离整数与小数部分
Dim m_lngCounter As Long '计数器
m_lngCounter = InStr(1, Number, c_strPoint)
If m_lngCounter <> 0 Then
IntegerPart = Mid(Number, 1, m_lngCounter - 1)
FloatPart = Mid(Number, m_lngCounter + 1)
Else
IntegerPart = Number
FloatPart = vbNullString
End If
End Sub
Private Function BinByte2HexByte(BinByte As String) As String
'二进制字节转十六进制字节
Dim m_intCounter As Integer '计数器
Dim m_intNum As Integer '数值
For m_intCounter = 1 To 4
m_intNum = m_intNum + CInt(Mid(BinByte, m_intCounter, 1)) * 2 ^ (4 - m_intCounter)
Next m_intCounter
BinByte2HexByte = Hex(m_intNum)
End Function
Private Function BinByte2OctByte(BinByte As String) As String
'二进制字节转八进制字节
Dim m_intCounter As Integer '计数器
Dim m_intNum As Integer '数值
For m_intCounter = 1 To 3
m_intNum = m_intNum + CInt(Mid(BinByte, m_intCounter, 1)) * 2 ^ (3 - m_intCounter)
Next m_intCounter
BinByte2OctByte = CStr(m_intNum)
End Function
Private Function Byte2BinByte(ByteChar As String) As String
'其它进制字节转二进制字节
Byte2BinByte = Dec2BaseN(CCur(GetCharNum(ByteChar)), 2, 0)
End Function
Private Function FillZero(Number As String, FillNum As Integer, FillAfter As Boolean) As String
'填充“0”
If FillAfter = False Then
FillZero = String(((Len(Number) + FillNum - 1) \ FillNum) * FillNum - Len(Number), "0") & Number
Else
FillZero = Number & String(((Len(Number) + FillNum - 1) \ FillNum) * FillNum - Len(Number), "0")
End If
End Function
Private Function RTrimZero(Target As String) As String
'去掉最右边的“0”
Dim m_lngCounter As Long '计数器
If Target = vbNullString Then Exit Function
For m_lngCounter = Len(Target) To 1 Step -1
If Mid(Target, m_lngCounter, 1) <> "0" Then
RTrimZero = Mid(Target, 1, m_lngCounter)
Exit Function
End If
Next m_lngCounter
End Function
'二进制数转八进制数
Dim m_lngCounter As Long '计数器
Dim m_strInteger As String '整数部分
Dim m_strFloat As String '小数部分
Dim m_strIntegerA As String '转换后的整数部分
Dim m_strFloatA As String '转换后的小数部分
If IsLegal(BinNum, 2) = False Then Exit Function '不合法数据
Call SeparatePoint(BinNum, m_strInteger, m_strFloat)
m_strInteger = FillZero(m_strInteger, 3, False)
m_strFloat = FillZero(m_strFloat, 3, True)
For m_lngCounter = 1 To Len(m_strInteger) Step 3
m_strIntegerA = m_strIntegerA & BinByte2OctByte(Mid(m_strInteger, m_lngCounter, 3))
Next m_lngCounter
For m_lngCounter = 1 To Len(m_strFloat) Step 3
m_strFloatA = m_strFloatA & BinByte2OctByte(Mid(m_strFloat, m_lngCounter, 3))
Next m_lngCounter
Bin2Oct = m_strIntegerA & c_strPoint & m_strFloatA
End Function
Public Function Hex2Bin(HexNum As String) As String
'十六进制数转二进制数
Dim m_lngCounter As Long '计数器
Dim m_strInteger As String '整数部分
Dim m_strFloat As String '小数部分
Dim m_strIntegerA As String '转换后的整数部分
Dim m_strConv As String '中间转换字串
Dim m_strFloatA As String '转换后的小数部分
If IsLegal(HexNum, 16) = False Then Exit Function '不合法数据
Call SeparatePoint(HexNum, m_strInteger, m_strFloat)
For m_lngCounter = 1 To Len(m_strInteger)
m_strConv = Byte2BinByte(Mid(m_strInteger, m_lngCounter, 1))
If m_lngCounter <> 1 Then m_strConv = String(4 - Len(m_strConv), "0") & m_strConv
m_strIntegerA = m_strIntegerA & m_strConv
Next m_lngCounter
For m_lngCounter = 1 To Len(m_strFloat)
m_strConv = Byte2BinByte(Mid(m_strFloat, m_lngCounter, 1))
m_strConv = String(4 - Len(m_strConv), "0") & m_strConv
m_strFloatA = m_strFloatA & m_strConv
Next m_lngCounter
Hex2Bin = m_strIntegerA & IIf(m_strFloat = vbNullString, vbNullString, c_strPoint) & RTrimZero(m_strFloatA)
End Function
Public Function Oct2Bin(OctNum As String) As String
'八进制数转二进制数
Dim m_lngCounter As Long '计数器
Dim m_strInteger As String '整数部分
Dim m_strFloat As String '小数部分
Dim m_strIntegerA As String '转换后的整数部分
Dim m_strConv As String '中间转换字串
Dim m_strFloatA As String '转换后的小数部分
If IsLegal(OctNum, 8) = False Then Exit Function '不合法数据
Call SeparatePoint(OctNum, m_strInteger, m_strFloat)
For m_lngCounter = 1 To Len(m_strInteger)
m_strConv = Byte2BinByte(Mid(m_strInteger, m_lngCounter, 1))
If m_lngCounter <> 1 Then m_strConv = String(3 - Len(m_strConv), "0") & m_strConv
m_strIntegerA = m_strIntegerA & m_strConv
Next m_lngCounter
For m_lngCounter = 1 To Len(m_strFloat)
m_strConv = Byte2BinByte(Mid(m_strFloat, m_lngCounter, 1))
m_strConv = String(3 - Len(m_strConv), "0") & m_strConv
m_strFloatA = m_strFloatA & m_strConv
Next m_lngCounter
Oct2Bin = m_strIntegerA & IIf(m_strFloat = vbNullString, vbNullString, c_strPoint) & RTrimZero(m_strFloatA)
End Function
Public Function Hex2Dec(HexNum As String) As Double
'十六进制数转十进制数
If IsLegal(HexNum, 16) = False Then Exit Function '不合法数据
Hex2Dec = Bin2Dec(Hex2Bin(HexNum))
End Function
Public Function Oct2Dec(OctNum As String) As Double
'八进制数转十进制数
If IsLegal(OctNum, 8) = False Then Exit Function '不合法数据
Oct2Dec = Bin2Dec(Oct2Bin(OctNum))
End Function
Private Function IsLegal(Number As String, Base As Integer) As Boolean
'判断数据是否合法
Dim m_lngCounter As Long '计数器
Dim m_lngCounterA As Long '计数器
Dim m_strChar As String '字符
'判断长度
If Number = vbNullString Then
IsLegal = False
Exit Function
End If
'判断小数点是否合法
m_lngCounter = InStr(1, Number, c_strPoint)
If m_lngCounter <> 0 Then
If InStr(m_lngCounter + 1, Number, c_strPoint) <> 0 Or _
Left(Number, 1) = c_strPoint Or _
Right(Number, 1) = c_strPoint Then
IsLegal = False
Exit Function
End If
End If
'判断数字是否合法
For m_lngCounter = 1 To Len(Number)
For m_lngCounterA = 1 To Base
m_strChar = UCase(Mid(Number, m_lngCounter, 1))
If GetCharNum(m_strChar) > Base - 1 Then
IsLegal = False
Exit Function
End If
Next m_lngCounterA
Next m_lngCounter
IsLegal = True
End Function
Private Function GetNumChar(Number As Integer) As String
'数字对应位
If Number < 10 Then
GetNumChar = CStr(Number)
Else
GetNumChar = Chr(vbKeyA + Number - 10)
End If
End Function
Private Function GetCharNum(Char As String) As Integer
'位对应数字
If Asc(Char) >= vbKey0 And Asc(Char) <= vbKey9 Then
GetCharNum = CInt(Char)
Else
GetCharNum = Asc(Char) - vbKeyA + 10
End If
End Function
Private Sub SeparatePoint(Number As String, IntegerPart As String, FloatPart As String)
'分离整数与小数部分
Dim m_lngCounter As Long '计数器
m_lngCounter = InStr(1, Number, c_strPoint)
If m_lngCounter <> 0 Then
IntegerPart = Mid(Number, 1, m_lngCounter - 1)
FloatPart = Mid(Number, m_lngCounter + 1)
Else
IntegerPart = Number
FloatPart = vbNullString
End If
End Sub
Private Function BinByte2HexByte(BinByte As String) As String
'二进制字节转十六进制字节
Dim m_intCounter As Integer '计数器
Dim m_intNum As Integer '数值
For m_intCounter = 1 To 4
m_intNum = m_intNum + CInt(Mid(BinByte, m_intCounter, 1)) * 2 ^ (4 - m_intCounter)
Next m_intCounter
BinByte2HexByte = Hex(m_intNum)
End Function
Private Function BinByte2OctByte(BinByte As String) As String
'二进制字节转八进制字节
Dim m_intCounter As Integer '计数器
Dim m_intNum As Integer '数值
For m_intCounter = 1 To 3
m_intNum = m_intNum + CInt(Mid(BinByte, m_intCounter, 1)) * 2 ^ (3 - m_intCounter)
Next m_intCounter
BinByte2OctByte = CStr(m_intNum)
End Function
Private Function Byte2BinByte(ByteChar As String) As String
'其它进制字节转二进制字节
Byte2BinByte = Dec2BaseN(CCur(GetCharNum(ByteChar)), 2, 0)
End Function
Private Function FillZero(Number As String, FillNum As Integer, FillAfter As Boolean) As String
'填充“0”
If FillAfter = False Then
FillZero = String(((Len(Number) + FillNum - 1) \ FillNum) * FillNum - Len(Number), "0") & Number
Else
FillZero = Number & String(((Len(Number) + FillNum - 1) \ FillNum) * FillNum - Len(Number), "0")
End If
End Function
Private Function RTrimZero(Target As String) As String
'去掉最右边的“0”
Dim m_lngCounter As Long '计数器
If Target = vbNullString Then Exit Function
For m_lngCounter = Len(Target) To 1 Step -1
If Mid(Target, m_lngCounter, 1) <> "0" Then
RTrimZero = Mid(Target, 1, m_lngCounter)
Exit Function
End If
Next m_lngCounter
End Function
Tenner 2003-03-21
- 打赏
- 举报
给出一个本人自己写的，数制转换模块
以前写的，可以实现二、八、十六进制的无限位转换，但十进制限最大为Currency型，在此仅供参考，转换包括小数部分的转换
Option Explicit
Private Const c_strPoint As String = "."
Private Const c_intBaseNMax As Integer = 16 '最大进制
Public Function Dec2BaseN(DecNum As Currency, BaseN As Integer, NAfter As Integer) As String
'十进制数转任意进制
Dim m_curInteger As Currency '整数部分
Dim m_dblFloat As Double '小数部分
Dim m_strInteger As String '结果整数部分
Dim m_strFloat As String '结果小数部分
Dim m_intCounter As Integer '计数器
If BaseN > c_intBaseNMax Or BaseN < 2 Then Exit Function '进制不正确
m_curInteger = Fix(DecNum)
m_dblFloat = CSng(DecNum - m_curInteger)
Do While (m_curInteger > 0)
m_strInteger = GetNumChar((m_curInteger / BaseN - Fix(m_curInteger / BaseN)) * BaseN) & m_strInteger
m_curInteger = Fix(m_curInteger / BaseN)
Loop
Do While (m_intCounter < NAfter)
m_strFloat = m_strFloat & GetNumChar(Fix(m_dblFloat * BaseN))
m_dblFloat = m_dblFloat * BaseN - Fix(m_dblFloat * BaseN)
m_intCounter = m_intCounter + 1
Loop
Dec2BaseN = m_strInteger & IIf(m_strFloat = vbNullString, vbNullString, c_strPoint) & m_strFloat
End Function
Public Function Bin2Dec(BinNum As String) As Double
'二进制数转十进制数
Dim m_lngCounter As Long '计数器
Dim m_strInteger As String '整数部分
Dim m_strFloat As String '小数部分
Dim m_curInteger As Currency '整数数字
Dim m_sngFloat As Single '小数数字
If IsLegal(BinNum, 2) = False Then Exit Function '不合法数据
Call SeparatePoint(BinNum, m_strInteger, m_strFloat)
For m_lngCounter = 1 To Len(m_strInteger)
m_curInteger = m_curInteger + CLng(Mid(m_strInteger, m_lngCounter, 1)) * (2 ^ (Len(m_strInteger) - m_lngCounter))
Next m_lngCounter
For m_lngCounter = 1 To Len(m_strFloat)
m_sngFloat = m_sngFloat + CLng(Mid(m_strFloat, m_lngCounter, 1)) * (2 ^ (-m_lngCounter))
Next m_lngCounter
Bin2Dec = CDbl(m_curInteger) + CDbl(m_sngFloat)
End Function
Public Function Bin2Hex(BinNum As String) As String
'二进制数转十六进制数
Dim m_lngCounter As Long '计数器
Dim m_strInteger As String '整数部分
Dim m_strFloat As String '小数部分
Dim m_strIntegerA As String '转换后的整数部分
Dim m_strFloatA As String '转换后的小数部分
If IsLegal(BinNum, 2) = False Then Exit Function '不合法数据
Call SeparatePoint(BinNum, m_strInteger, m_strFloat)
m_strInteger = FillZero(m_strInteger, 4, False)
m_strFloat = FillZero(m_strFloat, 4, True)
For m_lngCounter = 1 To Len(m_strInteger) Step 4
m_strIntegerA = m_strIntegerA & BinByte2HexByte(Mid(m_strInteger, m_lngCounter, 4))
Next m_lngCounter
For m_lngCounter = 1 To Len(m_strFloat) Step 4
m_strFloatA = m_strFloatA & BinByte2HexByte(Mid(m_strFloat, m_lngCounter, 4))
Next m_lngCounter
Bin2Hex = m_strIntegerA & c_strPoint & m_strFloatA
End Function
以前写的，可以实现二、八、十六进制的无限位转换，但十进制限最大为Currency型，在此仅供参考，转换包括小数部分的转换
Option Explicit
Private Const c_strPoint As String = "."
Private Const c_intBaseNMax As Integer = 16 '最大进制
Public Function Dec2BaseN(DecNum As Currency, BaseN As Integer, NAfter As Integer) As String
'十进制数转任意进制
Dim m_curInteger As Currency '整数部分
Dim m_dblFloat As Double '小数部分
Dim m_strInteger As String '结果整数部分
Dim m_strFloat As String '结果小数部分
Dim m_intCounter As Integer '计数器
If BaseN > c_intBaseNMax Or BaseN < 2 Then Exit Function '进制不正确
m_curInteger = Fix(DecNum)
m_dblFloat = CSng(DecNum - m_curInteger)
Do While (m_curInteger > 0)
m_strInteger = GetNumChar((m_curInteger / BaseN - Fix(m_curInteger / BaseN)) * BaseN) & m_strInteger
m_curInteger = Fix(m_curInteger / BaseN)
Loop
Do While (m_intCounter < NAfter)
m_strFloat = m_strFloat & GetNumChar(Fix(m_dblFloat * BaseN))
m_dblFloat = m_dblFloat * BaseN - Fix(m_dblFloat * BaseN)
m_intCounter = m_intCounter + 1
Loop
Dec2BaseN = m_strInteger & IIf(m_strFloat = vbNullString, vbNullString, c_strPoint) & m_strFloat
End Function
Public Function Bin2Dec(BinNum As String) As Double
'二进制数转十进制数
Dim m_lngCounter As Long '计数器
Dim m_strInteger As String '整数部分
Dim m_strFloat As String '小数部分
Dim m_curInteger As Currency '整数数字
Dim m_sngFloat As Single '小数数字
If IsLegal(BinNum, 2) = False Then Exit Function '不合法数据
Call SeparatePoint(BinNum, m_strInteger, m_strFloat)
For m_lngCounter = 1 To Len(m_strInteger)
m_curInteger = m_curInteger + CLng(Mid(m_strInteger, m_lngCounter, 1)) * (2 ^ (Len(m_strInteger) - m_lngCounter))
Next m_lngCounter
For m_lngCounter = 1 To Len(m_strFloat)
m_sngFloat = m_sngFloat + CLng(Mid(m_strFloat, m_lngCounter, 1)) * (2 ^ (-m_lngCounter))
Next m_lngCounter
Bin2Dec = CDbl(m_curInteger) + CDbl(m_sngFloat)
End Function
Public Function Bin2Hex(BinNum As String) As String
'二进制数转十六进制数
Dim m_lngCounter As Long '计数器
Dim m_strInteger As String '整数部分
Dim m_strFloat As String '小数部分
Dim m_strIntegerA As String '转换后的整数部分
Dim m_strFloatA As String '转换后的小数部分
If IsLegal(BinNum, 2) = False Then Exit Function '不合法数据
Call SeparatePoint(BinNum, m_strInteger, m_strFloat)
m_strInteger = FillZero(m_strInteger, 4, False)
m_strFloat = FillZero(m_strFloat, 4, True)
For m_lngCounter = 1 To Len(m_strInteger) Step 4
m_strIntegerA = m_strIntegerA & BinByte2HexByte(Mid(m_strInteger, m_lngCounter, 4))
Next m_lngCounter
For m_lngCounter = 1 To Len(m_strFloat) Step 4
m_strFloatA = m_strFloatA & BinByte2HexByte(Mid(m_strFloat, m_lngCounter, 4))
Next m_lngCounter
Bin2Hex = m_strIntegerA & c_strPoint & m_strFloatA
End Function
northwolves 2003-03-21
- 打赏
- 举报
对字符串进行运算应该有很宽的范围。
x = "1234567890"
For i = 1 To 100
num = num & x
Next
dectohex(num)=7845F900EECA8BAAE1426FC89F8541D52924B6E2A775A35A25B3E60A635A7B53EFA03EDE4F7D2B478568D5562E306B8120EE6C90AF3A740CC5360FB23B4DF84C14CFC5FA2B3927ACBD5FED6436D5E01BA11A139C78FF4781CAEB2928FCCA4480858D1EBC547F56C935CD7A3E072CB0CF7F8B7475ED0CA82D5B5B45B5C0362303B7133FDB63F19BE1C34871F91BCB8AB5845AEC95DEDBF7B709AB1F830F25EC864A73085C245D6C45EDBC6E0E13CA7838696A5AF93C7E71716D6925E667D8FE112E0034498BC0ACD8ABFA818EB0C9C6422B5D0BF0D55F5B73615FD5B39CDC4425A3EE42379B6927D2E2D9D62763D91F38A6B48C5EBD459149BDFB04AE111C014582216E7CBFC354D9D4D3D7A14DCBBC97B1BAD5BEA6BFCB80AC6FB40D87C1E20466E21A45A4F767654ED486E577C3DED8ACA9DE65B9A6C88A8D5AC3C1D9344F7D5B11EF14AA33A2E91886016C1B52B4A1CC3D596211CA69989822599C69EC74058396B78F33F3F307F17731C348EA26FC29D18352DDC3F190BD986F50D5E5E7EB001B51E3B725A501C2A01788A9935E243D1161EF7BF14BACCFF196CE3F0AD2
100个1234567890首尾相连，转换为16进制为830位，PII266，64M内存用时16秒
x = "1234567890"
For i = 1 To 100
num = num & x
Next
dectohex(num)=7845F900EECA8BAAE1426FC89F8541D52924B6E2A775A35A25B3E60A635A7B53EFA03EDE4F7D2B478568D5562E306B8120EE6C90AF3A740CC5360FB23B4DF84C14CFC5FA2B3927ACBD5FED6436D5E01BA11A139C78FF4781CAEB2928FCCA4480858D1EBC547F56C935CD7A3E072CB0CF7F8B7475ED0CA82D5B5B45B5C0362303B7133FDB63F19BE1C34871F91BCB8AB5845AEC95DEDBF7B709AB1F830F25EC864A73085C245D6C45EDBC6E0E13CA7838696A5AF93C7E71716D6925E667D8FE112E0034498BC0ACD8ABFA818EB0C9C6422B5D0BF0D55F5B73615FD5B39CDC4425A3EE42379B6927D2E2D9D62763D91F38A6B48C5EBD459149BDFB04AE111C014582216E7CBFC354D9D4D3D7A14DCBBC97B1BAD5BEA6BFCB80AC6FB40D87C1E20466E21A45A4F767654ED486E577C3DED8ACA9DE65B9A6C88A8D5AC3C1D9344F7D5B11EF14AA33A2E91886016C1B52B4A1CC3D596211CA69989822599C69EC74058396B78F33F3F307F17731C348EA26FC29D18352DDC3F190BD986F50D5E5E7EB001B51E3B725A501C2A01788A9935E243D1161EF7BF14BACCFF196CE3F0AD2
100个1234567890首尾相连，转换为16进制为830位，PII266，64M内存用时16秒
northwolves 2003-03-21
- 打赏
- 举报
不会吧，dectobin(string(1000,"9")) 运行18"可以算出啊。
northwolves 2003-03-21
- 打赏
- 举报
'刚写的代码，理论上可以转换非常大的数字，大家试试：
Private Sub Form_Click()
Dim start As Long
Const hugenum = "1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890"
start = Timer
MsgBox dectohex(hugenum), , "it take me about " & Format((Timer - start), "0.0000") & " seconds to trans the hugenum to hex"
End Sub
Function half(ByVal x As String) As String 'get half of x
x = 0 & x
Dim i As Long
ReDim result(2 To Len(x)) As String
For i = 2 To Len(x)
result(i) = CStr(Val(Mid(x, i, 1)) \ 2 + IIf(Val(Mid(x, i - 1, 1)) Mod 2 = 1, 5, 0))
Next
half = Join(result, "")
If Left(half, 1) = "0" Then half = Right(half, Len(half) - 1) ' no zero ahead
End Function
Function dectohex(ByVal hugenum As String) As String ' trans hugenum to hex
Do While Len(hugenum) > 2
dectohex = Hex(Val(Right(hugenum, 4)) Mod 16) & dectohex
For i = 1 To 4 'devide hugenum by 16
hugenum = half(hugenum)
Next
Loop
dectohex = Hex(Val(hugenum)) & dectohex
End Function
'八进制，二进制同理
Function dectooct(ByVal hugenum As String) As String ' trans hugenum to oct
Do While Len(hugenum) > 1
dectooct = Oct(Val(Right(hugenum, 3)) Mod 8) & dectooct
For i = 1 To 3 'devide hugenum by 8
hugenum = half(hugenum)
Next
Loop
dectooct = Oct(Val(hugenum)) & dectooct
End Function
Function dectobin(ByVal hugenum As String) As String ' trans hugenum to bin
Do While Not hugenum = "1"
dectobin = Val(Right(hugenum, 1)) Mod 2 & dectobin
hugenum = half(hugenum) 'devide hugenum by 16
dectobin = "1" & dectobin
End Function
Private Sub Form_Click()
Dim start As Long
Const hugenum = "1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890"
start = Timer
MsgBox dectohex(hugenum), , "it take me about " & Format((Timer - start), "0.0000") & " seconds to trans the hugenum to hex"
End Sub
Function half(ByVal x As String) As String 'get half of x
x = 0 & x
Dim i As Long
ReDim result(2 To Len(x)) As String
For i = 2 To Len(x)
result(i) = CStr(Val(Mid(x, i, 1)) \ 2 + IIf(Val(Mid(x, i - 1, 1)) Mod 2 = 1, 5, 0))
Next
half = Join(result, "")
If Left(half, 1) = "0" Then half = Right(half, Len(half) - 1) ' no zero ahead
End Function
Function dectohex(ByVal hugenum As String) As String ' trans hugenum to hex
Do While Len(hugenum) > 2
dectohex = Hex(Val(Right(hugenum, 4)) Mod 16) & dectohex
For i = 1 To 4 'devide hugenum by 16
hugenum = half(hugenum)
Next
Loop
dectohex = Hex(Val(hugenum)) & dectohex
End Function
'八进制，二进制同理
Function dectooct(ByVal hugenum As String) As String ' trans hugenum to oct
Do While Len(hugenum) > 1
dectooct = Oct(Val(Right(hugenum, 3)) Mod 8) & dectooct
For i = 1 To 3 'devide hugenum by 8
hugenum = half(hugenum)
Next
Loop
dectooct = Oct(Val(hugenum)) & dectooct
End Function
Function dectobin(ByVal hugenum As String) As String ' trans hugenum to bin
Do While Not hugenum = "1"
dectobin = Val(Right(hugenum, 1)) Mod 2 & dectobin
hugenum = half(hugenum) 'devide hugenum by 16
dectobin = "1" & dectobin
End Function
lxcc 2003-03-21
- 打赏
- 举报
up
chenyu5188 2003-03-21
- 打赏
- 举报
UP
ricemaster 2003-03-21
- 打赏
- 举报
TO all
现在看来，从内存里读，是最好的算法了，现在我只是想抛砖引玉，把这个问题作为一个纯技术的研究来讨论一下。
还有，我的看法，只要用到除法，都是没法支持比较大的数的，即使理论上是正确的，实际做起来还是慢的很。
现在看来，从内存里读，是最好的算法了，现在我只是想抛砖引玉，把这个问题作为一个纯技术的研究来讨论一下。
还有，我的看法，只要用到除法，都是没法支持比较大的数的，即使理论上是正确的，实际做起来还是慢的很。
Cooly 2003-03-21
- 打赏
- 举报
不对啊，你的算法依然超不出Double型的长度。15位左右
northwolves 2003-03-21
- 打赏
- 举报
'少了个loop
Function dectobin(ByVal hugenum As String) As String ' trans hugenum to bin
Do While Not hugenum = "1"
dectobin = Val(Right(hugenum, 1)) Mod 2 & dectobin
hugenum = half(hugenum) 'devide hugenum by 16
loop
dectobin = "1" & dectobin
End Function
Function dectobin(ByVal hugenum As String) As String ' trans hugenum to bin
Do While Not hugenum = "1"
dectobin = Val(Right(hugenum, 1)) Mod 2 & dectobin
hugenum = half(hugenum) 'devide hugenum by 16
loop
dectobin = "1" & dectobin
End Function
gang75 2003-03-21
- 打赏
- 举报
up
ricemaster 2003-03-20
- 打赏
- 举报
TO Tenner(Tenner)
Cooly(Lazy) 给的算法已经很快了啊，就是不支持更大的数了。
Cooly(Lazy) 给的算法已经很快了啊，就是不支持更大的数了。
carl__yao 2003-03-20
- 打赏
- 举报
UP,需要研究.
Tenner 2003-03-19
- 打赏
- 举报
如果楼主想纯用VB代码实现，只有自己写算法了，而且速度不会快的
ricemaster 2003-03-19
- 打赏
- 举报
TO wu_yongcai(浪人) ：
谢谢，不过对于一个比较大的数（不好意思，刚才的写错了），就算改成加法，速度上还是很慢的啊
谢谢，不过对于一个比较大的数（不好意思，刚才的写错了），就算改成加法，速度上还是很慢的啊
ricemaster 2003-03-19
- 打赏
- 举报
TO Cooly(Lazy) :
谢谢你的代码，没怎么看懂，：P，你的代码最多也只能支持20多位的吧，要是再长的数，我应该修改什么地方？
TO wu_yongcai(浪人) ：
谢谢，不过对于一个比较的的数，就算改成加法，速度上还是很慢的啊
谢谢你的代码，没怎么看懂，：P，你的代码最多也只能支持20多位的吧，要是再长的数，我应该修改什么地方？
TO wu_yongcai(浪人) ：
谢谢，不过对于一个比较的的数，就算改成加法，速度上还是很慢的啊
wu_yongcai 2003-03-18
- 打赏
- 举报
我原来写的一个16进制的加法，你可以改造一下：你可以把大数化成N个2147483648（7FFFFFFF）相加即可，速度问题自己考虑，应该不是很慢。
Public Function HexAdd(sHexA As String, sHexB As String) As String
Dim i As Integer
Dim tmpA As String
Dim tmpB As String
Dim bAdd As Boolean
Dim strA() As String
Dim strB() As String
Dim strResult() As String
Dim strLen As Integer
On Error GoTo Err_Exit
tmpA$ = sHexA$
tmpB$ = sHexB$
bAdd = False
i = InStr(UCase$(sHexA$), "&H")
If i <> 0 Then
tmpA$ = Right$(Trim$(sHexA$), Len(sHexA$) - 2)
End If
i = InStr(UCase$(sHexB$), "&H")
If i <> 0 Then
tmpB$ = Right$(Trim$(sHexB$), Len(sHexB$) - 2)
End If
If Len(tmpA$) > Len(tmpB$) Then
strLen = Len(tmpA$)
tmpB$ = String(Len(tmpA$) - Len(tmpB$), "0") + tmpB$
Else
strLen = Len(tmpB$)
tmpA$ = String(Len(tmpB$) - Len(tmpA$), "0") + tmpA$
End If
ReDim strA$(1 To strLen)
ReDim strB$(1 To strLen)
For i = 1 To strLen
strA$(i) = Mid(tmpA$, i, 1)
strB$(i) = Mid(tmpB$, i, 1)
Next
Dim tmp$
ReDim strResult$(0 To strLen)
For i = strLen To 1 Step -1
If bAdd Then
tmp$ = Hex(CDec("&H" + strA$(i)) + CDec("&H" + strB$(i)) + 1)
Else
tmp$ = Hex(CDec("&H" + strA$(i)) + CDec("&H" + strB$(i)))
End If
If Len(tmp$) > 1 Then
bAdd = True
Else
bAdd = False
End If
strResult$(i) = Right$(tmp$, 1)
Next
If Len(tmp$) > 1 Then
strResult(i) = "1"
End If
tmp$ = ""
For i = 0 To strLen
tmp$ = tmp$ + strResult(i)
Next
'HexAdd = "&H" + tmp$
HexAdd = tmp$
Exit Function
Err_Exit:
HexAdd = ""
End Function
Public Function HexAdd(sHexA As String, sHexB As String) As String
Dim i As Integer
Dim tmpA As String
Dim tmpB As String
Dim bAdd As Boolean
Dim strA() As String
Dim strB() As String
Dim strResult() As String
Dim strLen As Integer
On Error GoTo Err_Exit
tmpA$ = sHexA$
tmpB$ = sHexB$
bAdd = False
i = InStr(UCase$(sHexA$), "&H")
If i <> 0 Then
tmpA$ = Right$(Trim$(sHexA$), Len(sHexA$) - 2)
End If
i = InStr(UCase$(sHexB$), "&H")
If i <> 0 Then
tmpB$ = Right$(Trim$(sHexB$), Len(sHexB$) - 2)
End If
If Len(tmpA$) > Len(tmpB$) Then
strLen = Len(tmpA$)
tmpB$ = String(Len(tmpA$) - Len(tmpB$), "0") + tmpB$
Else
strLen = Len(tmpB$)
tmpA$ = String(Len(tmpB$) - Len(tmpA$), "0") + tmpA$
End If
ReDim strA$(1 To strLen)
ReDim strB$(1 To strLen)
For i = 1 To strLen
strA$(i) = Mid(tmpA$, i, 1)
strB$(i) = Mid(tmpB$, i, 1)
Next
Dim tmp$
ReDim strResult$(0 To strLen)
For i = strLen To 1 Step -1
If bAdd Then
tmp$ = Hex(CDec("&H" + strA$(i)) + CDec("&H" + strB$(i)) + 1)
Else
tmp$ = Hex(CDec("&H" + strA$(i)) + CDec("&H" + strB$(i)))
End If
If Len(tmp$) > 1 Then
bAdd = True
Else
bAdd = False
End If
strResult$(i) = Right$(tmp$, 1)
Next
If Len(tmp$) > 1 Then
strResult(i) = "1"
End If
tmp$ = ""
For i = 0 To strLen
tmp$ = tmp$ + strResult(i)
Next
'HexAdd = "&H" + tmp$
HexAdd = tmp$
Exit Function
Err_Exit:
HexAdd = ""
End Function
加载更多回复（7）
