Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как прочесть сообщение e-mail (*.eml). / 21 сообщений из 21, страница 1 из 1
21.01.2009, 17:57
    #35770217
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
В общем поставил себе задачу
1) получить e-mail (ы)
2) прочитать e-mail, т.е. для каждого e-mail узнать
a) с какого адреса
б) тема
в) body то бишь текст
с) количество вложений и имена этих файлов.
3) сохранить эти файлы и перечисленную выше информацию .

Задачу 1 я решил успешно.
Нарыл бинарник getmail для виндов, он почту проверяет и сохраняет письма целиком в файлах msg1.txt,msg2.txt...
Вложения также можно сохранять, но связи между ними и письмами после работы утилиты особо не просматривается.

Файлы txt, сохраняемые getmail-ом при переименовании в *.eml на ура открываются в Outlook Express.

Существует ли красивый способ "прочесть" файл (*.eml==*.txt) и сохранить вложение.

Про mapi мне все известно, все это я делать умею. И почту принимать, и вложения читать и т.п.
Даже программа с этими ocx давно и культурно написана.
Но сейчас это не то что мне нужно.

Если кто знает красивые решения, подскажите. Можно конечно, тупо читать письмо как текстовой файл, правда проге придется долго думать, какие же сохраненные вложения этому письму соотвествуют.
Облазил sourceforge.net, уж очень много там всего, по идее нужно что-то типа procmail , но под винды приличного бинарника не нашел...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
21.01.2009, 21:28
    #35770564
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
продолжаю размышлять...
а чем отличается *.eml от *.msg ??? и getmail какой формат делает, в *.eml я файл из txt сам переименовывал...
Email Parser -это вроде как то что мне нужно...
Нашел тут одну вещь...
http://sourceforge.net/projects/ssfiledll/
Outlook Msg file parser dll, for retrival of information (such as sender name and address, recipieants names and address, body text, email header form outlook msg file, without using outlook. Either using mapi or ole2 to parse the structured storage file
В двух вариантах типа с мапи и без него.
И в описании Declare для vb.... надо попробовать, м.б. это то что надо...
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
//-----------------------------------------------------------------------------------
Example VB code 

Public Declare Function OpenEmail Lib "SSFileDLL.dll" _
    (ByVal szString As String) As Boolean
Public Declare Function CloseEmail Lib "SSFileDLL.dll" _
    () As Boolean
    
Public Declare Function GetEmailData Lib "SSFileDLL.dll" _
    (ByVal szString As String) As String

Public Declare Function GetEmailHeader Lib "SSFileDLL.dll" _
    () As String


Public Declare Function GetEmailSubject Lib "SSFileDLL.dll" _
    () As String

Public Declare Function GetEmailBody Lib "SSFileDLL.dll" _
    () As String
Public Declare Function GetHTMLEmailBody Lib "SSFileDLL.dll" _
    () As String
    
Public Declare Function GetEmailSenderAddress Lib "SSFileDLL.dll" _
    () As String
Public Declare Function GetEmailSenderName Lib "SSFileDLL.dll" _
    () As String
    
Public Declare Function GetEmailToAddress Lib "SSFileDLL.dll" _
    () As String
Public Declare Function GetEmailToName Lib "SSFileDLL.dll" _
    () As String
    
    
Public Declare Function GetEmailSize Lib "SSFileDLL.dll" _
    () As String
Public Declare Function GetEmailAttacmentCount Lib "SSFileDLL.dll" _
    () As Integer

Public Declare Function GetEmailReceivedTime Lib "SSFileDLL.dll" _
    () As String
Public Declare Function GetEmailSentOn Lib "SSFileDLL.dll" _
    () As String
    
Public Declare Function GetEmailTime Lib "SSFileDLL.dll" _
    () As String

Function GetSenderAddress()
	if OpenEmail(FileName) = true then
		rtn = GetEmailSenderAddress()
		if rtn <> "False" then
			msgbox "SenderAddress: " & rtn
		else
			msgbox "error"
		end if
		CloseEmail
	else
		msgbox "Invalid File"
	end if
End Function

/
Вопрос только сразу возник, а вложения то оно сохранять умеет, хотя getmail умеет но надо еще потом соответствие как-то установить с правильным вложением-то...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.01.2009, 00:52
    #35770759
Antonariy
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Выкинуть getmail, принимать почту самостоятельно, сообщения разбирать через CDO.Message.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.01.2009, 02:20
    #35770809
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Что значит самостоятельно?
Это вот так что ли?
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
Private Sub ServiceTake_Click()
    StatusBar1.SimpleText = "Приём почты с сервера."
    Me.Refresh
    Form2.MAPISession1.DownLoadMail = True
    Form2.MAPISession1.SignOn
    Form2.MAPISession1.SignOff
    Form2.MAPISession1.DownLoadMail = False
    StatusBar1.SimpleText = "Процедура приёма почты завершена!"
End Sub
Да это работает на ура, потом
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
...
    Form2.MAPISession1.SignOn
    Form2.MAPIMessages1.SessionID = Form2.MAPISession1.SessionID
    Form2.MAPIMessages1.Fetch
    ChPis = Form2.MAPIMessages1.MsgCount
    NumAtt =  0 
    If ChPis >  0  Then
        Set FSys1 = CreateObject("Scripting.FileSystemObject")
        For i =  0  To ChPis -  1 
            NeVse = False
            Form2.MAPIMessages1.MsgIndex = i
            OriginalOut = Form2.MAPIMessages1.MsgOrigAddress
            TemaOut = Form2.MAPIMessages1.MsgSubject
            If InStr(AdressVip, OriginalOut) Then GoTo konbox
            Form2.MAPIMessages1.Copy
            ChAtt = Form2.MAPIMessages1.AttachmentCount
            If ChAtt =  0  Then
                GoTo konbox
            ElseIf ChAtt >  0  Then
                For j =  0  To Form2.MAPIMessages1.AttachmentCount -  1 
                    Form2.MAPIMessages1.AttachmentIndex = j
...
Но:Ни почтовая программа(Outlook+-Express), ни всякие там Scripting.FileSystemObject, mapisessions и т.п. детский сад использоваться не должно...

От VB по сути требуется
Код: plaintext
shell(goodproga, vbhide)
Ну и далее уже на vb разбор полетов и передача результатов "серверу"...
И чем же getmail плох.
Другое дело, не стоит getmail использовать для отстыковки вложения, максимум чего он может, это приписать к названию файла mail-сервер of sender (а надо бы знать тему и самого sendera).

Приведенный выше пример не работает, уже доперло, что .msg и .eml суть разные вещи.
getmail делает txt=eml=MIME, и нужен MIME parser, таковых платных есть, но ну их...короче

После ну очень продолжительных поисков нашел, чего искал:
http://www.freevbcode.com/ShowCode.asp?ID=2540
В принципе работает, по сути эта хрень анализирует текстовое содержание файла,что я и думал делать, и делает все чего надо, но... русского юникода не понимает, поэтому может глючить, собственно знание русского для моей идеи и не требуется(обратное мыло всегда латиница, а тема-цифры номера телефона), но в силу вероятности наличия русского оно может глючить хуже:напр, не доходить до того места где вложение, т.е. если итти по этому пути, то можно взять за основу, но доводить придется. Ну и конечно файл вложения отделяется подольше чем 0,5сек, ну это уже издержки VB в отличии от C++, кот.увы на проф. уровне не знаю.

OK, пошел выяснять что есть CDO.Message ...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.01.2009, 03:13
    #35770832
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Че то мне это CDO не понравилось, что-то надо ставить, а м.б. и не надо. И очень это все похоже на MAPI, т.е. зависит от того чего в системе стоит.
Первый попавшийся пример кода на этом форуме у меня не заработал,
зачем-то еще adodb добавлять пришлось, похоже енто очень завязано на то, чего в системе есть или нет...
Бинарник getmail похоже надежней, гудвинов и хитрых библиотек по крайней мере не требует, а парсер так тот вообще из ничего написан, доводить только надо...

С отправкой кстати проще:есть такая штука blad.exe называется. Жаль что я ее 7 лет назад не нашел, не возился бы со всеми этими mapi-control-ami.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.01.2009, 11:06
    #35771282
Antonariy
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
авторЧто значит самостоятельно?
Это вот так что ли?Нет. Я имел ввиду winsock + pop3.
CDO ставить надо, однако не вижу в этом проблемы. Оно, кстати, и отправлять умеет. ADODB не надо, оно и так везде есть.
К MAPI все это отношения не имеет.

Чем не угодило fso?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
22.01.2009, 17:34
    #35772365
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Проблемы то нету, когда у себя ставишь, а когда эта фигня будет запускаться на произвольном неизвестном PC,то они будут. Не можно конечно ворох ocx-в за собой тащить, но мне так думается, это дурной тон. Куда кидать то их при установке? В папку с программой? Или в system32, где они м.б. уже есть. Заменять одни версии другими? Нехолосо как-то. А не заменять, если есть? А вдруг несовместимость. А етот крякнутый 5 лет назад getmail у меня фурычит, и на другом pc фурычить будет.

Короче сделал так:
1)getmail все принимает в папку mail, но не распаковывает
2)идем туда и последовательно курочим все письма
3)получаем усе что надо в GetMsgInfo, т.е. mail отправителя и тему из письма, параллельно другой командой getmail вынимаем все вложения из тек. письма в папку attach и составляем их описание
Из этого же кода запускаем "процедуру использования сего", после чего и само письмо и вложения убиваем.
4)переходим к след. письму.

Скачанный Парсер я использовать не стал, т.к. декодировать вложения на vb это очень долго, мой же наворот работает быстро и четко.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
Private Sub Command1_Click()
   GetMail "user", "pass", "pop.list.ru", "110"
    MessageProcess
End Sub
Private Sub Form_Load()
    CreateFolder App.Path & "\mail"
    CreateFolder App.Path & "\attach"
End Sub
Type MsgInfo
    Sender As String
    Subject As String
    Attach As String
End Type
Public Sub GetMail(user As String, password As String, PopServer As String, ServerPort As String)
    Dim str As String
    str = App.Path & "\getmail.exe -u " & user & " -pw " & password & " -s " & PopServer & " -port " _
      & ServerPort & " -delete -dir " & Chr( 34 ) & App.Path & "\mail" & Chr( 34 )
    ShellAndContinue str, vbHide
End Sub
Public Sub MessageProcess()
    Dim MsgFile As String
    Dim MsgInfo As MsgInfo
    Dim tmpName As String
    Do
        MsgFile = Dir(App.Path & "\mail\msg*")
        If Len(MsgFile) =  0  Then Exit Do
        MsgInfo = GetMsgInfo(MsgFile)
        MsgBox "From:" & MsgInfo.Sender & " Subject:" & MsgInfo.Subject & "Attachments: " & MsgInfo.Attach
        '-------------------------------------------
        '/////Прога_обработки_компонентов письма(MsgInfo)//////
        '-------------------------------------------
        'после обработки все можно удалить
        DeleteFile App.Path & "\mail\" & MsgFile
        Do
            tmpName = Dir(App.Path & "\attach\*.*")
            If Len(tmpName) >  0  Then
                DeleteFile App.Path & "\attach\" & tmpName
            Else
                Exit Do
            End If
        Loop
    Loop
End Sub
Function GetMsgInfo(MsgFile As String) As MsgInfo
Dim Text As New ClsText
Dim N As Long 'к-во строк
Dim strHeader As String, strHeaderName As String, strHeaderValue As String
Dim SenderOK As Boolean, SubjectOK As Boolean
Dim i As Long
Dim intPosa As Integer
Dim StrDoAttach As String
    'читаем заголовки сообщения:e-mail от кого и тема
    SenderOK = False
    SubjectOK = False
    GetMsgInfo.Sender = ""
    GetMsgInfo.Subject = ""
    GetMsgInfo.Attach = ""
    Text.OpenText App.Path & "\mail\" & MsgFile
    N = Text.Count
    For i =  1  To N
        strHeader = Text.stroka(i)
        intPosa = InStr( 1 , strHeader, ":")
        If intPosa Then
            strHeaderName = LCase(Left$(strHeader, intPosa -  1 ))
        Else
            strHeaderName = ""
        End If
        strHeaderValue = Trim$(Right$(strHeader, Len(strHeader) - intPosa))
        If strHeaderName = "from" Then
            If InStr(strHeaderValue, "<") >  0  Then 'нужен только e-mail
                strHeaderValue = Trim(Right(strHeaderValue, Len(strHeaderValue) - InStr(strHeaderValue, "<")))
                strHeaderValue = Trim(Left(strHeaderValue, InStr(strHeaderValue, ">") -  1 ))
            End If
            GetMsgInfo.Sender = strHeaderValue
            SenderOK = True
        ElseIf strHeaderName = "subject" Then
            GetMsgInfo.Subject = strHeaderValue
            SubjectOK = True
        End If
        If (SenderOK = True) And (SubjectOK = True) Then Exit For
    Next i
    'копируем текущее сообщение в папку для вложений
    CopyFile App.Path & "\mail\" & MsgFile, App.Path & "\attach\" & MsgFile, True
    'и делаем ее текущей в силу нек. мелких глюков getmail
    ChDrive Left(App.Path,  1 )
    ChDir App.Path & "\attach\"
    'сохраняем все вложения текущего письма в папке attach
    StrDoAttach = "..\getmail.exe -forceextract " & MsgFile
    ShellAndContinue StrDoAttach, vbHide
    DeleteFile App.Path & "\attach\" & MsgFile
    ChDir App.Path
    'описываем имена вложения
    GetMsgInfo.Attach = GetAllNames(App.Path & "\attach\")
End Function
Function GetAllNames(MyPath As String) As String
' Display the names in MyPath that represent files.
    Dim MyName
    GetAllNames = ""
    MyName = Dir(MyPath, vbNormal) ' Retrieve the first entry.
    Do While MyName <> "" ' Start the loop.
        ' Ignore the current directory and the encompassing directory.
        If MyName <> "." And MyName <> ".." Then
            ' Use bitwise comparison to make sure MyName is a file.
            If (GetAttr(MyPath & MyName) And vbNormal) = vbNormal Then
                If Len(GetAllNames) >  0  Then
                    GetAllNames = GetAllNames & ";" & MyName
                Else
                    GetAllNames = MyName
                End If
            End If ' it represents a file.
        End If
        MyName = Dir ' Get next entry.
    Loop
End Function
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
27.01.2009, 04:38
    #35778907
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Нет, не совсем хорошо.
getmail прекрасно принимает и сохраняет в eml-образных файлах txt
парсер "собственного производства" для того чтобы считать обратный mail и тему вполне годится, пусть даже с кириллицей в теме (кириллица в теме это уже однозначно неправильная тема, по замыслу программы).
а вот с вложениями беда... т.е. в общем случае работает, а в частных, кот. много беда
команда getmail Getmail.exe -forceextract msg1.txt глючноватая, работает только из директории, где лежит msg1.txt, скажем файлы rtf вообще не распаковывает, я уж не говорю о русских названиях файлов-здесь кстати это существенно. Команда -extract при принятии сообщения работает достойнее, но скажем тот же rtf не переваривает, надо ставить ключ -plain, тогда распаковывает но очень долго.

В общем набросанный выше код вполне меня устраивает, но нужно придумать корректный чисто распаковщик вложений из отдельного письма, читать при этом само письмо не обязательно.
Один очень хороший вариант я знаю: Outlook Express через mapi -на прием это легко и просто решает все задачи, но это частный случай, ибо почтовая программа не должна учавствовать, не у всех OE(не все работает через Mapi также хорошо как OE), в общем не пойдет. С CDO конечно можно покопаться, но описание, что чего-то надо устанавливать меня не радует.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
27.01.2009, 11:55
    #35779518
Antonariy
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
авторнужно придумать корректный чисто распаковщик вложений из отдельного письма, читать при этом само письмо не обязательноВложение это часть письма, прочитать вложение не прочитав письма невозможно.

Так и быть, дам на тарелочке часть кода, проверяющего почту, из антиспамовской программы. Код расчитан на работу с массивом винсоков, может проверять одновременно несколько ящиков.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
Public LastChecked As Date
Public LastSaved As Boolean
Public CheckPeriod As Integer

Private Sub Timer1_Timer()
Dim X As Integer
Dim Completed As Boolean
    On Error GoTo errh
    Completed = True
    For X =  0  To UBound(m_States)
        With m_States(X)
            If .State = POP3_VeryQUIT And .RETR =  0  Then
                If Not .Stored And Not .Error Then
                    .Stored = True
                End If
            End If
            Completed = Completed And (.Stored Or .Error) And .State = POP3_VeryQUIT
        End With
    Next
    If Not LastSaved And Completed Then
        SaveSetting App.Title, "Common", "LastChecked", LastChecked
        LastSaved = True
    End If
    If DateDiff("n", LastChecked, Now) >= Val(CheckPeriod) And Completed Then
        LastChecked = Now
        LastSaved = False
        InitStates True
        For X =  0  To UBound(m_States)
            Debug.Print X; "Connecting " & m_States(X).Server, "##################################################"
            Select Case m_States(X).Protocol
                Case pSMTP: Winsock1(X).Connect m_States(X).Server,  110 
                Case pIMAP: Winsock1(X).Connect m_States(X).Server,  143 
            End Select
        Next
    End If
    Exit Sub
errh:
    'frmReport.AddEvent "Timer - " & Err.Description, etError
    Debug.Print "Timer - " & Err.Description
    Exit Sub
    Resume
End Sub

Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    Select Case m_States(Index).Protocol
        Case pSMTP: DataArrivalSMTP Winsock1(Index), bytesTotal
        Case pIMAP: DataArrivalIMAP Winsock1(Index), bytesTotal
    End Select
End Sub

Private Sub Winsock1_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    m_States(Index).Error = True
    m_States(Index).State = POP3_VeryQUIT
    Winsock1(Index).Close
End Sub

Private Sub InitStates(Init4Work As Boolean)
Dim rs As ADODB.Recordset
Dim X As Integer, Y As Integer
    On Error Resume Next
    If Not OpenAccounts Then Exit Sub
    ReDim m_States(rsAccounts.RecordCount -  1 )
    While Not rsAccounts.EOF
        If Init4Work Then
            If X >  0  Then Load Winsock1(X)
            Winsock1(X).Close
            Winsock1(X).LocalPort =  0 
            Set rs = New ADODB.Recordset
            rs.Open "select * from Deleted where 1=2", cn, adOpenStatic, adLockBatchOptimistic
            Set m_States(X).RsDeleted = rs
            Set rs = Nothing
            m_States(X).State = POP3_Connect
        Else
            m_States(X).State = POP3_VeryQUIT
            m_States(X).Stored = True
        End If
        m_States(X).Protocol = rsAccounts!Type
        m_States(X).Login = rsAccounts!Login
        m_States(X).Pass = rsAccounts!Pass
        m_States(X).Account = rsAccounts!email
        m_States(X).AccountID = rsAccounts!AccountID
        m_States(X).Server = rsAccounts!Server
        rsAccounts.MoveNext
        X = X +  1 
    Wend
    For X =  1  To  4 
        If StaSave(X) Then Y = Y +  1 
    Next
    FastMode = Y /  2  <=  2 
End Sub

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
Public Enum POP3States
    POP3_Connect =  1 
    POP3_USER =  2 
    POP3_PASS =  3 
    POP3_STAT =  4 
    POP3_TOP =  5 
    POP3_DELE =  6 
    POP3_QUIT =  7 
    POP3_LIST =  8 
    POP3_VeryQUIT =  9 
    IMAP_EXPUNGE =  10 
    IMAP_COPY =  11 
    POP3_RETR =  12 
End Enum

Public Type WSState
    State As POP3States
    StateStat As Boolean
    AccountID As Long
    SpamCount As Integer
    MailCount As Integer
    MessagesCount As Integer
    Protocol As Proto
    Login As String
    Pass As String
    CurrentMsg As Integer
    BufferString As String
    IMAPStep As Integer
    Stored As Boolean
    Error As Boolean
    Account As String
    IMAPMsgs() As String
    RsDeleted As ADODB.Recordset
    RETR As Long
    Server As String
End Type

Public m_States() As WSState
Public FastMode As Boolean

Public Sub DataArrivalSMTP(Winsock1 As Winsock, ByVal bytesTotal As Long)
Dim m_oMessage As CMessage
Dim strData As String
Dim s As String
    On Error GoTo errh
    Winsock1.GetData strData
    With m_States(Winsock1.Index)
        'Debug.Print Winsock1.Index, strData
        If Left$(strData,  1 ) = "+" Or .State = POP3_TOP Or .State = POP3_RETR Then
            Select Case .State
                Case POP3_Connect
                    .MessagesCount =  0 
                    .State = POP3_USER
                    Winsock1.SendData "USER " & .Login & vbCrLf
                Case POP3_USER
                    .State = POP3_PASS
                    Winsock1.SendData "PASS " & .Pass & vbCrLf
                Case POP3_PASS
                    .State = POP3_STAT
                    Winsock1.SendData "STAT" & vbCrLf
                    Debug.Print Winsock1.Index; ">STAT"
                Case POP3_STAT
                    .MessagesCount = CInt(Mid$(strData,  5 , InStr( 5 , strData, " ") -  5 ))
                    If Not .StateStat Then
                        If .MessagesCount >  0  Then
                            .CurrentMsg =  1  '.MessagesCount
                            .MailCount = .MessagesCount
                            If FastMode Then
                                .State = POP3_TOP
                                Winsock1.SendData "TOP " & .CurrentMsg & " 0" & vbCrLf
                            Else
                                .State = POP3_RETR
                                Winsock1.SendData "RETR " & .CurrentMsg & vbCrLf
                            End If
                        Else
                            .MailCount =  0 
                            .State = POP3_QUIT
                            Winsock1.SendData "QUIT" & vbCrLf
                            .SpamCount =  0 
                        End If
                    Else
                        .SpamCount = .MailCount - .MessagesCount
                        .State = POP3_QUIT
                        Winsock1.SendData "QUIT" & vbCrLf
                    End If
                Case POP3_TOP, POP3_RETR
                    .BufferString = .BufferString & strData
                    If InStr( 1 , .BufferString, vbLf & "." & vbCrLf) Then
                        If InStr(.BufferString, "+") =  1  Then .BufferString = Mid$(.BufferString, InStr(.BufferString, vbCrLf) +  2 )
                        .BufferString = Left$(.BufferString, Len(.BufferString) -  3 )
                        Set m_oMessage = New CMessage
                        m_oMessage.AccountID = .AccountID
                        m_oMessage.Account = .Account
                        m_oMessage.CreateFromText .BufferString
                        'Debug.Print Winsock1.Index & " " & .CurrentMsg, m_oMessage.FromEmail, m_oMessage.FromName, m_oMessage.Subject
                        'Debug.Print .BufferString
                        'Debug.Print Winsock1.Index, m_oMessage.SendDate, m_oMessage.FromEmail
                        s = CheckMsg(m_oMessage, Winsock1.Index)
                        If .RETR <>  0  Then .RETR =  0 
                        Winsock1.SendData s
                    End If
                Case POP3_QUIT
                    Winsock1.Close
                    .State = POP3_VeryQUIT
                Case POP3_DELE
                    .CurrentMsg = .CurrentMsg +  1 
                    .BufferString = ""
                    If .CurrentMsg > .MessagesCount Then
                        .StateStat = True
                        .State = POP3_STAT
                        Winsock1.SendData "STAT" & vbCrLf
                    Else
                        If FastMode Then
                            .State = POP3_TOP
                            Winsock1.SendData "TOP " & .CurrentMsg & " 0" & vbCrLf
                        Else
                            .State = POP3_RETR
                            Winsock1.SendData "RETR " & .CurrentMsg & vbCrLf
                        End If
                    End If
            End Select
        Else
            Winsock1.SendData "QUIT" & vbCrLf
            .State = POP3_QUIT
            .Error = True
        End If
    End With
    Exit Sub
errh:
    With m_States(Winsock1.Index)
        frmReport.ctlProgress1.ErrDesc(Winsock1.Index) = LoadEnumString(, "ProgramError") & "DataArrivalSMTP - " & Err.Description
        Winsock1.Close
        Debug.Print Err.Description
        .State = POP3_VeryQUIT
        .Error = True
    End With
    Exit Sub
    Resume
End Sub
Класс CMessage

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
Option Explicit
Private m_strMessageText     As String
Private m_strMessageBody     As String
Private m_strHeaders         As String

Dim lCDOMessage As New CDO.Message

Public Sub CreateFromText(strMessage As String)
Dim st As ADODB.Stream
Dim X As Integer
    m_strMessageBody = strMessage
    X = InStr(m_strMessageBody, vbCrLf & vbCrLf)
    If X <>  0  Then
        m_strHeaders = Mid$(strMessage,  1 , X -  1 )
        m_strMessageText = Mid$(strMessage, X +  4 )
    Else
        m_strHeaders = strMessage
    End If
    
    Set st = lCDOMessage.GetStream
    st.Type = adTypeText
    st.WriteText strMessage
    st.Flush
End Sub

Public Property Get FromName() As String
    FromName = lCDOMessage.Fields("urn:schemas:httpmail:fromname").Value
End Property

Public Property Get FromEmail() As String
    FromEmail = Replace(Replace(lCDOMessage.Fields("urn:schemas:httpmail:fromemail").Value, "<", ""), ">", "")
End Property

Public Property Get Headers() As String
    Headers = m_strHeaders
End Property

Public Property Get MessageText() As String
    MessageText = m_strMessageText
End Property

Public Property Get Subject() As String
    Subject = lCDOMessage.Subject
End Property

Public Property Get OtherCount() As Integer
    OtherCount = lCDOMessage.Fields.Count
End Property

Public Property Get OtherFields(Index As Integer) As ADODB.Fields
    Set OtherFields = lCDOMessage.Fields
End Property

Public Property Get MessageTo() As String
Dim r As String
Dim X As Integer
    r = lCDOMessage.Fields("urn:schemas:mailheader:to").Value
    X = InStr(r, "<")
    If X <>  0  Then
        r = Mid(r, X +  1 , InStr(X, r, ">") - X -  1 )
        MessageTo = r
    End If
End Property

Public Property Get SendDate() As String
    SendDate = lCDOMessage.ReceivedTime
End Property

Public Property Get Size() As Long
    Size = Len(m_strMessageBody)
End Property
Вложения находятся в lCDOMessage.Attachments
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
27.01.2009, 13:29
    #35779858
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Спасибо, будем разбираться.
Сразу 2 вопроса.
1) WINSOCK==MSWINSCK.OCX=Microsoft Winsock Control 6.0 -?оно? с ним работал, есть такой
2) CDO для меня объект новый, где чего правильно взять, чтобы это точно было. Понимаю, что наверно google+microsoft+cdo, но там наверняка будет несколько вариантов...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
27.01.2009, 13:31
    #35779867
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Вообще у меня есть CDOsys.dll (for win 2000) Это оно?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
27.01.2009, 14:00
    #35779965
Antonariy
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Оно.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
27.01.2009, 18:09
    #35780878
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Впечатляет. Почти убедили.
Почитал вот это: http://msdn.microsoft.com/en-us/library/ms527302(EXCHG.10).aspx
"Написал" совсем простой код, без всяких классов, работает, нравится.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
Private Sub Command1_Click()
    Dim str As String
    Dim mmm As CDO.Message
    Set mmm = LoadMessageFromFile("MSG1.txt")
    MsgBox mmm.From
    MsgBox mmm.Subject
    For Each att In mmm.Attachments
        att.SaveToFile App.Path & "\" & att.FileName
    Next
End Sub
' Reference to Microsoft ActiveX Data Objects 2.5 Library
' Reference to Microsoft CDO for Windows 2000 Library
Function LoadMessageFromFile(Path As String) As Message
    Dim Stm As New Stream
    Stm.Open
    Stm.LoadFromFile Path
    Dim iMsg As New CDO.Message
    Dim iDsrc As IDataSource
    Set iDsrc = iMsg
    iDsrc.OpenObject Stm, "_Stream"
    Set LoadMessageFromFile = iMsg
End Function

Все-таки куча вопросов.
По CDO:
AntonariyCDO ставить надо, однако не вижу в этом проблемы. Оно, кстати, и отправлять умеет. ADODB не надо, оно и так везде есть.
На какой ActiveX Data Objects надо ссылаться, чтобы заведомо не было проблем на произвольном PC (у меня их куча...)?
CDO "ставить" Точно надо? Какой файл?
На XP есть 6.2.4.0 (RU для win2000), на 2003 6.5.6757.0 (без слов 2000).
Взаимозаменяемы ли? Как правильно поступить? Просто кинуть cdosys.dll в папку с программой наверно не правильно, хотя с ocx иногда поступаю именно так...

По WINSOCK:
Стоит ли разбираться?
Помню как-то писал терминальную программу для себя на одном pc, на соседнем не заработала чуть ли не с тем же ocx, плюнул, откомпилировал на том для кот. предназначалась.

Или найти-попытаться winsock-API? Но там и с ocx черт ногу сломит.
Вообще-то аккуратный exe-шник getmail.exe вполне справляется с задачей приема почты, я бы сказал на 5+ .М.б. не стоит морочиться?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
28.01.2009, 10:05
    #35781797
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Про CDO:
м.б. хорошая идея будет включить файл cdosys.dll из win2003(EN) в дистрибутив программы,
при установке мувнуть его в %system%, и вполнить команду regsvr32 /s %system%\cdosys.dll
С условием заменять на более новую версию.
Оно ругаться не будет если скажем язык не совпадает?
А если это не администратор устанавливает?
А надо ли удалять при инсталяции,вдруг оно там уже было?
regsvr32 /u /s %system%\cdosys.dll
То что файлы "взаимозаменяемы" я понял.
Те 2 установочных пакета, что можно скачать на Microsoft, это не то. это MAPI,а не CDO, причем инсталятор гнусный и ругается, да еще и Outlook Express потом ругается, типа "не по умолчанию стал я..."
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
28.01.2009, 10:55
    #35781972
Antonariy
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Насчет распространения CDO и прочих ocx — нужно использовать инсталлятор, он сам решит, что и когда заменять. Обычно (в MS — всегда) несовместимые версии библиотек называются по-разному, поэтому с заменой проблем быть не должно.
Устанавливать программы может только администратор или продвинутый пользователь(?). Потому что обычный пользователь не имеет доступа к системной части реестра.
Язык рояля не играет.
Всегда лучше использовать ADO последней версии, а вообще версии 2.5-2.8 совместимы и взаимозаменяемы. Более ранние — нет.
Весь необходимый код для работы с винсоком я предоставил, больше ничего с ним делать не нужно.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
28.01.2009, 15:33
    #35783079
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
С этим CDO уже запутался.
Сделал:
Взял cdosys.dll из win2003 (6.5.6757.0) запихнул его в дистрибутив
Инсталятору написал:
копировать в %systemdir%, заменять если новее, при удалении не деинсталировать
после распаковки выполнить команду regsvr32 /s cdosys.dll
Пробую на своем XP:(у меня стоит версия 6.2.4.0). Запускаю инсталятор, все хорошо, смотрю-осталась моя библиотека.

Переделываю инсталлятор, пишу:заменять безусловно, повторяю тест: и опять моя 6.2.4.0

Ладно, перегружаюсь в безопасный режим, удаляю 6.2.4.0 из sys32, перегружаюсь нормально, выжидаю, смотрю, да, убил, нету его в sys32. Запускаю свой инсталятор, ага , появилась. Смотрю версию:....6.2.4.0, какая и стояла. Т.е. устанавливали эту, а win из архивов достал старую.

Ладно, если win такой умный.А если cdosys.dll до установки в системе не было, то выделенное черным шрифтом корректно и приведет к рабочим результатам для произвольного pc (xp,2003)?

М.б. это теперь все же обязательный компонент и можно не париться?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.01.2009, 12:40
    #35785161
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Antonariy,
разбираюсь потихоньку с вашим кодом с pop3-winsock, вернее вдумчиво упрощаю и тестирую.
пока удалось скачать и сохранить "первое" письмо.

Споткнулся вот здесь.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
                Case POP3_TOP, POP3_RETR
'...
                        strText.ClearText
                        strText.Add Left(.BufferString, Len(.BufferString) -  1 )
                        strText.SaveText App.Path & "\mail.eml"
                        strText.ClearText
                        s = CheckMsg(m_oMessage)
                        If .RETR <>  0  Then .RETR =  0 
                        Winsock1.SendData s
                    End If
'....
                Case POP3_DELE
                    .CurrentMsg = .CurrentMsg +  1 
                    .BufferString = ""
                    If .CurrentMsg > .MessagesCount Then
                        .StateStat = True
                        .State = POP3_STAT
                        Winsock1.SendData "STAT" & vbCrLf

s = CheckMsg(m_oMessage) очевидно у вас проверяет что все хорошо и дает команду серверу для перехода к POP3_DELE : удалить письмо, затребовать следующее.
Не проясните?
Неохота просто рыться чтобы узнать как выглядит команда delete message
И в чем сотоит этот CheckMsg(письмо)?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.01.2009, 15:36
    #35785854
Antonariy
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
CheckMsg проверяет, считать ли письмо спамом.
Вот кусок CheckMsg, в котором происходит возврат команды, он должен ответить на все вопросы
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
        If m_oMessage.Deleted Then
            .State = POP3_DELE
            CheckMsg = "DELE " & .CurrentMsg & vbCrLf
        Else
skip:
            If .CurrentMsg = .MessagesCount Then
                .StateStat = True
                .State = POP3_STAT
                CheckMsg = "STAT" & vbCrLf
            Else
                .CurrentMsg = .CurrentMsg +  1 
                If FastMode Then
                    .State = POP3_TOP
                    CheckMsg = "TOP " & .CurrentMsg & " 0" & vbCrLf
                Else
                    .State = POP3_RETR
                    CheckMsg = "RETR " & .CurrentMsg & vbCrLf
                End If
            End If
        End If
        .BufferString = ""
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
02.02.2009, 11:06
    #35791016
Дмитрий77
Дмитрий77
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Antonariy,
Доразобрался с Winsock, упростил до предела ваш код, все работает,
потом чуть усложнил под себя на предмет анализа темы и разбора вложений и...
уж очень все мудрено все-таки..
У меня алгоритм простой:
1.принять всю почту что есть
2.вытащить из каждого письма mail-тему-вложение
3.либо передать все это факс-серверу на исполнение
4.либо отослать юзеру ответ, чего в письме неправильно
5.уничтожить все компоненты писем и успокоиться.

Причем логика такая, что в таймере, кот. это запускает структура
Код: plaintext
1.
2.
timer.enabled=false
п.п. 1 - 5 
timer.enabled=true
дабы не лез проверять по новой пока не закончил предыдущую процедуру.
У вас (и видимо по-другому нельзя) делать по-моему принципу бессмысленно, ибо все результаты возвращаются из событий winsock, и timer.enabled=true надо запихивать именно туда, а вот куда именно, и сколько раз, фиг знает, потому как если winsock выйдет по-ошибке, и где-то я что-то забуду предусмотреть, то таймер уснет навсегда...
Посему решил я все-таки оставить getmail.exe, ибо делает он тоже самое, и делает хорошо (просто принять и сохранить msg1.txt, msg2.txt), запускается одной командой, и по выходу ShellAndContinue могу спокойно запускать последовательную обработку через CDO.message, за что вам огромное спасибо, ну и не надо с winsock.ocx морочиться. Ну что касается winsock API, дело точно гиблое, ибо и с ocx черт ногу сломит, и если б не ваш код, вряд ли б когда-либо сумел сэтим разобраться..
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
02.02.2009, 12:48
    #35791337
Antonariy
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
На здоровье)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
29.10.2010, 21:03
    #36928729
Chishelberg
Chishelberg
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как прочесть сообщение e-mail (*.eml).
Вот читаю Дмитрий77 ваш код, походу перевожу в VB.net, и к сожелению не нашёл как подключить getmail. Если это возможно напишите. (устроит даже на VB6)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как прочесть сообщение e-mail (*.eml). / 21 сообщений из 21, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]