进制转换VB代码

模块包含了下面的各种转换:
进制转十进制
二进制转化为十六进制
八进制转化为十进制
八进制转化为二进制
八进制转化为十六进制
十进制转二进制
十进制转化为八进制
十进制转化为十六进制
十六进制转化为二进制
十六进制转化为八进制
十六进制转化为十进制
16进制转ASC
10进制长整数转4位16进制字符串
10进制长整数转2位16进制字符串
ASCII字符串转16进制字符串
反16进制数转10进制数,共8位
反16进制数转10进制数,共6位
反16进制数转10进制数,共4位
10进制数转反16进制数,共8位
0进制数转反16进制数,共6位
10进制数转反16进制数,共4位
记录集转二进制流
ASCII码转二进制流
二进制流转ASCII码
VBScript code复制代码
'二进制转十进制
Public Function B2D(vBStr As String) As Long
Dim vLen As Integer  '串长
Dim vDec As Long    '结果
Dim vG As Long      '权值
Dim vI As Long      '位数
Dim vTmp As String  '临时串
Dim vN As Long      '中间值
vLen = Len(vBStr)
vG = 1 '初始权值
vDec = 0  '结果初值
B2D = vDec '返回初值
For vI = vLen To 1 Step -1
vTmp = Mid(vBStr, vI, 1) '取出当前位
vN = Val(vTmp)
If vN < 2 Then  '判断是不是合法二进制串,貌似不严谨,E文和符号会被判0而合法
vDec = vDec + vG * vN '得到中间结果
vG = vG + vG
Else
vDec = 0
'msgbox "不是有效的二进制数",vbokonly
Exit Function
End If
Next vI
B2D = vDec
End Function
'十进制转二进制
Public Function D2B(Dec As Long) As String
D2B = ""
Do While Dec > 0
D2B = Dec Mod 2 & D2B
Dec = Dec \ 2
Loop
End Function
' 用途:将十六进制转化为二进制
' 输入:Hex(十六进制数)
' 输入数据类型:String
' 输出:H2B(二进制数)
' 输出数据类型:String
' 输入的最大数为2147483647个字符
Public Function H2B(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
H2B = b
End Function
' 用途:将二进制转化为十六进制
' 输入:Bin(二进制数)
' 输入数据类型:String
' 输出:B2H(十六进制数)
' 输出数据类型:String
' 输入的最大数为2147483647个字符
Public Function B2H(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
While Left(H, 1) = "0"
H = Right(H, Len(H) - 1)
Wend
B2H = H
End Function
' 用途:将十六进制转化为十进制
' 输入:Hex(十六进制数)
' 输入数据类型:String
' 输出:H2D(十进制数)
' 输出数据类型:Long
' 输入的最大数为7FFFFFFF,输出的最大数为2147483647
Public Function H2D(ByVal Hex As String) As Long
Dim i As Long
Dim b As Long
Hex = UCase(Hex)
For i = 1 To Len(Hex)
Select Case Mid(Hex, Len(Hex) - i + 1, 1)
Case "0": b = b + 16 ^ (i - 1) * 0
Case "1": b = b + 16 ^ (i - 1) * 1
Case "2": b = b + 16 ^ (i - 1) * 2
Case "3": b = b + 16 ^ (i - 1) * 3
Case "4": b = b + 16 ^ (i - 1) * 4
Case "5": b = b + 16 ^ (i - 1) * 5
Case "6": b = b + 16 ^ (i - 1) * 6
Case "7": b = b + 16 ^ (i - 1) * 7
Case "8": b = b + 16 ^ (i - 1) * 8
Case "9": b = b + 16 ^ (i - 1) * 9
Case "A": b = b + 16 ^ (i - 1) * 10
Case "B": b = b + 16 ^ (i - 1) * 11
Case "C": b = b + 16 ^ (i - 1) * 12
Case "D": b = b + 16 ^ (i - 1) * 13
Case "E": b = b + 16 ^ (i - 1) * 14
Case "F": b = b + 16 ^ (i - 1) * 15
End Select
Next i
H2D = b
End Function
' 用途:将十进制转化为十六进制
' 输入:Dec(十进制数)
' 输入数据类型:Long
' 输出:D2H(十六进制数)
' 输出数据类型:String
' 输入的最大数为2147483647,输出最大数为7FFFFFFF
Public Function D2H(Dec As Long) As String
Dim a As String
D2H = ""
Do While De
c > 0
a = CStr(Dec Mod 16)
Select Case a
Case "10": a = "A"
Case "11": a = "B"
Case "12": a = "C"
Case "13": a = "D"
Case "14": a = "E"
Case "15": a = "F"
End Select
D2H = a & D2H
Dec = Dec \ 16
Loop
End Function
' 用途:将十进制转化为八进制
' 输入:Dec(十进制数)
' 输入数据类型:Long
' 输出:D2O(八进制数)
' 输出数据类型:String
' 输入的最大数为2147483647,输出最大数为177********
Public Function D2O(Dec As Long) As String
D2O = ""
Do While Dec > 0
D2O = Dec Mod 8 & D2O
Dec = Dec \ 8
Loop
End Function
' 用途:将八进制转化为十进制
' 输入:Oct(八进制数)
' 输入数据类型:String
' 输出:O2D(十进制数)
' 输出数据类型:Long
' 输入的最大数为177********,输出的最大数为2147483647
Public Function O2D(ByVal Oct As String) As Long
Dim i As Long
Dim b As Long
For i = 1 To Len(Oct)
Select Case Mid(Oct, Len(Oct) - i + 1, 1)
Case "0": b = b + 8 ^ (i - 1) * 0
Case "1": b = b + 8 ^ (i - 1) * 1
Case "2": b = b + 8 ^ (i - 1) * 2
Case "3": b = b + 8 ^ (i - 1) * 3
Case "4": b = b + 8 ^ (i - 1) * 4
Case "5": b = b + 8 ^ (i - 1) * 5
Case "6": b = b + 8 ^ (i - 1) * 6
Case "7": b = b + 8 ^ (i - 1) * 7
End Select
Next i
O2D = b
End Function
' 用途:将二进制转化为八进制
' 输入:Bin(二进制数)
' 输入数据类型:String
' 输出:B2O(八进制数)
' 输出数据类型:String
' 输入的最大数为2147483647个字符
Public Function B2O(ByVal Bin As String) As String
Dim i As Long
Dim H As String
If Len(Bin) Mod 3 <> 0 Then
Bin = String(3 - Len(Bin) Mod 3, "0") & Bin
End If
For i = 1 To Len(Bin) Step 3
Select Case Mid(Bin, i, 3)
Case "000": H = H & "0"
Case "001": H = H & "1"
Case "010": H = H & "2"
Case "011": H = H & "3"
Case "100": H = H & "4"
Case "101": H = H & "5"
Case "110": H = H & "6"
Case "111": H = H & "7"
End Select
Next i
While Left(H, 1) = "0"
H = Right(H, Len(H) - 1)
Wend
B2O = H
End Function
' 用途:将八进制转化为二进制
' 输入:Oct(八进制数)
' 输入数据类型:String
' 输出:O2B(二进制数)
' 输出数据类型:String
' 输入的最大数为2147483647个字符
Public Function O2B(ByVal Oct As String) As String
Dim i As Long
Dim b As String
For i = 1 To Len(Oct)
Select Case Mid(Oct, i, 1)
Case "0": b = b & "000"
Case "1": b = b & "001"
Case "2":
b = b & "010"
Case "3": b = b & "011"
Case "4": b = b & "100"
Case "5": b = b & "101"
Case "6": b = b & "110"
Case "7": b = b & "111"
End Select
Next i
While Left(b, 1) = "0"
b = Right(b, Len(b) - 1)
Wend
O2B = b
End Function
' 用途:将八进制转化为十六进制
' 输入:Oct(八进制数)
' 输入数据类型:String
' 输出:O2H(十六进制数)
' 输出数据类型:String
' 输入的最大数为2147483647个字符
Public Function O2H(ByVal Oct As String) As String
Dim Bin As String
Bin = O2B(Oct)
O2H = B2H(Bin)
End Function
' 用途:将十六进制转化为八进制
' 输入:Hex(十六进制数)
' 输入数据类型:String
' 输出:H2O(八进制数)
' 输出数据类型:String
' 输入的最大数为2147483647个字符
Public Function H2O(ByVal Hex As String) As String
Dim Bin As String
Hex = UCase(Hex)
Bin = H2B(Hex)
H2O = B2O(Bin)
End Function
'====================================================
'16进制转ASC
Function H2A(InputData As String) As String
Dim mydata
mydata = Chr(Val("&H" & InputData))
H2A = mydata
Exit Function
End Function
'10进制长整数转4位16进制字符串
Function S2H(Num As Long) As String
Dim mynum As String
mynum = Hex(Num)
If Len(mynum) = 1 Then mynum = "000" + mynum
If Len(mynum) = 2 Then mynum = "00" + mynum
If Len(mynum) = 3 Then mynum = "0" + Left(mynum, 2) + Right(mynum, 1)
If Len(mynum) = 4 Then mynum = Right(mynum, 2) + Left(mynum, 2)
S2H = mynum
End Function
'10进制长整数转2位16进制字符串
Function S2H2(Num As Long) As String
Dim mynum As String
mynum = Hex(Num)
If Len(mynum) = 1 Then mynum = "0" + mynum
S2H2 = mynum
End Function
'ASCII字符串转16进制字符串
Public Function A2H(str As String) As String
Dim strlen As Integer
Dim i As Integer
Dim mystr As String
mystr = ""
strlen = Len(str)
For i = 1 To strlen Step 1
mystr = mystr + Hex$(Asc(Mid(str, i, 1)))
Next i
A2H = mystr
End Function
'=====================================================
'进制反转
'=====================================================
'反16进制数转10进制数,共8位
Function FHexToInt(ByVal str As String) As String
Dim text1 As String
text1 = str
Dim text2 As String
text2 = Mid(text1, 7, 2)
Dim text3 As String
text3 = Mid(text1, 5, 2)
Dim text4 As String
text4 = Mid(text1, 3, 2)
Dim text5 As String
text5 = Mid(text1, 1, 2)
FHexToInt = Val("&H" & text2 & text3 & text4 & text5)
Exit Function
代码转换
End Function
'反16进制数转10进制数,共6位
Function FHexToInt6(ByVal str As String) As String
Dim text1 As String
text1 = str
Dim text2 As String
text2 = Mid(text1, 5, 2)
Dim text4 As String
text3 = Mid(text1, 3, 2)
Dim text5 As String
text4 = Mi
d(text1, 1, 2)
FHexToInt6 = Val("&H" & text2 & text3 & text4)
Exit Function
End Function
'反16进制数转10进制数,共4位
Function FHexToInt4(ByVal str As String) As String
Dim text1 As String
text1 = str
Dim text2 As String
text2 = Mid(text1, 3, 2)
Dim text4 As String
text3 = Mid(text1, 1, 2)
FHexToInt4 = Val("&H" & text2 & text3)
Exit Function
End Function
'10进制数转反16进制数,共8位
Function IntToFHex(ByVal nums As Long) As String
Dim text1 As String
'text1 = Convert.ToString(nums, &H10)
text1 = O2H(nums)
If (Len(text1) = 1) Then
text1 = ("0000000" & text1)
End If
If (Len(text1) = 2) Then
text1 = ("000000" & text1)
End If
If (Len(text1) = 3) Then
text1 = ("00000" & text1)
End If
If (Len(text1) = 4) Then
text1 = ("0000" & text1)
End If
If (Len(text1) = 5) Then
text1 = ("000" & text1)
End If
If (Len(text1) = 6) Then
text1 = ("00" & text1)
End If
If (Len(text1) = 7) Then
text1 = ("0" & text1)
End If
Dim text2 As String
text2 = Mid(text1, 7, 2)
Dim text3 As String
text3 = Mid(text1, 5, 2)
Dim text4 As String
text4 = Mid(text1, 3, 2)
Dim text5 As String
text5 = Mid(text1, 1, 2)
IntToFHex = text2 & text3 & text4 & text5
Exit Function
End Function
'10进制数转反16进制数,共6位
Function IntToFHex6(ByVal nums As Long) As String
Dim text1 As String
text1 = O2H(nums)
If (Len(text1) = 1) Then
text1 = ("00000" & text1)
End If
If (Len(text1) = 2) Then
text1 = ("0000" & text1)
End If
If (Len(text1) = 3) Then
text1 = ("000" & text1)
End If
If (Len(text1) = 4) Then
text1 = ("00" & text1)
End If
If (Len(text1) = 5) Then
text1 = ("0" & text1)
End If
Dim text2 As String
text2 = Mid(text1, 5, 2)
Dim text3 As String
text3 = Mid(text1, 3, 2)
Dim text4 As String
text4 = Mid(text1, 1, 2)
IntToFHex6 = text2 & text3 & text4
Exit Function
End Function
'10进制数转反16进制数,共4位
Function IntToFHex4(ByVal nums As Long) As String
Dim text1 As String
text1 = O2H(nums)
If (Len(text1) = 1) Then
text1 = ("000" & text1)
End If
If (Len(text1) = 2) Then
text1 = ("00" & text1)
End If
If (Len(text1) = 3) Then
text1 = ("0" & text1)
End If
Dim text2 As String
text2 = Mid(text1, 3, 2)
Dim text3 As String
text3 = Mid(text1, 1, 2)
IntToFHex4 = text2 & text3
Exit Function
End Function
'==========================================
Public Function B2S(ByVal str As Byte)
strto = ""
For i = 1 To LenB(str)
If AscB(MidB(str, i, 1)) > 127 Then
strto = strto & Chr(AscB(MidB(str, i, 1)) * 256 + AscB(MidB(str, i + 1, 1)))

本文发布于:2024-09-21 15:47:57,感谢您对本站的认可!

本文链接:https://www.17tex.com/tex/2/377192.html

版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系,我们将在24小时内删除。

标签:进制   二进制   转化   八进制   代码
留言与评论(共有 0 条评论)
   
验证码:
Copyright ©2019-2024 Comsenz Inc.Powered by © 易纺专利技术学习网 豫ICP备2022007602号 豫公网安备41160202000603 站长QQ:729038198 关于我们 投诉建议