VB icon

base64 decoder

Email
Submitted on: 1/5/2015 1:52:00 PM
By: Tair Abdurman (from psc cd)  
Level: Intermediate
User Rating: By 3 Users
Compatibility: VB 5.0, VB 6.0
Views: 783
 
     Decode base64 encoded Input file into Output file.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: base64 decoder
' Description:Decode base64 encoded Input file into Output file.
' By: Tair Abdurman (from psc cd)
'**************************************

'(C) 2000 by Tair Abdurman
'WWW: www.tair.freeservers.com
'e-mail: broadcast_line@usa.net
'this version to decode Outlook encrypted
'attachments
'Base64 decode routines
' based on RFC 1421
'----------------------------------------------------------------------------------------------------
' Quantum of decoded content
'----------------------------------------------------------------------------------------------------
'3 2 1 0
' 00XXXXXX 00XXXXXX 00XXXXXX 00XXXXXX
' || | | || || | |||
'A1A2 B1B2C1C2
'----------------------------------------------------------------------------------------------------
' Bit positions:
'----------------------------------------------------------------------------------------------------
'AND SHIFT RIGHT SHIFT LEFT BYTE NUMB
'A13FH 01H 08H3
'A230H 10H 01H2
'
'B1 0FH 01H10H2
'B2 3CH 08H01H1
'
'C1 03H 01H40H1
'C2 3FH 01H01H0
'----------------------------------------------------------------------------------------------------
' Decoded Triple
' DADB DC
' XXXXXXXX XXXXXXXX XXXXXXXX
'----------------------------------------------------------------------------------------------------
'VB Formula:
'Ydecoded(DZ)=(Xencoded(Z1bytenum) AND Z1and)*Z1shiftright +
'(Xencoded(Z2bytenum) AND Z2and)/Z2shiftleft
'----------------------------------------------------------------------------------------------------
Option Explicit
Private Type b64encoded
 Byte1 As Byte
 Byte2 As Byte
 Byte3 As Byte
 Byte4 As Byte
End Type
Private Type b64decoded
 Byte1 As Byte
 Byte2 As Byte
 Byte3 As Byte
End Type
Private Type codecodeBytes
 Byte1 As Byte
 Byte2 As Byte
 Byte3 As Byte
 Byte4 As Byte
End Type
Dim keyByteA As codecodeBytes
Dim keyByteB As codecodeBytes
Dim keyByteC As codecodeBytes
Private Sub InitDecodeEncodeMachine()
 
'-------------------------------
keyByteA.Byte1 = &H3F
keyByteA.Byte2 = &H4
keyByteA.Byte3 = &H30
keyByteA.Byte4 = &H10
'-------------------------------
'-------------------------------
keyByteB.Byte1 = &HF
keyByteB.Byte2 = &H10
keyByteB.Byte3 = &H3C
keyByteB.Byte4 = &H4
'-------------------------------
'-------------------------------
keyByteC.Byte1 = &H3
keyByteC.Byte2 = &H40
keyByteC.Byte3 = &H3F
keyByteC.Byte4 = &H1
'-------------------------------
End Sub
'Decode source file encoded by base64 into destination
Public Sub DecodeFile(ByVal srcFile As String, ByVal dstFile As String)
Dim tempBuffer As String * 78
Dim tempBufferNC As String * 74
Dim tempEncoded As b64encoded
Dim tempDecoded As b64decoded
Dim bResult As Byte
Dim iCntr As Long
Dim btResult As Byte
Call InitDecodeEncodeMachine
btResult = 0
iCntr = 0
 
Open srcFile For Random As #1 Len = 78
Open dstFile For Random As #2 Len = 1
 
 Do While Not (EOF(1))
Get #1, , tempBuffer
iCntr = 0
Do While iCntr < Len(tempBuffer)
If Mid(tempBuffer, (iCntr + 1), 2) = vbCrLf Then Exit Do
tempEncoded.Byte1 = DeMapCode(Mid(tempBuffer, (iCntr + 1), 1))
tempEncoded.Byte2 = DeMapCode(Mid(tempBuffer, (iCntr + 2), 1))
tempEncoded.Byte3 = DeMapCode(Mid(tempBuffer, (iCntr + 3), 1))
tempEncoded.Byte4 = DeMapCode(Mid(tempBuffer, (iCntr + 4), 1))
bResult = 0
bResult = Base64Decode(tempEncoded, tempDecoded)
Select Case bResult
Case 1
Put #2, , tempDecoded.Byte1
Case 2
Put #2, , tempDecoded.Byte1
Put #2, , tempDecoded.Byte2
Case 3
Put #2, , tempDecoded.Byte1
Put #2, , tempDecoded.Byte2
Put #2, , tempDecoded.Byte3
End Select
 
'EOF encoded part
If (bResult = 0) Then Exit Do
 
'FOUR bytes as step
iCntr = iCntr + 4
Loop
'if end of encoded text
If (bResult = 0) Then Exit Do
 Loop
 
Close #2
Close #1
End Sub
Private Function Base64Decode(srcBase64Encoded As b64encoded, dstBase64Decoded As b64decoded) As Byte
'return amoun of decoded bytes
If (srcBase64Encoded.Byte1 > 64) Then
 Base64Decode = 0
 Exit Function
End If
If ((srcBase64Encoded.Byte3 = 64) And (srcBase64Encoded.Byte4 = 64)) Then
 dstBase64Decoded.Byte1 = (srcBase64Encoded.Byte1 And keyByteA.Byte1) * keyByteA.Byte2 + _
 (srcBase64Encoded.Byte2 And keyByteA.Byte3) / keyByteA.Byte4
 dstBase64Decoded.Byte2 = 0
 dstBase64Decoded.Byte3 = 0
 Base64Decode = 1
 Exit Function
End If
If (srcBase64Encoded.Byte4 = 64) Then
 dstBase64Decoded.Byte1 = (srcBase64Encoded.Byte1 And keyByteA.Byte1) * keyByteA.Byte2 + _
(srcBase64Encoded.Byte2 And keyByteA.Byte3) / keyByteA.Byte4
 dstBase64Decoded.Byte2 = (srcBase64Encoded.Byte2 And keyByteB.Byte1) * keyByteB.Byte2 + _
(srcBase64Encoded.Byte3 And keyByteB.Byte3) / keyByteB.Byte4
 dstBase64Decoded.Byte3 = 0
 Base64Decode = 2
 Exit Function
End If
dstBase64Decoded.Byte1 = (srcBase64Encoded.Byte1 And keyByteA.Byte1) * keyByteA.Byte2 + _
(srcBase64Encoded.Byte2 And keyByteA.Byte3) / keyByteA.Byte4
dstBase64Decoded.Byte2 = (srcBase64Encoded.Byte2 And keyByteB.Byte1) * keyByteB.Byte2 + _
(srcBase64Encoded.Byte3 And keyByteB.Byte3) / keyByteB.Byte4
dstBase64Decoded.Byte3 = (srcBase64Encoded.Byte3 And keyByteC.Byte1) * keyByteC.Byte2 + _
(srcBase64Encoded.Byte4 And keyByteC.Byte3) / keyByteC.Byte4
Base64Decode = 3
 
End Function
Private Function DeMapCode(srcChar As String) As Byte
If Len(srcChar) <> 1 Then
DeMapCode = 0
Exit Function
End If
Select Case srcChar
Case "A" To "Z"
DeMapCode = Asc(srcChar) - 65
Case "a" To "z"
DeMapCode = Asc(srcChar) - 97 + 26
Case "0" To "9"
DeMapCode = Asc(srcChar) - 48 + 52
Case "+"
DeMapCode = 62
Case "/"
DeMapCode = 63
Case "="
DeMapCode = 64
Case Else
DeMapCode = 65
End Select
End Function


Other 5 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.