Option Strict Off
Option Explicit On
Option Compare Text
Imports Microsoft.VisualBasic.Compatibility
Namespace Blood.Com.ClassLib
Public Class Security
Private pbBase64Byt(63) As Byte
Private Const BASE64CHR As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
Private Const Q_CODE_HDR As String = "=?ISO-8859-1?Q?"
Private Const B_CODE_HDR As String = "=?ISO-8859-1?B?"
Private Const CODE_END As String = "?="
Public Sub New()
MyBase.New()
Dim intPtr As Integer
For intPtr = 0 To 63
pbBase64Byt(intPtr) = Asc(Mid(BASE64CHR, intPtr + 1, 1))
Next
End Sub
Protected Overrides Sub Finalize()
MyBase.Finalize()
End Sub
'对字符串进行B或Q编码
Public Function EnText(ByRef sIn As String) As String
Dim iPtr As Short
Dim bNeedsEncoding As Boolean
Dim iMax As Short
Dim sChr As String
Dim sLine As String
Dim sQCode As String
Dim sBCode As String
Dim bytTmp() As Byte
bytTmp = System.Text.UnicodeEncoding.Default.GetBytes(sIn)
For iPtr = 0 To UBound(bytTmp)
If bytTmp(iPtr) > 126 Then
bNeedsEncoding = True
Exit For
End If
Next
EnText = sIn
'Q 编码
iMax = 54
For iPtr = 1 To Len(sIn)
sChr = Mid(sIn, iPtr, 1)
Select Case Asc(sChr)
Case 33 To 60, 62, 64 To 94, 96 To 126
sLine = sLine & sChr
Case 32
sLine = sLine & "_"
Case Else
sLine = sLine & "=" & Right("00" & Hex(Asc(sChr)), 2)
End Select
If Len(sLine) >= iMax Then
sQCode = sQCode & Q_CODE_HDR & sLine & CODE_END
If iPtr < Len(sIn) Then sQCode = sQCode & vbCrLf & vbTab
sLine = ""
End If
Next
sQCode = sQCode & Q_CODE_HDR & sLine & CODE_END
'B 编码
iMax = 42
sLine = sIn
Do While Len(sLine)
sBCode = sBCode & B_CODE_HDR & Encode(Mid(sLine, 1, iMax))
sBCode = Mid(sBCode, 1, Len(sBCode) - 2) & CODE_END
sLine = Mid(sLine, iMax + 1)
If Len(sLine) Then sBCode = sBCode & vbCrLf & vbTab
Loop
If Len(sQCode) < Len(sBCode) Then
EnText = sQCode
Else
EnText = sBCode
End If
End Function
'解码字符串
Public Function Decode(ByVal str2Decode As String) As String
Dim lPtr As Integer
Dim iValue As Short
Dim iLen As Short
Dim iCtr As Short
Dim Bits(4) As Byte
Dim strDecode As String
For lPtr = 1 To Len(str2Decode) Step 4
iLen = 4
For iCtr = 0 To 3
iValue = InStr(1, BASE64CHR, Mid(str2Decode, lPtr + iCtr, 1), CompareMethod.Binary)
Select Case iValue
Case 1 To 64 : Bits(iCtr + 1) = iValue - 1
Case 65
iLen = iCtr
Exit For
Case 0
Exit Function
End Select
Next
Bits(1) = Bits(1) * &H4S + (Bits(2) And &H30S) \ &H10S
Bits(2) = CShort(Bits(2) And &HFS) * &H10S + (Bits(3) And &H3CS) \ &H4S
Bits(3) = CShort(Bits(3) And &H3S) * &H40S + Bits(4)
For iCtr = 1 To iLen - 1
strDecode = strDecode & Chr(Bits(iCtr))
Next
Next
Decode = strDecode
End Function
'对字节进行编码（可以直接进行文件的编码）
Public Function EncodeByte(ByRef InArray() As Byte) As Byte()
Dim lInPtr As Integer
Dim lOutPtr As Integer
Dim OutArray() As Byte
Dim lLen As Integer
Dim iNewLine As Integer
lLen = (UBound(InArray) - LBound(InArray) + 1) Mod 3
If lLen Then
lLen = 3 - lLen
ReDim Preserve InArray(UBound(InArray) + lLen)
End If
ReDim OutArray(UBound(InArray) * 2 + 100)
For lInPtr = 0 To UBound(InArray) Step 3
If iNewLine = 19 Then
OutArray(lOutPtr) = 13
OutArray(lOutPtr + 1) = 10
lOutPtr = lOutPtr + 2
iNewLine = 0
End If
OutArray(lOutPtr) = pbBase64Byt((InArray(lInPtr) And &HFCS) \ 4)
OutArray(lOutPtr + 1) = pbBase64Byt(CShort(InArray(lInPtr) And &H3S) * &H10S + (InArray(lInPtr + 1) And &HF0S) \ &H10S)
OutArray(lOutPtr + 2) = pbBase64Byt(CShort(InArray(lInPtr + 1) And &HFS) * 4 + (InArray(lInPtr + 2) And &HC0S) \ &H40S)
OutArray(lOutPtr + 3) = pbBase64Byt(InArray(lInPtr + 2) And &H3FS)
lOutPtr = lOutPtr + 4
iNewLine = iNewLine + 1
Next
Select Case lLen
Case 1
OutArray(lOutPtr - 1) = 61
Case 2
OutArray(lOutPtr - 1) = 61
OutArray(lOutPtr - 2) = 61
End Select
If OutArray(lOutPtr - 2) <> 13 Then
OutArray(lOutPtr) = 13
OutArray(lOutPtr + 1) = 10
lOutPtr = lOutPtr + 2
End If
ReDim Preserve OutArray(lOutPtr - 1)
EncodeByte = VB6.CopyArray(OutArray)
End Function
'对字符串进行编码
Public Function Encode(ByRef str2Encode As String) As String
Dim tmpByte() As Byte
If Len(str2Encode) Then
tmpByte = System.Text.UnicodeEncoding.Default.GetBytes(str2Encode)
tmpByte = EncodeByte(tmpByte)
Encode = System.Text.UnicodeEncoding.Unicode.GetString(tmpByte)
End If
End Function
End Class
End Namespace