精华内容
下载资源
问答
  • 二进制十进制转换VB函数 '返回二进制数对应的十进制数值
  • vb 二进制转十进制代码 不懂如何转换,求详细的过程。大神求带,大神求带,大神求带,大神求带,大神求带,
  • vb 十进制转二进制

    千次阅读 2016-04-28 17:42:59
    vb 十进制转二进制
    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码

    代码如下:

    '二进制转十进制
    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.Type = adTypeBinary
    rs.Save objStream, adPersistADTG
    objStream.Position = 0
    R2B = objStream.Read()
    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相关


    VB 读写TXT文本文件函数

    VB 提取TextBox 文本框中指定一行字符串

    VB 获取汉字拼音的首字母

    VB 汉字字符串转换成拼音

    VB判断指定名字的进程是否存在函数

    VB 两种方法实现热键

    VB 使用SendMessage枚举文件与目录

    VB 二进制数组与十六进制字符串相互转换

    VB 二进制数据读写实例

    VB 进制转换大全(十进制、十六进制、八进制、二进制、二进制流)互转

    VB 判断是否文本文件

    VB 读取UTF-8编码文件函数

    VB 按指定编码格式写入文本文件

    VB UTF-8 URL编码函数

    VB 实现UTF-8 GB2312互转

    VB 设置ListView中指定一行的背景颜色

    VB SendMessage向其他程序窗口发送字符串消息实例

    VB Listview导出到CSV文件函数

    vb卸载所有窗体

    VBNull, Empty, Nothing, and vbNullString的区别

    利用API函数计算程序运行时间VB

    获取快捷方式原文件路径vb路径

    利用VB函数Dir()实现递归搜索目录

    VB数组的清除和重新定义

    RtlAdjustPrivilege来调整进程权限(VB6.0代码)

    获取对象的接口信息(方法/属性/事件)(VB6代码)

    VB6中给数组赋值的限制

    [vb]一些窗口消息的详解

    VB直接播放EXE文件中的声音文件

    VB中利用CopyMemory使用指针

    VB读写注册表的三种方法

    [VB]SaveSetting 语句 和 DeleteSetting 语句

    VB APP对象属性一览表 + 灵活使用VBAPP对象

    [vb]SendMessageA函数

    使用VB绘制抛物线动画曲线

    关于vb中的容器

    [vb]利用WScript.Shell对象隐藏cmd命令行运行

    浅析VB For Each.Next语句

    VB中窗体模块、标准模块、类模块的区别

    引用 VB类模块

    VB中什么是类,类模块有什么作用

    VB SendKeys 语句

    VB 全局热键

    VB轻松调用其他程序

    vb读取txt文件到textbox

    如何去优化你的VB程序3

    如何去优化你的VB程序2

    如何去优化你的VB程序1

    [VB]在状态栏中显示帮助信息

    [VB]把屏幕保存为图像

    Mp3Play.ocx控件让音乐之声响起来


    更多精彩>>>
    展开全文
  • 二进制转十进制 二进制转化为八进制 二进制转化为十六进制 八进制转化为十进制 八进制转化为二进制 八进制转化为十六进制 十进制转二进制 十进制转化为八进制 十进制转化为十六进制 十六进制转化为二...

     

    原文地址:http://www.newxing.com/Tech/Program/VisualBasic/748.html
    模块包含了下面的各种转换:
    
    
    二进制转十进制
    二进制转化为八进制
    二进制转化为十六进制
    
    八进制转化为十进制
    八进制转化为二进制
    八进制转化为十六进制
    
    十进制转二进制
    十进制转化为八进制
    十进制转化为十六进制
    
    十六进制转化为二进制
    十六进制转化为八进制
    十六进制转化为十进制
    
    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 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.Type = adTypeBinary
        rs.Save objStream, adPersistADTG
        objStream.Position = 0
        R2B = objStream.Read()
        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
    

    展开全文
  • 二进制转十进制 二进制转化为八进制 二进制转化为十六进制 八进制转化为十进制 八进制转化为二进制 八进制转化为十六进制 十进制转二进制 十进制转化为八进制 十进制转化为十六进制 十六进制转化为二...

    原文地址:http://www.newxing.com/Tech/Program/VisualBasic/748.html
    模块包含了下面的各种转换:
    
    
    二进制转十进制
    二进制转化为八进制
    二进制转化为十六进制
    
    八进制转化为十进制
    八进制转化为二进制
    八进制转化为十六进制
    
    十进制转二进制
    十进制转化为八进制
    十进制转化为十六进制
    
    十六进制转化为二进制
    十六进制转化为八进制
    十六进制转化为十进制
    
    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 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.Type = adTypeBinary
        rs.Save objStream, adPersistADTG
        objStream.Position = 0
        R2B = objStream.Read()
        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做界面的二进制计算器。可以自己在写上十六进制和八进制转换!
  • 在.NET Framework中,System.Convert类中的ToString方法和ToInt32(ToInt64)方法都可以方便的实现各种进制间的相互转换。...即可以将十进制整数转换成二进制、八进制、十进制(无实际意义)或十...
  • 本文主要介绍的是VB十进制,八进制,十六进制,二进制相互转换大全
  • 本源码演示vb6.0在十进制二进制、八进制、十六进制等多种进制间的转换,同时还可进行十进制数分解,使用时,只需在右侧任意一个方框中输入需要转换的数字,点击“确定”按钮即可实现转换,转换记录会显示在左侧的...
  • VB进制转换程序,可进行以下四种进制相互转换:二进制、四进制、十六进制、十进制,界面简洁,操作方便,示例演示截图如图所示。
  • VB源程序 十进制二进制的转换
  • vb十转二进制

    2014-10-25 17:42:14
    vb直接把十进制的数字转换成二进制。这是本人第一个上传的文件,请大家赏个脸下载,谢谢!
  • VB 进制转换大全

    2019-09-27 16:43:19
    '二进制转十进制 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...
  • VB代码十进制小数转二进制? 一个十进制转二进制的函数 Public Function D2B(D As Integer) As String D2B = "" Do While D > 0 D2B = D Mod 2 & D2B D = D \ 2 Loop End Function Private Sub Form_Load...
  • 十进制转换二进制(原码) 收藏 计算机是采用二进制存储的,计算机的二进制编码方式也分为原码,反码,补码方法。这是一个把十进制数字转换到它的二进制原码的算法,希望能给大家一些启发吧!这个算法我是用VB6写的,...
  • 十进制转换二进制(原码)

    千次阅读 2010-11-12 21:03:00
    十进制转换二进制(原码) 收藏  计算机是采用二进制存储的,计算机的二进制编码方式也分为原码,反码,补码方法。这是一个把十进制数字转换到它的二进制原码的算法,希望能给大家一些启发吧!这个算法我...
  • ’十进制转二进制的步骤是将十进制数除以二然直到商为0,然后反向读取余数。请问要怎么获取余数呢? ’如何让程序自动判断输入数字的正负 以确定变为反码时是否需要将零变为1,将一变为零? ’如何进行二进制...
  • VB转二进制

    2009-08-10 18:23:00
    可以将十进制转换成二进制Public Function Bin(num) As StringDim H As StringDim s As Integer H = Hex(num) 成十六进制Dim str, binstr As String For i = 1 To Len(H) str = Mid(H, i, 1) Select Case ...
  • 十进制/十六进制/二进制 间的转换1,十进制转十六进制Function Dec2Hex(value As String) As String value = Trim$(value) If Len(value) = 0 Then Dec2Hex = "" Else Dec2Hex = Hex(value) ...
  • VB进制转换大全

    2011-01-24 13:35:16
    ' 用途:将十进制转化为 进 制 ' 输入:Dec(十进制数) ' 输入数据类型:Long ' 输出:DEC_to_BIN( 进 制数) ' 输出数据类型:String ' 输入的最大数为2147483647,输出最大数为...
  • 十进制转换二进制(补码)

    千次阅读 2005-05-04 19:59:00
    借鉴了反码算法的经验,在转换为补码的函数中,要以求反码函数为基础,...十进制转换为二进制补码的VB6代码:Public Function BinaryConvertC(ByVal iNum As Integer, Optional ByVal iLength As Integer = 8) As String
  • 十进制转换二进制(反码)

    千次阅读 2005-05-04 19:38:00
    这是段把十进制数转换为二进制反码的VB6代码,这段代码需要转换为原码函数(BinaryConvertA)的支持,开始的时候,我把它写成一个了独立的函数,但最后还是改到了现在这个样子,感觉如果转换原码代码部分有错误,可以把错误...
  • VB 、八、十六、二进制大全

    万次阅读 2012-11-18 00:42:30
    用途:将十进制转化为二进制 输入:Dec(十进制数) 输入数据类型:Long 输出:DEC_to_BIN(二进制数) 输出数据类型:String 输入的最大数为2147483647,输出最大数为1111111111111111111111111111111(31个1) ...
  • VB进制转换

    2007-01-29 11:23:00
    用途:将十进制转化为二进制 输入:Dec(十进制数) 输入数据类型:Long 输出:DEC_to_BIN(二进制数) 输出数据类型:String 输入的最大数为2147483647,输出最大数为1111111111111111111111111111111(31个1)Public...
  • vb.net进制

    2020-07-09 16:43:16
    十进制转二进制 代码如下 Public Class Form1 Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim i As Integer i = TextBox1.Text TextBox2.Tex...

空空如也

空空如也

1 2 3 4 5 6
收藏数 102
精华内容 40
关键字:

二进制转十进制vb