VBS 進位制相互轉換
阿新 • • 發佈:2018-12-14
效果動畫演示
實現步驟
步驟一:建立視窗,並設計視窗畫面
步驟二:按鈕 “十進位制==>二進位制”事件
Dec=Trim(文字框0.Text)
D2B = ""
Do While Dec > 0
D2B = Dec Mod 2 & D2B
Dec = Dec \ 2
Loop
lblerjinzhi.Text=D2B
步驟三:按鈕“十進位制==>十六進位制”事件
Dec=Trim(文字框0.Text) Dim a 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 lblshiliujinzhi.Text=D2H
步驟四:按鈕“十六進位制==>十進位制”事件
HexStr=Trim(文字框0.Text) Dim i,b HexStr = UCase(HexStr) For i = 1 To Len(HexStr) Select Case Mid(HexStr, Len(HexStr) - 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 H2D = b lblshiliutoshi.Text=H2D
VBS 指令碼常用的進位制轉換函式
'二進位制轉十進位制 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