4 种常用加密算法

hjb016

1-[CFS編碼加密]

你是怎麼把密碼儲存到資料庫裡？是以純文字的方式？你可知道這對安全的危險性？當攻擊你網站的人能開啟資料庫瀏覽，以純文字方式存在資料庫裡的密碼一覽無疑，基於安全上的考量，你想這樣適當嗎？有什麼辦法能夠讓別人看到資料庫裡的資料，也沒辦法知道儲存在其中的密碼？
　
以上問題你是否知道如何解決？本文要告訴你，如何將你的密碼做加密處理，處理過後的密碼字串，就算是公開出來也沒人猜得到原來的密碼！首先我們來看看一組字串：
27B827277C70E88DD87E3057BFBE8F
這是將密碼加密後的結果，你知道加密之前的字串是什麼嗎？其實是『 test 』。不可思議吧！經過處理後的字串，和原本的字串全然不同，我不說你猜的到嗎？如果決定密碼的人不說，這密碼永遠都是個秘密！
畢竟這是以原本字串為起點開始編碼，你可能會怕有人用反向工程將字串變回原本的密碼，這點你就不用擔心了，這編碼方式是『單向』的，無法用反向工程恢復！只要將密碼加密後再存入資料庫，你的密碼就多了一份保障！比對密碼時，就將使用者輸入的密碼加密後再跟資料庫比對。講了許多，現在開始告訴你如何寫這段程式。
我們用的加密方法『CFS編碼加密函式庫』，請於《ASP技術廣場網站→檔案下載→相關元件→函式庫》下載其函式包含檔。此為『ASP技術廣場』所創造的加密法，不同於市面上其他的加密編碼方法！下載回來的檔案為ZIP檔，請解壓縮到跟你的ASP同一目錄。
<!--#include file="Codefun.fun" -->
這是用來將函式包含檔加入到你的ASP，請於ASP開頭加上，接著就可使用其編碼函式。
編碼函式 CfsEncode() 的使用：
Var = CfsEncode(字串來源)
範例：
<%Dim SourceDim Var1Source = "test"Var1 = CfsEncode(Source)Response.Write Var1%>

執行結果：
27B827277C70E88DD87E3057BFBE8F
<%
'********************************************************************************
'* *
'* CFS Encode Function *
'* *
'* Produced by ASP-Zone *
'* *
'* Main website is located at *
'* http://asp.diy.com.tw/ *
'* *
'* E-MAIL: *
'* thiefghost@games.com.tw *
'* *
'* Use this function: *
'* <!--#include file="Codefun.fun" --> *
'* *
'* 2001/8/3 *
'* *
'********************************************************************************
'Encode Function
Function CfsEnCode(CodeStr)
Dim CodeLen
Dim CodeSpace
Dim NewCode
CodeLen = 30
CodeSpace = CodeLen - Len(CodeStr)
If Not CodeSpace < 1 Then
For cecr = 1 To CodeSpace
CodeStr = CodeStr & Chr(21)
Next
End If
NewCode = 1
Dim Been
For cecb = 1 To CodeLen
Been = CodeLen + Asc(Mid(CodeStr,cecb,1)) * cecb
NewCode = NewCode * Been
Next
CodeStr = NewCode
NewCode = Empty
For cec = 1 To Len(CodeStr)
NewCode = NewCode & CfsCode(Mid(CodeStr,cec,3))
Next
For cec = 20 To Len(NewCode) - 18 Step 2
CfsEnCode = CfsEnCode & Mid(NewCode,cec,1)
Next
End Function

Function CfsCode(Word)
For cc = 1 To Len(Word)
CfsCode = CfsCode & Asc(Mid(Word,cc,1))
Next
CfsCode = Hex(CfsCode)
End Function
%>

hjb016

2-RC4经典加密算法VB版本代码

VB版rc4算法

　

Public Sub main()
Dim key As String
For i = 1 To 16
Randomize
key = key & Chr(Rnd * 255)
Next i
MsgBox RC4(RC4("Welcome To Plindge Studio!", key), key)
End Sub
Public Function RC4(inp As String, key As String) As String
Dim S(0 To 255) As Byte, K(0 To 255) As Byte, i As Long
Dim j As Long, temp As Byte, Y As Byte, t As Long, x As Long
Dim Outp As String

For i = 0 To 255
S(i) = i
Next

j = 1
For i = 0 To 255
If j > Len(key) Then j = 1
K(i) = Asc(Mid(key, j, 1))
j = j + 1
Next i

j = 0
For i = 0 To 255
j = (j + S(i) + K(i)) Mod 256
temp = S(i)
S(i) = S(j)
S(j) = temp
Next i

i = 0
j = 0
For x = 1 To Len(inp)
i = (i + 1) Mod 256
j = (j + S(i)) Mod 256
temp = S(i)
S(i) = S(j)
S(j) = temp
t = (S(i) + (S(j) Mod 256)) Mod 256
Y = S(t)

Outp = Outp & Chr(Asc(Mid(inp, x, 1)) Xor Y)
Next
RC4 = Outp
End Function
　

如果是中文请改用 lenb 等来操作

hjb016

3-md5
方法一：



在 Windows 2003 server 的机器上找到对应类库，其他系统不知是否有

Function test_MD5()
    '引用 ComMD5 1.0 Type Library
    '该类库定位于 msppmd5.dll
    Dim a As New CoMD5
    Debug.Print a.MD5Hash("a")
    Debug.Print a.MD5Hash("a")
End Function


上述 MD5 类库你可以到以下地址下载
http://access911.net/down/software/msppmd5.rar (13KB)
解压缩后用 REGSVR32.EXE C:\TEMP\msppmd5.dll 可以注册






方法二：



4 种常用加密算法-3《VBA》
MD5不可逆加密算法的ASP实现实例

此为国外转载函数，可将任意字符转换为md5 16为字符加密形式，而且为不可逆转换。
<%
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32

　

Private m_lOnBits(30)
Private m_l2Power(30)

Private Function LShift(lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If

If (lValue And m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
Else
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
End If
End Function

Private Function RShift(lValue, iShiftBits)
If iShiftBits = 0 Then
RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If

RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If
End Function

Private Function RotateLeft(lValue, iShiftBits)
RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function

Private Function AddUnsigned(lX, lY)
Dim lX4
Dim lY4
Dim lX8
Dim lY8
Dim lResult

lX8 = lX And &H80000000
lY8 = lY And &H80000000
lX4 = lX And &H40000000
lY4 = lY And &H40000000

lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)

If lX4 And lY4 Then
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And &H40000000 Then
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
Else
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
End If
Else
lResult = lResult Xor lX8 Xor lY8
End If

AddUnsigned = lResult
End Function

Private Function md5_F(x, y, z)
md5_F = (x And y) Or ((Not x) And z)
End Function

Private Function md5_G(x, y, z)
md5_G = (x And z) Or (y And (Not z))
End Function

Private Function md5_H(x, y, z)
md5_H = (x Xor y Xor z)
End Function

Private Function md5_I(x, y, z)
md5_I = (y Xor (x Or (Not z)))
End Function

Private Sub md5_FF(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub

Private Sub md5_GG(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub

Private Sub md5_HH(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub

Private Sub md5_II(a, b, c, d, x, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub

Private Function ConvertToWordArray(sMessage)
Dim lMessageLength
Dim lNumberOfWords
Dim lWordArray()
Dim lBytePosition
Dim lByteCount
Dim lWordCount

Const MODULUS_BITS = 512
Const CONGRUENT_BITS = 448

lMessageLength = Len(sMessage)

lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
ReDim lWordArray(lNumberOfWords - 1)

lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
lByteCount = lByteCount + 1
Loop

lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE

lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)

lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)

ConvertToWordArray = lWordArray
End Function

Private Function WordToHex(lValue)
Dim lByte
Dim lCount

For lCount = 0 To 3
lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
Next
End Function

Public Function MD5(sMessage)
m_lOnBits(0) = CLng(1)
m_lOnBits(1) = CLng(3)
m_lOnBits(2) = CLng(7)
m_lOnBits(3) = CLng(15)
m_lOnBits(4) = CLng(31)
m_lOnBits(5) = CLng(63)
m_lOnBits(6) = CLng(127)
m_lOnBits(7) = CLng(255)
m_lOnBits(8) = CLng(511)
m_lOnBits(9) = CLng(1023)
m_lOnBits(10) = CLng(2047)
m_lOnBits(11) = CLng(4095)
m_lOnBits(12) = CLng(8191)
m_lOnBits(13) = CLng(16383)
m_lOnBits(14) = CLng(32767)
m_lOnBits(15) = CLng(65535)
m_lOnBits(16) = CLng(131071)
m_lOnBits(17) = CLng(262143)
m_lOnBits(18) = CLng(524287)
m_lOnBits(19) = CLng(1048575)
m_lOnBits(20) = CLng(2097151)
m_lOnBits(21) = CLng(4194303)
m_lOnBits(22) = CLng(8388607)
m_lOnBits(23) = CLng(16777215)
m_lOnBits(24) = CLng(33554431)
m_lOnBits(25) = CLng(67108863)
m_lOnBits(26) = CLng(134217727)
m_lOnBits(27) = CLng(268435455)
m_lOnBits(28) = CLng(536870911)
m_lOnBits(29) = CLng(1073741823)
m_lOnBits(30) = CLng(2147483647)

m_l2Power(0) = CLng(1)
m_l2Power(1) = CLng(2)
m_l2Power(2) = CLng(4)
m_l2Power(3) = CLng(8)
m_l2Power(4) = CLng(16)
m_l2Power(5) = CLng(32)
m_l2Power(6) = CLng(64)
m_l2Power(7) = CLng(128)
m_l2Power(8) = CLng(256)
m_l2Power(9) = CLng(512)
m_l2Power(10) = CLng(1024)
m_l2Power(11) = CLng(2048)
m_l2Power(12) = CLng(4096)
m_l2Power(13) = CLng(8192)
m_l2Power(14) = CLng(16384)
m_l2Power(15) = CLng(32768)
m_l2Power(16) = CLng(65536)
m_l2Power(17) = CLng(131072)
m_l2Power(18) = CLng(262144)
m_l2Power(19) = CLng(524288)
m_l2Power(20) = CLng(1048576)
m_l2Power(21) = CLng(2097152)
m_l2Power(22) = CLng(4194304)
m_l2Power(23) = CLng(8388608)
m_l2Power(24) = CLng(16777216)
m_l2Power(25) = CLng(33554432)
m_l2Power(26) = CLng(67108864)
m_l2Power(27) = CLng(134217728)
m_l2Power(28) = CLng(268435456)
m_l2Power(29) = CLng(536870912)
m_l2Power(30) = CLng(1073741824)


Dim x
Dim k
Dim AA
Dim BB
Dim CC
Dim DD
Dim a
Dim b
Dim c
Dim d

Const S11 = 7
Const S12 = 12
Const S13 = 17
Const S14 = 22
Const S21 = 5
Const S22 = 9
Const S23 = 14
Const S24 = 20
Const S31 = 4
Const S32 = 11
Const S33 = 16
Const S34 = 23
Const S41 = 6
Const S42 = 10
Const S43 = 15
Const S44 = 21

x = ConvertToWordArray(sMessage)

a = &H67452301
b = &HEFCDAB89
c = &H98BADCFE
d = &H10325476

For k = 0 To UBound(x) Step 16
AA = a
BB = b
CC = c
DD = d

md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478
md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756
md5_FF c, d, a, b, x(k + 2), S13, &H242070DB
md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A
md5_FF c, d, a, b, x(k + 6), S13, &HA8304613
md5_FF b, c, d, a, x(k + 7), S14, &HFD469501
md5_FF a, b, c, d, x(k + 8), S11, &H698098D8
md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE
md5_FF a, b, c, d, x(k + 12), S11, &H6B901122
md5_FF d, a, b, c, x(k + 13), S12, &HFD987193
md5_FF c, d, a, b, x(k + 14), S13, &HA679438E
md5_FF b, c, d, a, x(k + 15), S14, &H49B40821

md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562
md5_GG d, a, b, c, x(k + 6), S22, &HC040B340
md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51
md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D
md5_GG d, a, b, c, x(k + 10), S22, &H2441453
md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681
md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6
md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87
md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED
md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905
md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9
md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A

md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942
md5_HH d, a, b, c, x(k + 8), S32, &H8771F681
md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122
md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C
md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6
md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA
md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085
md5_HH b, c, d, a, x(k + 6), S34, &H4881D05
md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039
md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665

md5_II a, b, c, d, x(k + 0), S41, &HF4292244
md5_II d, a, b, c, x(k + 7), S42, &H432AFF97
md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7
md5_II b, c, d, a, x(k + 5), S44, &HFC93A039
md5_II a, b, c, d, x(k + 12), S41, &H655B59C3
md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92
md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D
md5_II b, c, d, a, x(k + 1), S44, &H85845DD1
md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F
md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
md5_II c, d, a, b, x(k + 6), S43, &HA3014314
md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1
md5_II a, b, c, d, x(k + 4), S41, &HF7537E82
md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235
md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
md5_II b, c, d, a, x(k + 9), S44, &HEB86D391

a = AddUnsigned(a, AA)
b = AddUnsigned(b, BB)
c = AddUnsigned(c, CC)
d = AddUnsigned(d, DD)
Next

MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
' MD5=LCase(WordToHex(b) & WordToHex(c)) 'I crop this to fit 16byte database password
End Function

Response.Write "123456的加密结果为[" & md5 ("123456") & "]"
%>

hjb016

4-BASE64
严格来说，这不能算是一种加密方式，只能算是一种编码方式。

' Base64 Encode/Decode
'
' This is an optimized version of the common Base 64 encode/decode.
' This version eliminates the repeditive calls to chr$() and asc(),
' as well as the linear searches I've seen in some routines.
'
' This method does use a bit more memory in permanent lookup tables
' than most do.  However, this eliminates the need for using vb's
' rather slow method of bit shifting (multiplication and division).
' This appears not to make much difference in the IDE, but make
' a huge difference in the exe.
'   Encodeing Index = 834 vs. 64 bytes standard
'   Decoding Index  = 1536 vs. 64 to 256 standard
'
' This routine also adds the CrLf on the fly rather than making
' a temporary copy of the encoded string then adding the crlf
'
' Encoding/Decoding data from and to a file should be changed to
' use a fixed buffer to reduce the memory requirements of EncodeFile, etc.
'
' All of this results in a speed increase:
'   Encode:
'         100 reps on a string of 28311 bytes
'                               IDE      EXE
'   Base64                      2824     300 (220 w/no overflow & array bound checks)
'   Base64a (unknown author)  375500* 185300*
'   Base64b (Wil Johnson)       2814     512 (410 w/no overflow & array bound checks)
'     *Extrapolated (based on 1 rep, I didn't have time to wait 30 minutes for 100)
'     *Unknown code is from ftp:altecdata.com/base64.cls
'
'  Decode
'         100 reps on a string of 28311 bytes
'                              IDE    EXE
'   Base64                    3384     351 (271 w/no overflow & array bound checks)
'   Base64a (unknown author)
'   Base64b (Wil Johnson)     5969    1191 (981 w/no overflow & array bound checks)
'   *Failed
'   *Unknown code is from ftp:altecdata.com/base64.cls
'
'
'
' This code is provided as-is.  You are free to use and modify it
' as you wish.  Please report bugs, fixes and enhancements to the
' author.
'
' 用如下方法使用:
'    Dim b as Base64
'    b = New Base64
'    Debug.Print b.Encode("This is a test.") ' Prints "VGhpcyBpcyBhIHRlc3Qu"
'    Debug.Print b.Decode("VGhpcyBpcyBhIHRlc3Qu") ' Prints "This is a test."
'
'
'建立一个类模块，然后输入这段代码

Private Const MAX_LINELENGTH As Long = 76 ' Must be a multiple of 4
Private Const CHAR_EQUAL As Byte = 61
Private Const CHAR_CR As Byte = 13
Private Const CHAR_LF As Byte = 10


Private m_Index1(0 To 255) As Byte
Private m_Index2(0 To 255) As Byte
Private m_Index3(0 To 255) As Byte
Private m_Index4(0 To 63) As Byte
Private m_ReverseIndex1(0 To 255) As Byte
Private m_ReverseIndex2(0 To 255, 0 To 1) As Byte
Private m_ReverseIndex3(0 To 255, 0 To 1) As Byte
Private m_ReverseIndex4(0 To 255) As Byte

' Encode a string to a string.
Public Function Encode(sInput As String) As String
   Dim bTemp() As Byte
   
   'Convert to a byte array then convert.
   'This is faster the repetitive calls to asc() or chr$()
   bTemp = StrConv(sInput, vbFromUnicode)
   Encode = StrConv(EncodeArr(bTemp), vbUnicode)
End Function

'Decode a string to a string.
Public Function Decode(sInput As String) As String
   Dim bTemp() As Byte
   
   'Convert to a byte array then convert.
   'This is faster the repetitive calls to asc() or chr$()
   bTemp = StrConv(sInput, vbFromUnicode)
   Decode = StrConv(DecodeArr(bTemp), vbUnicode)
End Function

Public Sub DecodeToFile(sInput As String, sOutputFile As String)
   Dim bTemp() As Byte
   Dim fh As Long
   
   bTemp = StrConv(sInput, vbformunicode)
   bTemp = DecodeArr(bTemp)
   
   fh = FreeFile(0)
   Open sOutputFile For Binary Access Write As fh
   Put fh, , bTemp
   Close fh
End Sub

Public Sub DecodeFile(sInputFile As String, sOutputFile As String)
   Dim bTemp() As Byte
   Dim fh As Long
   
   fh = FreeFile(0)
   Open sInputFile For Binary Access Read As fh
   ReDim bTemp(0 To LOF(fh) - 1)
   Get fh, , bTemp
   Close fh
   
   bTemp = DecodeArr(bTemp)
   Open sOutputFile For Binary Access Write As fh
   Put fh, , bTemp
   Close fh
End Sub

Public Function EncodeFromFile(sFileName As String) As String
   Dim bTemp() As Byte
   Dim fh As Long
   
   fh = FreeFile(0)
   Open sFileName For Binary Access Read As fh
   ReDim bTemp(0 To LOF(fh) - 1)
   Get fh, , bTemp
   Close fh
   
   EncodeFromFile = StrConv(EncodeArr(bTemp), vbUnicode)
End Function

Public Sub EncodeFile(sInputFile As String, sOutputFile As String)
   Dim bTemp() As Byte
   Dim fh As Long
   
   fh = FreeFile(0)
   Open sInputFile For Binary Access Read As fh
   ReDim bTemp(0 To LOF(fh) - 1)
   Get fh, , bTemp
   Close fh
   
   bTemp = EncodeArr(bTemp)
   Open sOutputFile For Binary Access Write As fh
   Put fh, , bTemp
   Close fh
End Sub


Private Function EncodeArr(bInput() As Byte) As Byte()
   Dim bOutput() As Byte
   Dim k As Long
   Dim l As Long
   Dim i As Long
   Dim evenBound As Long
   Dim CurrentOut As Long
   Dim b As Byte
   Dim c As Byte
   Dim d As Byte
   Dim linelength As Long
   
   k = LBound(bInput)
   l = UBound(bInput)
   
   'Calculate the input size
   i = l - k + 1
   
   'Calculate the output size
   Select Case i Mod 3
      Case 0:
         i = (i \ 3) * 4
         evenBound = l
      Case 1:
         i = ((i \ 3) * 4) + 4
         evenBound = l - 1
      Case 2:
         i = ((i \ 3) * 4) + 4
         evenBound = l - 2
      Case 3:
         i = ((i \ 3) * 4) + 4
         evenBound = l - 3
   End Select
   
   'Add in the line feeds.
   If i Mod MAX_LINELENGTH = 0 Then
      i = i + (i \ MAX_LINELENGTH) * 2 - 2
   Else
      i = i + (i \ MAX_LINELENGTH) * 2
   End If
   
   'Size the output array
   ReDim bOutput(0 To i - 1)
      
   CurrentOut = 0
   linelength = 0
   
   For i = k To evenBound Step 3
      b = bInput(i)
      c = bInput(i + 1)
      d = bInput(i + 2)
      bOutput(CurrentOut) = m_Index1(b And &HFC)
      bOutput(CurrentOut + 1) = m_Index2((b And &H3) Or (c And &HF0))
      bOutput(CurrentOut + 2) = m_Index3((c And &HF) Or (d And &HC0))
      bOutput(CurrentOut + 3) = m_Index4(d And &H3F)
      CurrentOut = CurrentOut + 4
      linelength = linelength + 4
      
      If linelength >= MAX_LINELENGTH Then
         If i <> l - 2 Then  ' If this is the last line, don't add crlf
            bOutput(CurrentOut) = CHAR_CR
            bOutput(CurrentOut + 1) = CHAR_LF
         End If
         CurrentOut = CurrentOut + 2
         linelength = 0
      End If
   Next i
   
   Select Case l - i
      Case 1:
         b = bInput(i)
         c = bInput(i + 1)
         d = 0
         bOutput(CurrentOut) = m_Index1(b And &HFC)
         bOutput(CurrentOut + 1) = m_Index2((b And &H3) Or (c And &HF0))
         bOutput(CurrentOut + 2) = m_Index3((c And &HF) Or (d And &HC0))
         bOutput(CurrentOut + 3) = CHAR_EQUAL
         CurrentOut = CurrentOut + 4
         linelength = linelength + 4
      Case 0:
         b = bInput(i)
         c = 0
         bOutput(CurrentOut) = m_Index1(b And &HFC)
         bOutput(CurrentOut + 1) = m_Index2((b And &H3) Or (c And &HF0))
         bOutput(CurrentOut + 2) = CHAR_EQUAL
         bOutput(CurrentOut + 3) = CHAR_EQUAL
         CurrentOut = CurrentOut + 4
         linelength = linelength + 4
   End Select
   
   EncodeArr = bOutput
End Function


Private Function DecodeArr(bInput() As Byte) As Byte()
   Dim bOutput() As Byte
   Dim OutLength As Long
   Dim CurrentOut As Long
   
   Dim k As Long
   Dim l As Long
   Dim i As Long
   Dim j As Long
   
   Dim b As Byte
   Dim c As Byte
   Dim d As Byte
   Dim e As Byte
   
   k = LBound(bInput)
   l = UBound(bInput)
   
   'Calculate the length of the input
   i = l - k + 1
   
   'Calculate the expected length of the output
   'It should be no more (but may possible be less)
   j = i Mod (MAX_LINELENGTH + 2)
   If j = 0 Then
      OutLength = (i \ (MAX_LINELENGTH + 2)) * (MAX_LINELENGTH \ 4) * 3
   Else
      j = (j / 4) * 3
      If bInput(l) = CHAR_EQUAL Then j = j - 1
      If bInput(l - 1) = CHAR_EQUAL Then j = j - 1
      OutLength = (i \ (MAX_LINELENGTH + 2)) * (MAX_LINELENGTH \ 4) * 3 + j
   End If
   
   'Allocate the output
   ReDim bOutput(0 To OutLength - 1)
   
   CurrentOut = 0
   
   For i = k To l
      Select Case bInput(i)
         Case CHAR_CR
            'Do nothing
         Case CHAR_LF
            'Do nothing
         Case Else
            If l - i >= 3 Then
               b = bInput(i)
               c = bInput(i + 1)
               d = bInput(i + 2)
               e = bInput(i + 3)
               
               If e <> CHAR_EQUAL Then
                  bOutput(CurrentOut) = m_ReverseIndex1(b) Or m_ReverseIndex2(c, 0)
                  bOutput(CurrentOut + 1) = m_ReverseIndex2(c, 1) Or m_ReverseIndex3(d, 0)
                  bOutput(CurrentOut + 2) = m_ReverseIndex3(d, 1) Or m_ReverseIndex4(e)
                  CurrentOut = CurrentOut + 3
                  i = i + 3
               ElseIf d <> CHAR_EQUAL Then
                  bOutput(CurrentOut) = m_ReverseIndex1(b) Or m_ReverseIndex2(c, 0)
                  bOutput(CurrentOut + 1) = m_ReverseIndex2(c, 1) Or m_ReverseIndex3(d, 0)
                  CurrentOut = CurrentOut + 2
                  i = i + 3
               Else
                  bOutput(CurrentOut) = m_ReverseIndex1(b) Or m_ReverseIndex2(c, 0)
                  CurrentOut = CurrentOut + 1
                  i = i + 3
               End If
               
            Else
               'Possible input code error, but may also be
               'an extra CrLf, so we will ignore it.
            End If
      End Select
   Next i
   
   'On properly formed input we should have to do this.
   If OutLength <> CurrentOut + 1 Then
      ReDim Preserve bOutput(0 To CurrentOut - 1)
   End If
   
   DecodeArr = bOutput
End Function


Private Sub Class_Initialize()
   Dim i As Long
   
   'Setup the encodeing and decoding lookup arrays.
   'Essentially we speed up the routine by pre-shifting
   'the data so it only needs combined with And and Or.
   m_Index4(0) = 65 'Asc("A")
   m_Index4(1) = 66 'Asc("B")
   m_Index4(2) = 67 'Asc("C")
   m_Index4(3) = 68 'Asc("D")
   m_Index4(4) = 69 'Asc("E")
   m_Index4(5) = 70 'Asc("F")
   m_Index4(6) = 71 'Asc("G")
   m_Index4(7) = 72 'Asc("H")
   m_Index4(8) = 73 'Asc("I")
   m_Index4(9) = 74 'Asc("J")
   m_Index4(10) = 75 'Asc("K")
   m_Index4(11) = 76 'Asc("L")
   m_Index4(12) = 77 'Asc("M")
   m_Index4(13) = 78 'Asc("N")
   m_Index4(14) = 79 'Asc("O")
   m_Index4(15) = 80 'Asc("P")
   m_Index4(16) = 81 'Asc("Q")
   m_Index4(17) = 82 'Asc("R")
   m_Index4(18) = 83 'Asc("S")
   m_Index4(19) = 84 'Asc("T")
   m_Index4(20) = 85 'Asc("U")
   m_Index4(21) = 86 'Asc("V")
   m_Index4(22) = 87 'Asc("W")
   m_Index4(23) = 88 'Asc("X")
   m_Index4(24) = 89 'Asc("Y")
   m_Index4(25) = 90 'Asc("Z")
   m_Index4(26) = 97 'Asc("a")
   m_Index4(27) = 98 'Asc("b")
   m_Index4(28) = 99 'Asc("c")
   m_Index4(29) = 100 'Asc("d")
   m_Index4(30) = 101 'Asc("e")
   m_Index4(31) = 102 'Asc("f")
   m_Index4(32) = 103 'Asc("g")
   m_Index4(33) = 104 'Asc("h")
   m_Index4(34) = 105 'Asc("i")
   m_Index4(35) = 106 'Asc("j")
   m_Index4(36) = 107 'Asc("k")
   m_Index4(37) = 108 'Asc("l")
   m_Index4(38) = 109 'Asc("m")
   m_Index4(39) = 110 'Asc("n")
   m_Index4(40) = 111 'Asc("o")
   m_Index4(41) = 112 'Asc("p")
   m_Index4(42) = 113 'Asc("q")
   m_Index4(43) = 114 'Asc("r")
   m_Index4(44) = 115 'Asc("s")
   m_Index4(45) = 116 'Asc("t")
   m_Index4(46) = 117 'Asc("u")
   m_Index4(47) = 118 'Asc("v")
   m_Index4(48) = 119 'Asc("w")
   m_Index4(49) = 120 'Asc("x")
   m_Index4(50) = 121 'Asc("y")
   m_Index4(51) = 122 'Asc("z")
   m_Index4(52) = 48 'Asc("0")
   m_Index4(53) = 49 'Asc("1")
   m_Index4(54) = 50 'Asc("2")
   m_Index4(55) = 51 'Asc("3")
   m_Index4(56) = 52 'Asc("4")
   m_Index4(57) = 53 'Asc("5")
   m_Index4(58) = 54 'Asc("6")
   m_Index4(59) = 55 'Asc("7")
   m_Index4(60) = 56 'Asc("8")
   m_Index4(61) = 57 'Asc("9")
   m_Index4(62) = 43 'Asc("+")
   m_Index4(63) = 47 'Asc("/")
   
   'Calculate the other Arrays
   For i = 0 To 63
      m_Index1((i * 4) And &HFC) = m_Index4(i)
      m_Index2(((i And &HF) * 16) Or ((i And &H30) \ 16)) = m_Index4(i)
      m_Index3((i \ 4 And &HF) Or ((i And &H3) * 64)) = m_Index4(i)
   Next i
   
   
   m_ReverseIndex4(65) = 0 'Asc("A")
   m_ReverseIndex4(66) = 1 'Asc("B")
   m_ReverseIndex4(67) = 2 'Asc("C")
   m_ReverseIndex4(68) = 3 'Asc("D")
   m_ReverseIndex4(69) = 4 'Asc("E")
   m_ReverseIndex4(70) = 5 'Asc("F")
   m_ReverseIndex4(71) = 6 'Asc("G")
   m_ReverseIndex4(72) = 7 'Asc("H")
   m_ReverseIndex4(73) = 8 'Asc("I")
   m_ReverseIndex4(74) = 9 'Asc("J")
   m_ReverseIndex4(75) = 10 'Asc("K")
   m_ReverseIndex4(76) = 11 'Asc("L")
   m_ReverseIndex4(77) = 12 'Asc("M")
   m_ReverseIndex4(78) = 13 'Asc("N")
   m_ReverseIndex4(79) = 14 'Asc("O")
   m_ReverseIndex4(80) = 15 'Asc("P")
   m_ReverseIndex4(81) = 16 'Asc("Q")
   m_ReverseIndex4(82) = 17 'Asc("R")
   m_ReverseIndex4(83) = 18 'Asc("S")
   m_ReverseIndex4(84) = 19 'Asc("T")
   m_ReverseIndex4(85) = 20 'Asc("U")
   m_ReverseIndex4(86) = 21 'Asc("V")
   m_ReverseIndex4(87) = 22 'Asc("W")
   m_ReverseIndex4(88) = 23 'Asc("X")
   m_ReverseIndex4(89) = 24 'Asc("Y")
   m_ReverseIndex4(90) = 25 'Asc("Z")
   m_ReverseIndex4(97) = 26 'Asc("a")
   m_ReverseIndex4(98) = 27 'Asc("b")
   m_ReverseIndex4(99) = 28 'Asc("c")
   m_ReverseIndex4(100) = 29 'Asc("d")
   m_ReverseIndex4(101) = 30 'Asc("e")
   m_ReverseIndex4(102) = 31 'Asc("f")
   m_ReverseIndex4(103) = 32 'Asc("g")
   m_ReverseIndex4(104) = 33 'Asc("h")
   m_ReverseIndex4(105) = 34 'Asc("i")
   m_ReverseIndex4(106) = 35 'Asc("j")
   m_ReverseIndex4(107) = 36 'Asc("k")
   m_ReverseIndex4(108) = 37 'Asc("l")
   m_ReverseIndex4(109) = 38 'Asc("m")
   m_ReverseIndex4(110) = 39 'Asc("n")
   m_ReverseIndex4(111) = 40 'Asc("o")
   m_ReverseIndex4(112) = 41 'Asc("p")
   m_ReverseIndex4(113) = 42 'Asc("q")
   m_ReverseIndex4(114) = 43 'Asc("r")
   m_ReverseIndex4(115) = 44 'Asc("s")
   m_ReverseIndex4(116) = 45 'Asc("t")
   m_ReverseIndex4(117) = 46 'Asc("u")
   m_ReverseIndex4(118) = 47 'Asc("v")
   m_ReverseIndex4(119) = 48 'Asc("w")
   m_ReverseIndex4(120) = 49 'Asc("x")
   m_ReverseIndex4(121) = 50 'Asc("y")
   m_ReverseIndex4(122) = 51 'Asc("z")
   m_ReverseIndex4(48) = 52 'Asc("0")
   m_ReverseIndex4(49) = 53 'Asc("1")
   m_ReverseIndex4(50) = 54 'Asc("2")
   m_ReverseIndex4(51) = 55 'Asc("3")
   m_ReverseIndex4(52) = 56 'Asc("4")
   m_ReverseIndex4(53) = 57 'Asc("5")
   m_ReverseIndex4(54) = 58 'Asc("6")
   m_ReverseIndex4(55) = 59 'Asc("7")
   m_ReverseIndex4(56) = 60 'Asc("8")
   m_ReverseIndex4(57) = 61 'Asc("9")
   m_ReverseIndex4(43) = 62 'Asc("+")
   m_ReverseIndex4(47) = 63 'Asc("/")
   
   'Calculate the other arrays.
   For i = 0 To 255
      If m_ReverseIndex4(i) <> 0 Then
         m_ReverseIndex1(i) = m_ReverseIndex4(i) * 4
         
         m_ReverseIndex2(i, 0) = m_ReverseIndex4(i) \ 16
         m_ReverseIndex2(i, 1) = (m_ReverseIndex4(i) And &HF) * 16
         
         m_ReverseIndex3(i, 0) = m_ReverseIndex4(i) \ 4
         m_ReverseIndex3(i, 1) = (m_ReverseIndex4(i) And &H3) * 64
      End If
   Next i
End Sub

todaynew

回复 hjb016 的帖子

支持加密，坚决潜伏！
   

yuly

md5现在都可以在网站中查询得到了

li08hua

谢谢分享！

xuwenning

谢谢分享
收藏了

wuheng

谢谢~~~~~~~````收藏中~~