精华内容
下载资源
问答
  • vb十进制转十六进制 源码 Visual Basic 6.0
  • 在IFIX中VB十进制八进制十六进制二进制转换代码
  • 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
    

    展开全文
  • 十进制,八进制,十六进制,二进制相互转换' 用途:将十进制转化为二进' 输入:Dec(十进制数)' 输入数据类型:Long' 输出:DEC_to_BIN(二进制数)' 输出数据类型:String' 输入的最大数为2147483647,输出最大数为...

    十进制,八进制,十六进制,二进制相互转换

    ' 用途:将十进制转化为二进

    ' 输入:Dec(十进制数)

    ' 输入数据类型:Long

    ' 输出:DEC_to_BIN(二进制数)

    ' 输出数据类型:String

    ' 输入的最大数为2147483647,输出最大数为1111111111111111111111111111111(31个1)

    Public Function DEC_to_BIN(Dec As Long) As String

    DEC_to_BIN = ""

    Do While Dec > 0

    DEC_to_BIN = Dec Mod 2 & DEC_to_BIN

    Dec = Dec \ 2

    Loop

    End Function

    ' 用途:将二进制转化为十进制

    ' 输入:Bin(二进制数)

    ' 输入数据类型:String

    ' 输出:BIN_to_DEC(十进制数)

    ' 输出数据类型:Long

    ' 输入的最大数为1111111111111111111111111111111(31个1),输出最大数为2147483647

    Public Function BIN_to_DEC(ByVal Bin As String) As Long

    Dim i As Long

    For i = 1 To Len(Bin)

    BIN_to_DEC = BIN_to_DEC * 2 + Val(Mid(Bin, i, 1))

    Next i

    End Function

    ' 用途:将十六进制转化为二进制

    ' 输入:Hex(十六进制数)

    ' 输入数据类型:String

    ' 输出:HEX_to_BIN(二进制数)

    ' 输出数据类型:String

    ' 输入的最大数为2147483647个字符

    Public Function HEX_to_BIN(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

    HEX_to_BIN = B

    End Function

    ' 用途:将二进制转化为十六进制

    ' 输入:Bin(二进制数)

    ' 输入数据类型:String

    ' 输出:BIN_to_HEX(十六进制数)

    ' 输出数据类型:String

    ' 输入的最大数为2147483647个字符

    Public Function BIN_to_HEX(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

    BIN_to_HEX = H

    End Function

    ' 用途:将十六进制转化为十进制

    ' 输入:Hex(十六进制数)

    ' 输入数据类型:String

    ' 输出:HEX_to_DEC(十进制数)

    ' 输出数据类型:Long

    ' 输入的最大数为7FFFFFFF,输出的最大数为2147483647

    Public Function HEX_to_DEC(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

    HEX_to_DEC = B

    End Function

    ' 用途:将十进制转化为十六进制

    ' 输入:Dec(十进制数)

    ' 输入数据类型:Long

    ' 输出:DEC_to_HEX(十六进制数)

    ' 输出数据类型:String

    ' 输入的最大数为2147483647,输出最大数为7FFFFFFF

    Public Function DEC_to_HEX(Dec As Long) As String

    Dim a As String

    DEC_to_HEX = ""

    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

    DEC_to_HEX = a & DEC_to_HEX

    Dec = Dec \ 16

    Loop

    End Function

    ' 用途:将十进制转化为八进制

    ' 输入:Dec(十进制数)

    ' 输入数据类型:Long

    ' 输出:DEC_to_OCT(八进制数)

    ' 输出数据类型:String

    ' 输入的最大数为2147483647,输出最大数为17777777777

    Public Function DEC_to_OCT(Dec As Long) As String

    DEC_to_OCT = ""

    Do While Dec > 0

    DEC_to_OCT = Dec Mod 8 & DEC_to_OCT

    Dec = Dec \ 8

    Loop

    End Function

    ' 用途:将八进制转化为十进制

    ' 输入:Oct(八进制数)

    ' 输入数据类型:String

    ' 输出:OCT_to_DEC(十进制数)

    ' 输出数据类型:Long

    ' 输入的最大数为17777777777,输出的最大数为2147483647

    Public Function OCT_to_DEC(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

    OCT_to_DEC = B

    End Function

    ' 用途:将二进制转化为八进制

    ' 输入:Bin(二进制数)

    ' 输入数据类型:String

    ' 输出:BIN_to_OCT(八进制数)

    ' 输出数据类型:String

    ' 输入的最大数为2147483647个字符

    Public Function BIN_to_OCT(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

    BIN_to_OCT = H

    End Function

    ' 用途:将八进制转化为二进制

    ' 输入:Oct(八进制数)

    ' 输入数据类型:String

    ' 输出:OCT_to_BIN(二进制数)

    ' 输出数据类型:String

    ' 输入的最大数为2147483647个字符

    Public Function OCT_to_BIN(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

    OCT_to_BIN = B

    End Function

    ' 用途:将八进制转化为十六进制

    ' 输入:Oct(八进制数)

    ' 输入数据类型:String

    ' 输出:OCT_to_HEX(十六进制数)

    ' 输出数据类型:String

    ' 输入的最大数为2147483647个字符

    Public Function OCT_to_HEX(ByVal Oct As String) As String

    Dim Bin As String

    Bin = OCT_to_BIN(Oct)

    OCT_to_HEX = BIN_to_HEX(Bin)

    End Function

    ' 用途:将十六进制转化为八进制

    ' 输入:Hex(十六进制数)

    ' 输入数据类型:String

    ' 输出:HEX_to_OCT(八进制数)

    ' 输出数据类型:String

    ' 输入的最大数为2147483647个字符

    Public Function HEX_to_OCT(ByVal Hex As String) As String

    Dim Bin As String

    Hex = UCase(Hex)

    Bin = HEX_to_BIN(Hex)

    HEX_to_OCT = BIN_to_OCT(Bin)

    End Function

    VB自带函数:

    十进制转八进制:Oct(num)

    十六进制转八进制:oct("&H" & num)

    十进制转十六进制:hex(num)

    八进制转十六进制:hex("&O" & num)

    十六进制转换为十进制

    Dim str As String

    str = Text2.Text

    Text10.Text = CLng("&H" & str)

    文章出处:http://blog.programfan.com/article.asp?id=11903

    感谢作者的无私奉献、、、、

    展开全文
  • 原文地址:... 二进制转十进制 二进制转化为八进制 二进制转化为十六进制 ...八进制转化为十六进制 ...十进制转二进制 十进制转化为八进制 十进制转化为十六进制 十六进制转化为二进制 十六...

    原文地址: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--十进制,八进制,十六进制,二进制相互转换大全
  • 十进制/十六进制/二进制 间的转换1,十进制转十六进制Function Dec2Hex(value As String) As String value = Trim$(value) If Len(value) = 0 Then Dec2Hex = "" Else Dec2Hex = Hex(value) ...
  • 在.NET Framework中,System.Convert类中的ToString方法和ToInt32(ToInt64)方法都可以方便的实现各种进制间的相互转换。...即可以将十进制整数转换成二进制、八进制、十进制(无实际意义)或十...
  • VB 8位十六进制转十进制,大家可以看看,祝好用啊。8位十六进制转十进制,8位十六进制转十进制
  • Public Function decToHex(ByVal decNumber As Double, ByVal reservedDigits As Integer) As String '将十进制转换为十六进制字符串,保留需要的位 Dim hexStr = Hex(decNumber) If hexStr.Length < ...
  • 本源码演示vb6.0在十进制、二进制、八进制、十六进制等多种进制间的转换,同时还可进行十进制数分解,使用时,只需在右侧任意一个方框中输入需要转换的数字,点击“确定”按钮即可实现转换,转换记录会显示在左侧的...
  • vb做界面的二进制计算器。可以自己在写上十六进制和八进制转换!
  • VB有符号十六进制转十进制工具,小工具可以直接用,另附源码,方便集成系统,结果准确已经在实际项目中应用
  • VB写的十六进制转十进制小工具,可逆转,支持从10进制转换成16进制,定义成通用函数,将RGB值转换成6位16进制颜色值。窗体做的有意思,可窗体置顶,窗体抖动,靠近边缘自动隐藏等。
  • VB进制转换程序,可进行以下四种进制相互转换:二进制、四进制、十六进制十进制,界面简洁,操作方便,示例演示截图如图所示。
  • 请教大家,用VB写一个十六进制的数转换成十进制数,并且能正确转换16位数的十六进制数,我写的只能保正14位数以下的十六进制数转换是对的,15位十六进制数以上,转换成十进制数就不对了。 有哪位大侠能帮帮小弟。
  • VB.NET将十进制转化为十六进制的方法 '' 用途:将十进制转化为十六进制 '' 输入:Dec(十进制数) '' 输入数据类型:Long '' 输出:DEC_to_HEX(十六进制数) '' 输出数据类型:String '' 输入的最大数为2147483647,输出...
  • 在VS2010用VB.NET语言跟serialport控件编写十进制转换成16位十六进制程序,例如:输入10进制数字123,希望能在打开端口之后,能在串口助手工具上用HEX显示接收到00 7B,谢谢
  • 例如:0503080102030465646362C138一串字符,我想以05开头,38结尾,取01020304输出十进制text2,取6564636输出十进制text3
  • vb 进制间的转换

    2012-04-08 23:07:45
    vb编的 进制间的转换 二进制十进制 十进制十六进制 二进制十六进制 间的相互转换
  • 十进制,八进制,十六进制,二进制相互转换  程序代码:   '-------------------------------------------------' 用途:将十进制转化为二进制' 输入:Dec(十进制数)' 输入数据类型:Long' 输出:DEC_to_BIN(二...
  • VB做的简单的进制转换,可以把十进制转换为二进制,八进制和十六进制
  • VB 、八、十六、二进制大全

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

    千次阅读 2018-05-30 21:11:09
    今天碰到一个这样的问题。我在修改以前用VB写的一个功能,这个功能中有一个部分是使用着色器给一段文字上色。...1、十进制十六进制字符串。 2、十六进制字符串成RGB码。 3、RGB码成Color类型的值,给...

空空如也

空空如也

1 2 3 4 5
收藏数 98
精华内容 39
关键字:

vb十进制转十六进制