```'二进制转十进制
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 Dec > 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,输出最大数为17777777777
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
' 输入的最大数为17777777777,输出的最大数为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 = Mid(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)))
i = i + 1
Else
strto = strto & Chr(AscB(MidB(str, i, 1)))
End If
Next
B2S = strto
End Function

Public Function V2H(ByVal sHex As String, Optional bUnicode As Boolean)
Dim sByte As Variant
Dim byChar() As Byte
Dim i As Long
sHex = Replace(sHex, vbCrLf, "")
sByte = Split(sHex, " ")
ReDim byChar(0 To UBound(sByte)) As Byte
For i = 0 To UBound(sByte)
byChar(i) = Val("&h" & sByte(i))
Next
If bUnicode Then
V2H = byChar
Else
V2H = StrConv(byChar, vbUnicode)
End If
End Function

'记录集转二进制流

Public Function R2B(rs As Recordset) As Variant              '记录集转换为二进制数据
Dim objStream As Stream
Set objStream = New Stream
objStream.Open
objStream.Position = 0
Set objStream = Nothing
End Function

'ASCII码转二进制流

Public Function A2B(str As String) As Variant
Dim a() As Byte, s As String
s = str
a = StrConv(s, vbFromUnicode) '字符串转换为byte型 'a 是byte数组，你可以在程序中调用 ，但不能在textbox中显示。
A2B = a
End Function

'二进制流转ASCII码

Public Function B2A(vData As Variant) As String
Dim s As String
s = StrConv(vData, vbUnicode) 'byte型转换为字符串
B2A = s
End Function
```

## VB 进制转换大全的更多相关文章

1. SQL Server 进制转换函数

一.背景 前段时间群里的朋友问了一个问题:“在查询时增加一个递增序列,如:0x00000001,即每一个都是36进位(0—9,A--Z),0x0000000Z后面将是0x00000010,生成一个像下 ...

2. [No000071]C# 进制转换（二进制、十六进制、十进制互转）

using System; using System.Collections.Generic; using System.Linq; using System.Text; using System.T ...

3. JS中的进制转换以及作用

js的进制转换, 分为2进制,8进制,10进制,16进制之间的相互转换, 我们直接利用 对象.toString()即可实现: //10进制转为16进制 ().toString() // =>&q ...

4. 结合stack数据结构，实现不同进制转换的算法

#!/usr/bin/env python # -*- coding: utf-8 -*- # learn <<Problem Solving with Algorithms and Da ...

5. 进制转换（ C++字符数组 ）

注: 较为简便的方法是用 整型(int)或浮点型(long.double 注意:该类型不一定能够准确存储数据) 来存放待转换的数值,可直接取余得到每一位数值 较为稳定的方法是用 字符数组储存待转换的数 ...

6. JS 进制转换

7. php的进制转换

学习了php的进制转换,有很多的知识点,逻辑,也有最原始的笔算,但是我们还是习惯使用代码来实现进制的转换,进制的转换代码有如下:二进制(bin)八进制( oct)十进制( dec)十六进制( hex) ...

8. C++ 中数串互转、进制转换的类

/******************************************************************** created: 2014/03/16 22:56 file ...

9. 【String与基本类型之间的转换】以及【进制转换】

1. 基本数据类型---->字符串类型: 方法一:使用连接一个空字符串,例如  基本数据类型+“” : 方法二:静态方法 String.valueOf(),具体有: String.valueOf ...

## 随机推荐

1. T-SQL：毕业生出门需知系列（八）

第8课 使用函数处理数据 8.1 函数 [名词]可移植:所编写的代码可以在多个系统上运行 8.2 使用函数 8.2.1 文本处理函数 例1:使用 UPPER() 函数--将文本转换为大写 SELECT ...

2. 04 DOM一窥

BOM 浏览器对象模型 * window       alert(); 弹出框 confirm() 询问框 setInterval("run()",1000); 每隔1秒执行run ...

3. MapReduce从HBase读写数据简单示例

就用单词计数这个例子,需要统计的单词存在HBase中的word表,MapReduce执行的时候从word表读取数据,统计结束后将结果写入到HBase的stat表中. 1.在eclipse中建立一个ha ...

4. hdu 1848 Fibonacci again and again （初写SG函数，详解）

思路: SG函数的应用,可取的值为不连续的固定值,可用GetSG求出SG,然后三堆数异或. SG函数相关注释见代码: 相关详细说明请结合前一篇博客: #include<stdio.h> # ...

5. python实现的文本编辑器 - Skycrab - 博客频道 - CSDN.NET

Download Qt, the cross-platform application framework | Qt Project Qt 5.2.1 for Windows 64-bit (VS 2 ...

6. 重写titleView

在一些特定的情况下不能使用原有的titleView需要重写titleView代码如下 #import "TitleView.h" @implementation TitleView ...

7. bochs模拟器创建映像文件 、写入文件并启动

安装 bochs,dd for windows,nasm,并将安装目录加入到环境变量中. 我用的bochs版本是2.6.8 1.用 bochs 中 bximage.exe 创建新的 img 文件 2. ...

8. HDU 4301 Divide Chocolate（DP）

http://acm.hdu.edu.cn/showproblem.php?pid=4301 题意: 有一块n*2大小的巧克力,现在某人要将这巧克力分成k个部分,每个部分大小随意,问有多少种分法. 思 ...

9. spring boot 整合pagehelper分页插件

Spring Boot 整合pagehelper分页插件 测试环境: spring boot  版本 2.0.0.M7 mybatis starter 版本  1.3.1 jdk 1.8 ------ ...

10. Python 基础进阶

函数的定义 函数的参数 函数的默认参数 函数的变量 函数的返回值 函数的多类型传值 函数的冗余参数 函数的递归调用 匿名函数 高阶函数 内建函数 模块与包 面向对象 类的定义 类的属性 类的内置属性 ...