VB 进制转换大全

'二进制转十进制

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 进制转换大全的更多相关文章

SQL Server 进制转换函数
一.背景前段时间群里的朋友问了一个问题:“在查询时增加一个递增序列,如:0x00000001,即每一个都是36进位(0—9,A--Z),0x0000000Z后面将是0x00000010,生成一个像下 ...
[No000071]C# 进制转换（二进制、十六进制、十进制互转）
using System; using System.Collections.Generic; using System.Linq; using System.Text; using System.T ...
JS中的进制转换以及作用
js的进制转换, 分为2进制,8进制,10进制,16进制之间的相互转换, 我们直接利用对象.toString()即可实现: //10进制转为16进制 ().toString() // =>&q ...
结合stack数据结构，实现不同进制转换的算法
#!/usr/bin/env python # -*- coding: utf-8 -*- # learn <<Problem Solving with Algorithms and Da ...
进制转换（ C++字符数组）
注: 较为简便的方法是用整型(int)或浮点型(long.double 注意:该类型不一定能够准确存储数据) 来存放待转换的数值,可直接取余得到每一位数值较为稳定的方法是用字符数组储存待转换的数 ...
JS 进制转换
十进制转换成其他进制 objectname.toString([radix]) objectname 必选项.要得到字符串表示的对象. radix 可选项.指定将数字值转换为字符串时的进制. 例如 ...
php的进制转换
学习了php的进制转换,有很多的知识点,逻辑,也有最原始的笔算,但是我们还是习惯使用代码来实现进制的转换,进制的转换代码有如下:二进制(bin)八进制( oct)十进制( dec)十六进制( hex) ...
C++ 中数串互转、进制转换的类
/******************************************************************** created: 2014/03/16 22:56 file ...
【String与基本类型之间的转换】以及【进制转换】
1. 基本数据类型---->字符串类型: 方法一:使用连接一个空字符串,例如基本数据类型+“” : 方法二:静态方法 String.valueOf(),具体有: String.valueOf ...

随机推荐

Flex使用宋体渲染越南语显示错误
本来应该显示Lưu nhóm,偏偏编译后显示Lưu nhòm.二声变成了四声,并且某些情况下,刚打开的窗口时二声的,然后变成了四声.初始以为是Flex的问题,分别使用S和mx包下的Label做实验,后 ...
asp.net子窗体与父窗体交互
今天在项目上遇到了这个问题,其实只是window.returnValue的简单应用,不是asp.net的专属内容.作为积累,记录一个简单的实现模型. 图1 用到的文件从图1中我们可以看到,只用到了 ...
CVU介绍
ORA.CVU New resource (Cluster Verification Utility) is added in 11.2.0.2 Unlike the previous resour ...
php 深入理解addslashes函数
php addslashes函数对于很多人来说并不陌生,但很大部分人只是了解皮毛,只知道addslashes函数是在特定字符前面加上反斜杠,本文章将带大家深入理解php addslashes函数的使用 ...
Android——Dialog
public class DialogActivity extends Activity { //进度对话框 ProgressDialog progressDialog; @Override ...
struts2下实现的json传递list,object。
必须的jar: java bean: package upload.progress.action; public class music { private String name; private ...
重设mysql的root密码，MAC OSX
前些天装得mysql突然链接不上了,原谅我小白,没有在安装后改密码,mysql初始登陆不需要密码,但是之后root是有个临时密码的,然后..然后就登不上了. 网上有很多改密码的帖子,关键的UPDATE ...
C语言之实现控制台光标随意移动
原理引入windows.h,首先是要获得输入的东西,然后通过判断: 1.方向键:执行上下左右的移动功能 2:回车键:执行换行的功能. 3.普通键:输入功能. 终点就是要获取到屏幕上的坐标,当按下了方向 ...
解决数据标准及质量AppScan（测试）安全性问题相关方法
1. SQL注入文件写入(需要用户验证) 解决办法:通过建立过滤器方法,对所有用户输入信息进行清理过滤.通过清理过滤用户输入所包含的危险字符,便可能防止恶意的用户导致应用程序执行计划外的任务,例如:启 ...
【LeetCode】3.Longest Substring Without Repeating Characters 最长无重复子串
题目: Given a string, find the length of the longest substring without repeating characters. Examples: ...

VB 进制转换大全

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

随机推荐

热门专题