module1.bas

主要是一些文件操作的技巧

Attribute VB_Name = "Module1"
Function Bin2Dec(InputData As String) As Double
'2进制转换为10进制
Dim DecOut As Double
Dim I As Integer
Dim LenBin As Double
Dim JOne As String

LenBin = Len(InputData)

'确定是否是一个合法的2进制数
For I = 1 To LenBin
 JOne = Mid(InputData, I, 1)
   If JOne <> "0" And JOne <> "1" Then
     MsgBox "不是合法的2进制数", vbCritical
     Exit Function
   End If
Next I

DecOut = 0
For I = Len(InputData) To 1 Step -1
  If Mid(InputData, I, 1) = "1" Then
    DecOut = DecOut + 2 ^ (Len(InputData) - I)
  End If
Next I
  Bin2Dec = DecOut
        
End Function

Function Dec2Bin(InputData As Double) As String
'10进制转换为2进制
Dim Quot As Double
Dim Remainder As Double
Dim BinOut As String
Dim I As Integer
Dim NewVal As Double
Dim TempString As String
Dim TempVal As Double
Dim BinTemp As String
Dim BinTemp1 As String
Dim PosDot As Integer
Dim Temp2 As String

'检查该10进制数是否有小数点
If InStr(1, CStr(InputData), ".") Then
  MsgBox "包含小数点的10进制数不能进行转换", vbCritical
  GoTo eds
End If

BinOut = ""
NewVal = InputData

DoAgain:

NewVal = (NewVal / 2)

'如果存在余数
If InStr(1, CStr(NewVal), ".") Then
  BinOut = BinOut + "1"
  
  '去掉余数
  NewVal = Format(NewVal, "#0")
  NewVal = (NewVal - 1)
  
   If NewVal < 1 Then
     GoTo DoneIt
   End If
Else
  BinOut = BinOut + "0"
   If NewVal < 1 Then
     GoTo DoneIt
   End If
End If

GoTo DoAgain
DoneIt:

BinTemp = ""

For I = Len(BinOut) To 1 Step -1
 BinTemp1 = Mid(BinOut, I, 1)
 BinTemp = BinTemp + BinTemp1
Next I

BinOut = BinTemp

'输出结果
Dec2Bin = BinOut

eds:
End Function

Function Bin2Hex(InputData As String) As String
'2进制转换为16进制
Dim I As Integer
Dim LenBin As Integer
Dim JOne As String
Dim NumBlocks As Integer
Dim FullBin As String
Dim HexOut As String
Dim TempBinBlock As String
Dim TempHex As String

LenBin = Len(InputData)

'确定是合法的2进制数
For I = 1 To LenBin
 JOne = Mid(InputData, I, 1)
   If JOne <> "0" And JOne <> "1" Then
     MsgBox "不是合法的2进制数", vbCritical
     Exit Function
   End If
Next I

FullBin = InputData

If LenBin < 4 Then
 If LenBin = 3 Then
  FullBin = "0" + FullBin
 ElseIf LenBin = 2 Then
  FullBin = "00" + FullBin
 ElseIf LenBin = 1 Then
  FullBin = "000" + FullBin
 ElseIf LenBin = 0 Then
   MsgBox "空值", vbCritical
   Exit Function
 End If
  NumBlocks = 1
  GoTo DoBlocks
End If

If LenBin = 4 Then
  NumBlocks = 1
  GoTo DoBlocks
End If

If LenBin > 4 Then

Dim TempHold As Currency
Dim TempDiv As Currency
Dim AfterDot As Integer
Dim Pos As Integer

TempHold = Len(InputData)
TempDiv = (TempHold / 4)

Pos = InStr(1, CStr(TempDiv), ".")

If Pos = 0 Then
 NumBlocks = TempDiv
 GoTo DoBlocks
End If

AfterDot = Mid(CStr(TempDiv), (Pos + 1))

If AfterDot = 25 Then
  FullBin = "000" + FullBin
  NumBlocks = (Len(FullBin) / 4)
ElseIf AfterDot = 5 Then
  FullBin = "00" + FullBin
  NumBlocks = (Len(FullBin) / 4)
ElseIf AfterDot = 75 Then
  FullBin = "0" + FullBin
  NumBlocks = (Len(FullBin) / 4)
Else
  MsgBox "超时", vbInformation
  Exit Function
End If

  GoTo DoBlocks
End If

DoBlocks:

HexOut = ""

For I = 1 To Len(FullBin) Step 4
  TempBinBlock = Mid(FullBin, I, 4)

If TempBinBlock = "0000" Then
  HexOut = HexOut + "0"
ElseIf TempBinBlock = "0001" Then
  HexOut = HexOut + "1"
ElseIf TempBinBlock = "0010" Then
  HexOut = HexOut + "2"
ElseIf TempBinBlock = "0011" Then
  HexOut = HexOut + "3"
ElseIf TempBinBlock = "0100" Then
  HexOut = HexOut + "4"
ElseIf TempBinBlock = "0101" Then
  HexOut = HexOut + "5"
ElseIf TempBinBlock = "0110" Then
  HexOut = HexOut + "6"
ElseIf TempBinBlock = "0111" Then
  HexOut = HexOut + "7"
ElseIf TempBinBlock = "1000" Then
  HexOut = HexOut + "8"
ElseIf TempBinBlock = "1001" Then
  HexOut = HexOut + "9"
ElseIf TempBinBlock = "1010" Then
  HexOut = HexOut + "A"
ElseIf TempBinBlock = "1011" Then
  HexOut = HexOut + "B"
ElseIf TempBinBlock = "1100" Then
  HexOut = HexOut + "C"
ElseIf TempBinBlock = "1101" Then
  HexOut = HexOut + "D"
ElseIf TempBinBlock = "1110" Then
  HexOut = HexOut + "E"
ElseIf TempBinBlock = "1111" Then
  HexOut = HexOut + "F"
End If

Next I

Bin2Hex = HexOut

eds:
End Function

Function Hex2Bin(InputData As String) As String
'16进制转换为2进制
Dim I As Integer
Dim BinOut As String
Dim Lenhex As Integer
'输入数的长度
InputData = UCase(InputData)
Lenhex = Len(InputData)

For I = 1 To Lenhex

If IsNumeric(Mid(InputData, I, 1)) Then
  ''
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "A" Then
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "B" Then
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "C" Then
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "D" Then
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "E" Then
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "F" Then
  GoTo NumOk
Else
  MsgBox "输入的数不是合法的16进制数", vbCritical
  Exit Function
End If

NumOk:
Next I

BinOut = ""
'转换为2进制
For I = 1 To Lenhex

If Mid(InputData, I, 1) = "0" Then
  BinOut = BinOut + "0000"
ElseIf Mid(InputData, I, 1) = "1" Then
  BinOut = BinOut + "0001"
ElseIf Mid(InputData, I, 1) = "2" Then
  BinOut = BinOut + "0010"
ElseIf Mid(InputData, I, 1) = "3" Then
  BinOut = BinOut + "0011"
ElseIf Mid(InputData, I, 1) = "4" Then
  BinOut = BinOut + "0100"
ElseIf Mid(InputData, I, 1) = "5" Then
  BinOut = BinOut + "0101"
ElseIf Mid(InputData, I, 1) = "6" Then
  BinOut = BinOut + "0110"
ElseIf Mid(InputData, I, 1) = "7" Then
  BinOut = BinOut + "0111"
ElseIf Mid(InputData, I, 1) = "8" Then
  BinOut = BinOut + "1000"
ElseIf Mid(InputData, I, 1) = "9" Then
  BinOut = BinOut + "1001"
ElseIf Mid(InputData, I, 1) = "A" Then
  BinOut = BinOut + "1010"
ElseIf Mid(InputData, I, 1) = "B" Then
  BinOut = BinOut + "1011"
ElseIf Mid(InputData, I, 1) = "C" Then
  BinOut = BinOut + "1100"
ElseIf Mid(InputData, I, 1) = "D" Then
  BinOut = BinOut + "1101"
ElseIf Mid(InputData, I, 1) = "E" Then
  BinOut = BinOut + "1110"
ElseIf Mid(InputData, I, 1) = "F" Then
  BinOut = BinOut + "1111"
Else
  MsgBox "超时", vbCritical
End If

Next I

Hex2Bin = BinOut

eds:
End Function

Function Hex2Dec(InputData As String) As Double
'16进制转换为10进制
Dim I As Integer
Dim DecOut As Double
Dim Lenhex As Integer
Dim HexStep As Double

DecOut = 0

'输入数的长度
InputData = UCase(InputData)
Lenhex = Len(InputData)

'检查该数是否为合法的16进制数
For I = 1 To Lenhex

If IsNumeric(Mid(InputData, I, 1)) Then
  ''
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "A" Then
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "B" Then
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "C" Then
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "D" Then
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "E" Then
  GoTo NumOk
ElseIf Mid(InputData, I, 1) = "F" Then
  GoTo NumOk
Else
  MsgBox "输入数字不是有效的十六进制数字", vbCritical
  Exit Function
End If

NumOk:
Next I

HexStep = 0
'转换为10进制数
For I = Lenhex To 1 Step -1

HexStep = HexStep * 16
If HexStep = 0 Then
  HexStep = 1
End If

 If Mid(InputData, I, 1) = "0" Then
   DecOut = DecOut + (0 * HexStep)
 ElseIf Mid(InputData, I, 1) = "1" Then
   DecOut = DecOut + (1 * HexStep)
 ElseIf Mid(InputData, I, 1) = "2" Then
   DecOut = DecOut + (2 * HexStep)
 ElseIf Mid(InputData, I, 1) = "3" Then
   DecOut = DecOut + (3 * HexStep)
 ElseIf Mid(InputData, I, 1) = "4" Then
   DecOut = DecOut + (4 * HexStep)
 ElseIf Mid(InputData, I, 1) = "5" Then
   DecOut = DecOut + (5 * HexStep)
 ElseIf Mid(InputData, I, 1) = "6" Then
   DecOut = DecOut + (6 * HexStep)
 ElseIf Mid(InputData, I, 1) = "7" Then
   DecOut = DecOut + (7 * HexStep)
 ElseIf Mid(InputData, I, 1) = "8" Then
   DecOut = DecOut + (8 * HexStep)
 ElseIf Mid(InputData, I, 1) = "9" Then
   DecOut = DecOut + (9 * HexStep)
 ElseIf Mid(InputData, I, 1) = "A" Then
   DecOut = DecOut + (10 * HexStep)
 ElseIf Mid(InputData, I, 1) = "B" Then
   DecOut = DecOut + (11 * HexStep)
 ElseIf Mid(InputData, I, 1) = "C" Then
   DecOut = DecOut + (12 * HexStep)
 ElseIf Mid(InputData, I, 1) = "D" Then
   DecOut = DecOut + (13 * HexStep)
 ElseIf Mid(InputData, I, 1) = "E" Then
   DecOut = DecOut + (14 * HexStep)
 ElseIf Mid(InputData, I, 1) = "F" Then
   DecOut = DecOut + (15 * HexStep)
 Else
   MsgBox "超时", vbCritical
 End If

Next I

Hex2Dec = DecOut

eds:
End Function