cmessage.cls

vb代码集,收集许多VB网络编程代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CMessage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Description = "RFC822 e-mail message."
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'local variables to hold property values
Private m_strReturnPath      As String
Private m_strReceived        As String
Private m_strSendDate        As String
Private m_strMessageID       As String
Private m_strMessageTo       As String
Private m_strFrom            As String
Private m_strSubject         As String
Private m_strReplyTo         As String
Private m_strSender          As String
Private m_strCC              As String
Private m_strBCC             As String
Private m_strInReplyTo       As String
Private m_strReferences      As String
Private m_strKeywords        As String
Private m_strComments        As String
Private m_strEncrypted       As String
Private m_strMessageText     As String
Private m_strMessageBody     As String
Private m_strHeaders         As String
Private m_lSize              As Long
Private mvarAttachments      As CAttachments
'

Public Property Set Attachments(ByVal vData As CAttachments)
    Set mvarAttachments = vData
End Property

Public Property Get Attachments() As CAttachments
    Set Attachments = mvarAttachments
End Property

Public Sub CreateFromText(strMessage As String)

    Dim intPosA         As Integer
    Dim intPosB         As Integer
    Dim vHeaders        As Variant
    Dim vField          As Variant
    Dim strHeader       As String
    Dim strHeaderName   As String
    Dim strHeaderValue  As String
    
    intPosA = InStr(1, strMessage, vbCrLf & vbCrLf)
    If intPosA Then
        m_strHeaders = Left$(strMessage, intPosA - 1)
        m_strMessageBody = Right$(strMessage, Len(strMessage) - intPosA - 3)
        m_strMessageText = strMessage
        '
        'look for attacments
        '
        Dim strFileName   As String
        Dim strAttachment As String
        Dim lngFileSize   As Long
        Dim lngFirstBegin As Long
        Dim lngFullStrings As Long
        Const ENCODED_LINE_LENGTH = 61
        '
        intPosA = 1
        Do
            'Looking for the start marker - "begin "
            intPosA = InStr(intPosA, m_strMessageBody, vbCrLf & "begin ") + 2
             'Exit from the loop if it hasn't found
            If intPosA = 2 Then Exit Do
            'remember the position of the first marker
            If lngFirstBegin = 0 Then lngFirstBegin = intPosA - 2
             'looking for the end of string the marker belongs to
            intPosB = InStr(intPosA + 1, m_strMessageBody, vbCrLf)
            If intPosB > 0 Then
                'check whether it is real marker or just