'**************************************
' Name: QP Decode
' Description:The following code is based on code submitted by: AndrComm
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=3113&lngWId=1
His code is designed to decode quoted-printable text transmitted
in an email, and is straight forward and relatively quick. However,
I ran into a number of complications when attempting to use it.
' By: J.A. Coutts
'
'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=74601&lngWId=1'for details.'**************************************
The first problem was with the line:
sTemp = Replace(sTemp, "=", "")
It removes any remaining "=" signs, which is not required by RFC 2045 and
causes complications. It can safely be removed.
The next problem was with the line:
For i = 32 To 10 Step -1
Codes 0 to 9 were separated from codes 10 to 32 because of the number of
digits involved. Unfortunately, that left out the single digit hex codes A
to F (10 to 15). I replaced both of these routines with a single routine.
The next problem encountered was with what they call dot-stuffing. With
the SMTP protocol, a single dot on a line by itself signifies the end of
the message. When the message lines are reduced to 76 characters, there is
a possibility that a dot could be left on a line by itself. To prevent
this, they add an extra dot if the line begins with a dot. Code was added
to remove this extra dot.
I have no idea why, but some vendors add multiple "=" signs before and
after the boundary string as part of the actual string. The last "="
sign in this string gets interpreted as a soft end-of-line. I added code
to preserve this string.
Everyone seems to have their own solution to dealing with the single dot
problem. One vendor replaced all dots with quoted-printable characters.
Codes 33 to 127 do not require coding, but I had to add code to deal with
this bizarre situation.
Public Function DecodeQP(ByRef StrToDecode As String) As String
Dim sTemp As String
Dim N%
sTemp = StrToDecode
'Check for dot stuffing at beginning of line
If InStr(sTemp, vbCrLf & "..") <> 0 Then
sTemp = Replace(sTemp, vbCrLf & "..", vbCrLf & ".")
End If
'Substitute temporary code for "==" chars at end of line
If InStr(1, sTemp, "==" & vbCrLf) <> 0 Then
sTemp = Replace(sTemp, "==" & vbCrLf, "==" & Chr$(255) & Chr$(254))
'Delete soft end of lines
sTemp = Replace(sTemp, "=" & vbCrLf, "")
'Restore original "==" signs
sTemp = Replace(sTemp, "==" & Chr$(255) & Chr$(254), "==" & vbCrLf)
Else 'Just delete soft end of lines
sTemp = Replace(sTemp, "=" & vbCrLf, "")
End If
'Restore non ASCII chars
For N% = 255 To 127 Step -1
If InStr(1, sTemp, "=" & Hex$(N%)) <> 0 Then
sTemp = Replace(sTemp, "=" & Hex$(N%), Chr$(N%))
End If
Next N%
'Restore periods
If InStr(1, sTemp, "=2E") <> 0 Then
sTemp = Replace(sTemp, "=2E", ".")
End If
'Substitute temporary code for "=" signs
If InStr(1, sTemp, "=" & Hex$(61)) <> 0 Then _
sTemp = Replace(sTemp, "=" & Hex$(61), Chr$(255) & Chr$(254))
'Restore control codes
For N% = 32 To 0 Step -1
If InStr(1, sTemp, "=" & Right$("0" & Hex$(N%), 2)) <> 0 Then
sTemp = Replace(sTemp, "=" & Right$("0" & Hex$(N%), 2), Chr$(N%))
End If
Next N%
'sTemp = Replace(sTemp, "=", "") 'Replace remaining "=" signs
sTemp = Replace(sTemp, Chr$(255) & Chr$(254), "=") 'Restore original "=" signs
DecodeQP = sTemp
End Function
|
