home *** CD-ROM | disk | FTP | other *** search
- Attribute VB_Name = "MIME_Coding"
- Private Const base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
-
- Public Function base64_encode(DecryptedText As String) As String
- Dim c1, c2, c3 As Integer
- Dim w1 As Integer
- Dim w2 As Integer
- Dim w3 As Integer
- Dim w4 As Integer
- Dim n As Integer
- Dim retry As String
- For n = 1 To Len(DecryptedText) Step 3
- c1 = Asc(Mid$(DecryptedText, n, 1))
- c2 = Asc(Mid$(DecryptedText, n + 1, 1) + Chr$(0))
- c3 = Asc(Mid$(DecryptedText, n + 2, 1) + Chr$(0))
- w1 = Int(c1 / 4)
- w2 = (c1 And 3) * 16 + Int(c2 / 16)
- If Len(DecryptedText) >= n + 1 Then w3 = (c2 And 15) * 4 + Int(c3 / 64) Else w3 = -1
- If Len(DecryptedText) >= n + 2 Then w4 = c3 And 63 Else w4 = -1
- retry = retry + mimeencode(w1) + mimeencode(w2) + mimeencode(w3) + mimeencode(w4)
- Next
- base64_encode = retry
- End Function
-
- Public Function base64_decode(a As String) As String
- Dim w1 As Integer
- Dim w2 As Integer
- Dim w3 As Integer
- Dim w4 As Integer
- Dim n As Integer
- Dim retry As String
-
- For n = 1 To Len(a) Step 4
- w1 = mimedecode(Mid$(a, n, 1))
- w2 = mimedecode(Mid$(a, n + 1, 1))
- w3 = mimedecode(Mid$(a, n + 2, 1))
- w4 = mimedecode(Mid$(a, n + 3, 1))
- If w2 >= 0 Then retry = retry + Chr$(((w1 * 4 + Int(w2 / 16)) And 255))
- If w3 >= 0 Then retry = retry + Chr$(((w2 * 16 + Int(w3 / 4)) And 255))
- If w4 >= 0 Then retry = retry + Chr$(((w3 * 64 + w4) And 255))
- Next
- base64_decode = retry
- End Function
-
- Private Function mimeencode(w As Integer) As String
- If w >= 0 Then mimeencode = Mid$(base64, w + 1, 1) Else mimeencode = ""
- End Function
-
- Private Function mimedecode(a As String) As Integer
- If Len(a) = 0 Then mimedecode = -1: Exit Function
- mimedecode = InStr(base64, a) - 1
- End Function
-
-
-