VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CMailSubBody"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'variables locales de stockage des valeurs de propriétés
Private mvarContent As String 'copie locale
Private mvarMIMEHeader As CMIMEHeader 'copie locale

Public Property Set MIMEHeader(ByVal vData As CMIMEHeader)
'utilisé lors de l'affectation d'un objet à la propriété, du coté gauche de l'instruction Set.
'Syntax: Set x.MIMEHeader = Form1
    Set mvarMIMEHeader = vData
End Property


Public Property Get MIMEHeader() As CMIMEHeader
'utilisé lors de la lecture de la valeur de la propriété, du coté droit de l'instruction.
'Syntax: Debug.Print X.MIMEHeader
    Set MIMEHeader = mvarMIMEHeader
End Property



Public Property Let Content(ByVal vData As String)
'utilisé lors de l'affectation d'une valeur à la propriété, du coté gauche de l'affectation.
'Syntax: X.Content = 5
    mvarContent = vData
End Property


Public Property Get Content() As String
'utilisé lors de la lecture de la valeur de la propriété, du coté droit de l'instruction.
'Syntax: Debug.Print X.Content
    Content = mvarContent
End Property

Private Function Unfolding(szHeaders As String) As String
Unfolding = Replace(szHeaders, vbCrLf & vbTab, " ")
Unfolding = Replace(Unfolding, vbCrLf & " ", " ")
End Function

Public Sub Parse(szMail As String)
Dim szHeaders As String, szBody As String
Dim pos As Long, body As CMailBody

pos = InStr(szMail, vbCrLf & vbCrLf)

szHeaders = Mid$(szMail, 1, pos - 1)
szHeaders = Unfolding(szHeaders)

'set defaults
With mvarMIMEHeader.ContentType
    .CTType = "text"
    .CTSubType = "plain"
    .charset = "us-ascii"
End With
With mvarMIMEHeader.ContentDisposition
    .CDType = "inline"
End With
mvarMIMEHeader.ContentTransfertEncoding = "7bit"

mvarMIMEHeader.Parse szHeaders

szBody = Mid$(szMail, pos + 1)

mvarContent = szBody
End Sub

Public Function ExtractText(lpText As String) As Boolean
With mvarMIMEHeader
    If .ContentType.CTType = "text" Then
        Select Case .ContentTransfertEncoding
            Case "base64"
                lpText = DecodeB64ToString(mvarContent)
            Case "quoted-printable"
                lpText = DecodeQPToString(mvarContent)
            Case Else
                lpText = mvarContent
        End Select
        ExtractText = True
    Else
        ExtractText = False
    End If
End With
End Function

Public Function ExtractImage(lpImage As StdPicture) As Boolean
With mvarMIMEHeader
    If .ContentType.CTType = "image" Then
        Select Case .ContentTransfertEncoding
            Case "base64"
                lpText = DecodeB64ToPicture(mvarContent)
            Case "quoted-printable"
                lpText = DecodeQPToPicture(mvarContent)
            Case Else
                lpText = StringToPicture(mvarContent)
        End Select
        ExtractText = True
    Else
        ExtractText = False
    End If
End With
End Function

Public Function ExtractBinary(lpBuff() As Byte) As Boolean
With mvarMIMEHeader
    Select Case .ContentTransfertEncoding
        Case "base64"
            lpBuff = DecodeB64ToBinary(mvarContent)
        Case "quoted-printable"
            lpBuff = DecodeQPToBinary(mvarContent)
        Case Else
            lpBuff = mvarContent
    End Select
    ExtractText = True
End With
End Function
