7,763
社区成员
发帖
与我相关
我的任务
分享VB 进制转换问题 在线等 NNNNNN简单
Text1.Text = EthernetAddress(0) '显示 网卡号 为16进制
然后要把 网卡号转换10进制 怎么转换 给个相对这个程序的代码 谢谢
然后要把 网卡号转换10进制 怎么转换 给个相对这个程序的代码 谢谢
...全文
请发表友善的回复…
发表回复
aohan 2004-09-13
- 打赏
- 举报
TO northwolves(狼行天下)
不用客气，你写的东西很好，我就用过，所以现在有人要用，就直接给别人了，不要见怪，呵呵！
不用客气，你写的东西很好，我就用过，所以现在有人要用，就直接给别人了，不要见怪，呵呵！
dongge2000 2004-09-13
- 打赏
- 举报
Option Explicit
Public Function D_To_B(ByVal Dec As Long) As String
Do
D_To_B = Dec Mod 2 & D_To_B
Dec = Dec \ 2
Loop While Dec
End Function
Public Function B_To_D(ByVal Bin As String) As Currency
Dim i As Long
For i = 1 To Len(Bin)
B_To_D = B_To_D * 2 + Val(Mid(Bin, i, 1))
Next i
End Function
Public Function H_To_B(ByVal Hex As String) As String
Dim i As Long
Dim B As String
Hex = UCase(Hex)
For i = 1 To Len(Hex)
Select Case Mid(Hex, i, 1)
Case "0": B = B & "0000"
Case "1": B = B & "0001"
Case "2": B = B & "0010"
Case "3": B = B & "0011"
Case "4": B = B & "0100"
Case "5": B = B & "0101"
Case "6": B = B & "0110"
Case "7": B = B & "0111"
Case "8": B = B & "1000"
Case "9": B = B & "1001"
Case "A": B = B & "1010"
Case "B": B = B & "1011"
Case "C": B = B & "1100"
Case "D": B = B & "1101"
Case "E": B = B & "1110"
Case "F": B = B & "1111"
End Select
Next i
While Left(B, 1) = "0"
B = Right(B, Len(B) - 1)
Wend
H_To_B = B
End Function
Public Function B_To_H(ByVal Bin As String) As String
Dim i As Long
Dim H As String
If Len(Bin) Mod 4 <> 0 Then
Bin = String(4 - Len(Bin) Mod 4, "0") & Bin
End If
For i = 1 To Len(Bin) Step 4
Select Case Mid(Bin, i, 4)
Case "0000": H = H & "0"
Case "0001": H = H & "1"
Case "0010": H = H & "2"
Case "0011": H = H & "3"
Case "0100": H = H & "4"
Case "0101": H = H & "5"
Case "0110": H = H & "6"
Case "0111": H = H & "7"
Case "1000": H = H & "8"
Case "1001": H = H & "9"
Case "1010": H = H & "A"
Case "1011": H = H & "B"
Case "1100": H = H & "C"
Case "1101": H = H & "D"
Case "1110": H = H & "E"
Case "1111": H = H & "F"
End Select
Next i
B_To_H = H
End Function
Public Function D_To_B(ByVal Dec As Long) As String
Do
D_To_B = Dec Mod 2 & D_To_B
Dec = Dec \ 2
Loop While Dec
End Function
Public Function B_To_D(ByVal Bin As String) As Currency
Dim i As Long
For i = 1 To Len(Bin)
B_To_D = B_To_D * 2 + Val(Mid(Bin, i, 1))
Next i
End Function
Public Function H_To_B(ByVal Hex As String) As String
Dim i As Long
Dim B As String
Hex = UCase(Hex)
For i = 1 To Len(Hex)
Select Case Mid(Hex, i, 1)
Case "0": B = B & "0000"
Case "1": B = B & "0001"
Case "2": B = B & "0010"
Case "3": B = B & "0011"
Case "4": B = B & "0100"
Case "5": B = B & "0101"
Case "6": B = B & "0110"
Case "7": B = B & "0111"
Case "8": B = B & "1000"
Case "9": B = B & "1001"
Case "A": B = B & "1010"
Case "B": B = B & "1011"
Case "C": B = B & "1100"
Case "D": B = B & "1101"
Case "E": B = B & "1110"
Case "F": B = B & "1111"
End Select
Next i
While Left(B, 1) = "0"
B = Right(B, Len(B) - 1)
Wend
H_To_B = B
End Function
Public Function B_To_H(ByVal Bin As String) As String
Dim i As Long
Dim H As String
If Len(Bin) Mod 4 <> 0 Then
Bin = String(4 - Len(Bin) Mod 4, "0") & Bin
End If
For i = 1 To Len(Bin) Step 4
Select Case Mid(Bin, i, 4)
Case "0000": H = H & "0"
Case "0001": H = H & "1"
Case "0010": H = H & "2"
Case "0011": H = H & "3"
Case "0100": H = H & "4"
Case "0101": H = H & "5"
Case "0110": H = H & "6"
Case "0111": H = H & "7"
Case "1000": H = H & "8"
Case "1001": H = H & "9"
Case "1010": H = H & "A"
Case "1011": H = H & "B"
Case "1100": H = H & "C"
Case "1101": H = H & "D"
Case "1110": H = H & "E"
Case "1111": H = H & "F"
End Select
Next i
B_To_H = H
End Function
BlueBeer 2004-09-12
- 打赏
- 举报
哈哈，楼上的狼老师，你在这我就不现眼了^_^
northwolves 2004-09-12
- 打赏
- 举报
TO aohan(陈景升) ：
谢谢你称我为“网上的好心人”，我可是狼心！呵呵
http://community.csdn.net/Expert/topic/2974/2974472.xml?temp=.2603876
谢谢你称我为“网上的好心人”，我可是狼心！呵呵
http://community.csdn.net/Expert/topic/2974/2974472.xml?temp=.2603876
northwolves 2004-09-12
- 打赏
- 举报
对于12位的网卡序列号，下面的代码就够了：
Private Sub Command1_Click()
MsgBox hextodec("00E04CA48A32")
End Sub
Function hextodec(ByVal X As String) As Double
hextodec = CDbl("&H" & Left(X, 6)) * CDbl(16 ^ 6) + CDbl("&H" & Right(X, 6))
End Function
Private Sub Command1_Click()
MsgBox hextodec("00E04CA48A32")
End Sub
Function hextodec(ByVal X As String) As Double
hextodec = CDbl("&H" & Left(X, 6)) * CDbl(16 ^ 6) + CDbl("&H" & Right(X, 6))
End Function
rainstormmaster 2004-09-12
- 打赏
- 举报
//楼上的 不行 益出了
应该用aohan(陈景升) 的方法试试
应该用aohan(陈景升) 的方法试试
rainstormmaster 2004-09-12
- 打赏
- 举报
同意楼上
shashou47 2004-09-12
- 打赏
- 举报
楼上的 不行 益出了
00E04CA48A32 这个是网卡序列号
00E04CA48A32 这个是网卡序列号
tztz520 2004-09-12
- 打赏
- 举报
Private Sub Command1_Click()
Dim aa As String
Dim I As Single
aa = "12D687"
I = CLng("&H" & aa)
MsgBox I
'aa就是一个十六进制的数,用CLng("&H" & aa)转换为十进制
End Sub
Dim aa As String
Dim I As Single
aa = "12D687"
I = CLng("&H" & aa)
MsgBox I
'aa就是一个十六进制的数,用CLng("&H" & aa)转换为十进制
End Sub
aohan 2004-09-12
- 打赏
- 举报
十六进制转为十进制用VAL（）函数实现,如：
十进制结果= Val("&H" & 网卡16进数 & "")
如果数字很大则不能全部转换，用下面的一个程序实现，是网上的好心人写的，我们就用一下吧
Dim largehex As String, largedec As String, start As Long, Y(20) As String
'Ô¤±¸º¯Êý
Function sums(ByVal X As String, ByVal Y As String) As String ' sum of two hugehexnum£¨Á½¸ö´óÊýÖ®ºÍ£©
Dim max As Long, temp As Long, I As Long, result As Variant
max = IIf(Len(X) >= Len(Y), Len(X), Len(Y))
X = Right(String(max, "0") & X, max)
Y = Right(String(max, "0") & Y, max)
ReDim result(0 To max)
For I = max To 1 Step -1
result(I) = Val(Mid(X, I, 1)) + Val(Mid(Y, I, 1))
Next
For I = max To 1 Step -1
temp = result(I) \ 10
result(I) = result(I) Mod 10
result(I - 1) = result(I - 1) + temp
Next
If result(0) = 0 Then result(0) = ""
sums = Join(result, "")
Erase result
End Function
Function multi(ByVal X As String, ByVal Y As String) As String 'multi of two huge hexnum£¨Á½¸ö´óÊýÖ®»ý£©
Dim result As Variant
Dim xl As Long, yl As Long, temp As Long, I As Long
xl = Len(Trim(X))
yl = Len(Trim(Y))
ReDim result(1 To xl + yl)
For I = 1 To xl
For temp = 1 To yl
result(I + temp) = result(I + temp) + Val(Mid(X, I, 1)) * Val(Mid(Y, temp, 1))
Next
Next
For I = xl + yl To 2 Step -1
temp = result(I) \ 10
result(I) = result(I) Mod 10
result(I - 1) = result(I - 1) + temp
Next
If result(1) = "0" Then result(1) = ""
multi = Join(result, "")
Erase result
End Function
Function POWERS(ByVal X As Integer) As String ' GET 16777216^X,ie 16^(6*x)£¨16777216µÄX ´Î·½£©
POWERS = 1
Dim I As Integer
For I = 1 To X
POWERS = multi(POWERS, CLng(&H1000000))
Next
End Function
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 POWERXY(ByVal X As Integer, ByVal Y As Integer) As String 'GET X^Y£¨X µÄ Y ´Î·½£©
Dim I As Integer
POWERXY = X
For I = 2 To Y
POWERXY = multi(POWERXY, X)
Next
End Function
'½øÖÆת»»º¯Êý£º
'16 to 10
Function HEXTODEC(ByVal X As String) As String
Dim A() As String, I As Long, UNIT As Integer
For I = 1 To Len(X)
If Not IsNumeric("&h" & Mid(X, I, 1)) Then MsgBox "NOT A HEX FORMAT!", 64, "INFO": Exit Function
Next
X = String((6 - Len(X) Mod 6) Mod 6, "0") & X
UNIT = Len(X) \ 6 - 1
ReDim A(UNIT)
For I = 0 To UNIT
A(I) = CLng("&h" & Mid(X, I * 6 + 1, 6))
Next
For I = 0 To UNIT
A(I) = multi(A(I), POWERS(UNIT - I))
HEXTODEC = sums(HEXTODEC, A(I))
Next
End Function
' 10 to 16
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
Private Sub Form_Load()
For I = 0 To 20
Y(I) = "1234567890ABCDEF"
Next
largehex = Join(Y, "")
End Sub
'hextodec
Private Sub Command1_Click()
start = Timer
largedec = HEXTODEC(largehex)
Debug.Print largedec
MsgBox "hex(" & Len(largehex) & " λ): " & largehex & vbCrLf & vbCrLf & "dec(" & Len(largedec) & " λ): " & largedec, 64, "ÓÃʱ" & Format((Timer - start), "0.0000") & " Ã룡"
End Sub
'dectohex
Private Sub Command2_Click()
largedec = "27305594525408320787401222904174795936368587913861811995606068514338921239280447480038845811151419865392100570221250636783105942723266982313358992551204806603060637911792055430458953651997903849585424629638958641829173494438455892966522070157613386886352421847833413821003678138295449221439062614172249927946884678471687751616589458280098503446100701588657220466765694306218356144887228155732857434394095"
start = Timer
largehex = dectohex(largedec)
MsgBox "dec(" & Len(largedec) & " λ): " & largedec & vbCrLf & vbCrLf & "hex(" & Len(largehex) & " λ): " & largehex, 64, "ÓÃʱ" & Format((Timer - start), "0.0000") & " Ã룡"
End Sub
'get x^y
Private Sub Command3_Click()
start = Timer
MsgBox "2^3000=" & POWERXY(2, 3000), 64, "用时 Format((Timer - start), "0.0000") & " 秒¡"
End Sub
十进制结果= Val("&H" & 网卡16进数 & "")
如果数字很大则不能全部转换，用下面的一个程序实现，是网上的好心人写的，我们就用一下吧
Dim largehex As String, largedec As String, start As Long, Y(20) As String
'Ô¤±¸º¯Êý
Function sums(ByVal X As String, ByVal Y As String) As String ' sum of two hugehexnum£¨Á½¸ö´óÊýÖ®ºÍ£©
Dim max As Long, temp As Long, I As Long, result As Variant
max = IIf(Len(X) >= Len(Y), Len(X), Len(Y))
X = Right(String(max, "0") & X, max)
Y = Right(String(max, "0") & Y, max)
ReDim result(0 To max)
For I = max To 1 Step -1
result(I) = Val(Mid(X, I, 1)) + Val(Mid(Y, I, 1))
Next
For I = max To 1 Step -1
temp = result(I) \ 10
result(I) = result(I) Mod 10
result(I - 1) = result(I - 1) + temp
Next
If result(0) = 0 Then result(0) = ""
sums = Join(result, "")
Erase result
End Function
Function multi(ByVal X As String, ByVal Y As String) As String 'multi of two huge hexnum£¨Á½¸ö´óÊýÖ®»ý£©
Dim result As Variant
Dim xl As Long, yl As Long, temp As Long, I As Long
xl = Len(Trim(X))
yl = Len(Trim(Y))
ReDim result(1 To xl + yl)
For I = 1 To xl
For temp = 1 To yl
result(I + temp) = result(I + temp) + Val(Mid(X, I, 1)) * Val(Mid(Y, temp, 1))
Next
Next
For I = xl + yl To 2 Step -1
temp = result(I) \ 10
result(I) = result(I) Mod 10
result(I - 1) = result(I - 1) + temp
Next
If result(1) = "0" Then result(1) = ""
multi = Join(result, "")
Erase result
End Function
Function POWERS(ByVal X As Integer) As String ' GET 16777216^X,ie 16^(6*x)£¨16777216µÄX ´Î·½£©
POWERS = 1
Dim I As Integer
For I = 1 To X
POWERS = multi(POWERS, CLng(&H1000000))
Next
End Function
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 POWERXY(ByVal X As Integer, ByVal Y As Integer) As String 'GET X^Y£¨X µÄ Y ´Î·½£©
Dim I As Integer
POWERXY = X
For I = 2 To Y
POWERXY = multi(POWERXY, X)
Next
End Function
'½øÖÆת»»º¯Êý£º
'16 to 10
Function HEXTODEC(ByVal X As String) As String
Dim A() As String, I As Long, UNIT As Integer
For I = 1 To Len(X)
If Not IsNumeric("&h" & Mid(X, I, 1)) Then MsgBox "NOT A HEX FORMAT!", 64, "INFO": Exit Function
Next
X = String((6 - Len(X) Mod 6) Mod 6, "0") & X
UNIT = Len(X) \ 6 - 1
ReDim A(UNIT)
For I = 0 To UNIT
A(I) = CLng("&h" & Mid(X, I * 6 + 1, 6))
Next
For I = 0 To UNIT
A(I) = multi(A(I), POWERS(UNIT - I))
HEXTODEC = sums(HEXTODEC, A(I))
Next
End Function
' 10 to 16
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
Private Sub Form_Load()
For I = 0 To 20
Y(I) = "1234567890ABCDEF"
Next
largehex = Join(Y, "")
End Sub
'hextodec
Private Sub Command1_Click()
start = Timer
largedec = HEXTODEC(largehex)
Debug.Print largedec
MsgBox "hex(" & Len(largehex) & " λ): " & largehex & vbCrLf & vbCrLf & "dec(" & Len(largedec) & " λ): " & largedec, 64, "ÓÃʱ" & Format((Timer - start), "0.0000") & " Ã룡"
End Sub
'dectohex
Private Sub Command2_Click()
largedec = "27305594525408320787401222904174795936368587913861811995606068514338921239280447480038845811151419865392100570221250636783105942723266982313358992551204806603060637911792055430458953651997903849585424629638958641829173494438455892966522070157613386886352421847833413821003678138295449221439062614172249927946884678471687751616589458280098503446100701588657220466765694306218356144887228155732857434394095"
start = Timer
largehex = dectohex(largedec)
MsgBox "dec(" & Len(largedec) & " λ): " & largedec & vbCrLf & vbCrLf & "hex(" & Len(largehex) & " λ): " & largehex, 64, "ÓÃʱ" & Format((Timer - start), "0.0000") & " Ã룡"
End Sub
'get x^y
Private Sub Command3_Click()
start = Timer
MsgBox "2^3000=" & POWERXY(2, 3000), 64, "用时 Format((Timer - start), "0.0000") & " 秒¡"
End Sub
