ReSQL.ru
     
powered by simpleCommunicator - 2.0.53     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Получение непрочитанных сообщений с помощью IMAP
6 сообщений из 6, страница 1 из 1
Получение непрочитанных сообщений с помощью IMAP
    #37729578
ilnurav
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ilnurav
Участник
Суть задачи: получить непрочитанные сообщения с помощью протокола IMAP (в POP3, к сожалению, нет возможности работать с флагами).

Взаимодействие с различными почтовиками типа Outlook не рассматривается.

Пишем свой "почтовик", собирающий непрочитанные сообщения. В работе использую Winsock.

На данный момент программа реализована следующим образом: с помощью IMAP в переменную записываем количество новых (непрочитанных) сообщений, затем с помощью POP3 получаем эти сообщения с сервера. У каждого сообщения есть свой последовательный номер.

Еще вопрос: как вообще получает с сервера сообщения Outlook по IMAP ведь там нет команды передачи в отличие от POP3?

зарание благодарю.
...
Рейтинг: 0 / 0
29.03.2012, 14:55
| Ответить | Цитировать | Написать  
Получение непрочитанных сообщений с помощью IMAP
    #37729620
ilnurav
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ilnurav
Участник
получение сообщений с аттачментами
...
Рейтинг: 0 / 0
29.03.2012, 15:13
| Ответить | Цитировать | Написать  
Получение непрочитанных сообщений с помощью IMAP
    #37729710
Фотография Antonariy
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Antonariy
Участник
Практически никакой разницы с POP3. Я однажды почти доделал, тестировал на mail.ru и наткнулся на странность, когда команда предназначенная письму с номером х, так же применялась и к письму с номером х+1. Я спрашивал у mail.ru, баг это или фича, но никто не соизволил ответить.

 
Код: vbnet
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.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
Option Explicit

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 Enum CheckState
    csNone = 0
    csRed = 1
    csGreen = 2
End Enum

Public m_States() As WSState
Public FastMode As Boolean

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

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
                    frmReport.ctlProgress1.Connect Winsock1.Index
                    .MessagesCount = 0
                    .State = POP3_USER
                    Winsock1.SendData "USER " & .Login & vbCrLf
                Case POP3_USER
                    .State = POP3_PASS
                    Winsock1.SendData "PASS " & .Pass & vbCrLf
                Case POP3_PASS
                    frmReport.ctlProgress1.Logon Winsock1.Index
                    .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
                            frmReport.ctlProgress1.MsgCount(Winsock1.Index) = .MessagesCount
                            .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
                            frmReport.ctlProgress1.MsgCount(Winsock1.Index) = 1
                            frmReport.ctlProgress1.NoMsgs Winsock1.Index
                            .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
                            frmReport.ctlProgress1.AddMsg Winsock1.Index
                        Else
                            .RETR = 0
                        End If
                        'Debug.Print Winsock1.Index, s
                        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
            frmReport.ctlProgress1.ErrDesc(Winsock1.Index) = LoadEnumString(, "ProtoError") & strData
            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

Public Sub DataArrivalIMAP(Winsock1 As Winsock, ByVal bytesTotal As Long)
Dim m_oMessage As CMessage
Dim strData As String
Dim strData1 As String
Dim IP As String
Dim r As Boolean
Dim s() As String
Dim X As Integer
Dim lSize As Long
    Winsock1.GetData strData1
    s = Split(strData1, vbCrLf)
    strData = s(UBound(s) - 1)
    With m_States(Winsock1.Index)
        If .State = POP3_TOP Then
            Debug.Print strData1 'strData & vbCrLf
        Else
            Debug.Print strData1
        End If
        If Mid$(strData, InStr(strData, " ") + 1, 2) = "OK" Or Mid$(s(0), InStr(s(0), " ") + 1, 2) = "OK" Then
            .IMAPStep = .IMAPStep + 1
            Select Case .State
                Case POP3_Connect
                    .MessagesCount = 0
                    .IMAPStep = 1
                    .State = POP3_USER
                    Winsock1.SendData "A" & .IMAPStep & " LOGIN " & .Login & " " & .Pass & vbCrLf
                    'Debug.Print "A" & .IMAPStep & " LOGIN " & rsAccounts!login & " " & rsAccounts!Pass & vbCrLf
                Case POP3_USER
                    .State = POP3_STAT
                    Winsock1.SendData "A" & .IMAPStep & " SELECT INBOX" & vbCrLf
                    'Debug.Print "SELECT INBOX"
                Case POP3_STAT
                    .State = POP3_LIST
                    Debug.Print ">>>> "; "A" & .IMAPStep & " SEARCH UNSEEN"
                    Winsock1.SendData "A" & .IMAPStep & " SEARCH UNSEEN" & vbCrLf
                    'Debug.Print "SEARCH ALL"
                Case POP3_LIST
                    .IMAPMsgs = Split(Mid$(s(0), InStr(s(0), "SEARCH") + 7), " ")
                    .MessagesCount = UBound(.IMAPMsgs) + 1
                    If .MessagesCount > 0 Then
                        .State = POP3_TOP
                        .CurrentMsg = 0 '.MessagesCount
                        .MailCount = .MessagesCount
                        Debug.Print ">>>> "; "A" & .IMAPStep & " FETCH " & .IMAPMsgs(.CurrentMsg) & " (FLAGS RFC822.SIZE RFC822.HEADER)"
                        Winsock1.SendData "A" & .IMAPStep & " FETCH " & .IMAPMsgs(.CurrentMsg) & " body[header]" & vbCrLf ' " (FLAGS RFC822.SIZE RFC822.HEADER)" & vbCrLf
                    Else
                        .State = POP3_QUIT
                        Winsock1.SendData "A" & .IMAPStep & " LOGOUT" & vbCrLf
                    End If
                Case POP3_TOP
                        For X = 1 To UBound(s) - 4
                            IP = IP & s(X) & vbCrLf
                        Next
                        IP = IP & vbCrLf
                        Set m_oMessage = New CMessage
                        m_oMessage.CreateFromText IP
                        'Debug.Print m_oMessage.Subject
                        Winsock1.SendData CheckMsg(m_oMessage, Winsock1.Index)
                Case POP3_QUIT
                    Winsock1.Close
                    .State = POP3_VeryQUIT
                Case POP3_DELE
                    .CurrentMsg = .CurrentMsg + 1
                    If .CurrentMsg = .MessagesCount Then
                        '.State = IMAP_EXPUNGE
                        'Winsock1.SendData "A" & .IMAPStep & " EXPUNGE" & vbCrLf
                        .State = POP3_QUIT
                        Winsock1.SendData "A" & .IMAPStep & " LOGOUT" & vbCrLf
                    Else
                        .State = POP3_TOP
                        Winsock1.SendData "A" & .IMAPStep & " FETCH " & .IMAPMsgs(.CurrentMsg) & " (flags RFC822.SIZE RFC822.HEADER)" & vbCrLf
                    End If
                Case IMAP_EXPUNGE
                    .State = POP3_QUIT
                    Winsock1.SendData "A" & .IMAPStep & " LOGOUT" & vbCrLf
                Case IMAP_COPY
                    .CurrentMsg = .CurrentMsg + 1
                    If .CurrentMsg = .MessagesCount Then
                        .State = POP3_VeryQUIT 'POP3_QUIT
                        Winsock1.SendData "A" & .IMAPStep & " LOGOUT" & vbCrLf 'EXPUNGE
                    Else
                        .State = POP3_TOP
                        Debug.Print ">>>> "; "A" & .IMAPStep & " FETCH " & .IMAPMsgs(.CurrentMsg) & " (FLAGS RFC822.SIZE RFC822.HEADER)"
                        Winsock1.SendData "A" & .IMAPStep & " FETCH " & .IMAPMsgs(.CurrentMsg) & " body[header]" & vbCrLf '& " (flags RFC822.SIZE RFC822.HEADER)" & vbCrLf
                    End If
                    'Winsock1.SendData "A" & .IMAPStep & " SEARCH UNSEEN" & vbCrLf
                '    .State = POP3_DELE
                '    Winsock1.SendData "A" & .IMAPStep & " STORE " & .IMAPMsgs(.CurrentMsg) & " +FLAGS \Deleted \flagged" & vbCrLf
            End Select
        ElseIf InStr(strData, " NO ") = 0 And Mid$(s(0), 1, 1) = "*" Then
            .BufferString = .BufferString & strData
        Else
            frmReport.ctlProgress1.ErrDesc(Winsock1.Index) = LoadEnumString(msg_ErrorDD) & strData
            Winsock1.SendData "A" & .IMAPStep & " EXPUNGE" & vbCrLf
            .State = POP3_QUIT
            .Error = True
        End If
    End With
End Sub

Private Function CheckMsg(m_oMessage As CMessage, WSIndex As Integer) As String
Dim ID As Long
Dim rs As ADODB.Recordset
Dim csResult As CheckState
    On Error GoTo errh
    With m_States(WSIndex)
        If m_oMessage.Status > rNotChecked And StaDelete(m_oMessage.Status) Then
            If StaSave(m_oMessage.Status) Then
                If .State = POP3_TOP Then
                    .State = POP3_RETR
                    .RETR = 1
                    CheckMsg = "RETR " & .CurrentMsg & vbCrLf
                    Exit Function
                End If
            End If
        End If
        If m_oMessage.Deleted Then
            If .Protocol = pSMTP Then
                .State = POP3_DELE
                CheckMsg = "DELE " & .CurrentMsg & vbCrLf
            Else
                '.State = IMAP_COPY
                .State = POP3_DELE
                CheckMsg = "A" & .IMAPStep & " COPY " & .IMAPMsgs(.CurrentMsg) & " Trash" & vbCrLf
                'Winsock1.SendData "A" & .IMAPStep & " STORE " & .IMAPMsgs(.CurrentMsg) & " +FLAGS \Deleted \flagged" & vbCrLf
                'CheckMsg =  "A" & .IMAPStep & " STORE " & .IMAPMsgs(.CurrentMsg) & " +FLAGS \Deleted \flagged" & vbCrLf
            End If
        Else
            If .Protocol = pSMTP Then
                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
            Else
                'CheckMsg = "A" & .IMAPStep & " FETCH " & .IMAPMsgs(.CurrentMsg) & " (flags RFC822.SIZE RFC822.HEADER)" & vbCrLf
                Debug.Print ">>>> A" & .IMAPStep & " STORE " & .IMAPMsgs(.CurrentMsg) & " -FLAGS (\Seen)"
                CheckMsg = "A" & .IMAPStep & " STORE " & .IMAPMsgs(.CurrentMsg) & " -FLAGS (\Seen)" & vbCrLf
                .State = IMAP_COPY
            End If
        End If
        .BufferString = ""
    End With
    Exit Function
errh:
    Exit Function
    Resume
End Function


...
Рейтинг: 0 / 0
29.03.2012, 15:42
| Ответить | Цитировать | Написать  
Получение непрочитанных сообщений с помощью IMAP
    #37730951
ilnurav
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ilnurav
Участник
Antonariy, спасибо.
...
Рейтинг: 0 / 0
30.03.2012, 10:48
| Ответить | Цитировать | Написать  
Получение непрочитанных сообщений с помощью IMAP
    #37734155
ilnurav
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ilnurav
Участник
Решил свою задачу так:

Winsock1.Connect "ХХХ.ХХХ.ХХХ.ХХХ", 143
Do Until received: DoEvents: Loop
If sckError Then MsgBox "An error occured trying to connect to server": Exit Sub
sendMsg "AUTH LOGIN username password"

If sckError Then MsgBox "Error": Exit Sub
sendMsg "А142 SELECT INBOX"
If sckError Then MsgBox "Error": Exit Sub

sendMsg "Д042 STATUS INBOX (MESSAGES UNSEEN)"
x_all = InStr(Message$, "(MESSAGES "): b_all = InStrRev(Message$, " UNSEEN")
Messages_server = Val(Mid$(Message$, x_all + 10, b_all - (x_all + 10)))

x_new = InStr(Message$, "UNSEEN "): b_new = InStrRev(Message$, ")")

Messages_new = Val(Mid$(Message$, x_new + 7, b_new - (x_new + 7)))

If Len(Dir("C:\WINDOWS\Temp\Delo", vbDirectory)) = 0 Then MkDir "C:\WINDOWS\Temp\Delo"
If Len(Dir("C:\WINDOWS\Temp\Delo\EML", vbDirectory)) = 0 Then MkDir "C:\WINDOWS\Temp\Delo\EML"


If Messages_new > 0 Then

For a = (Messages_server - Messages_new) + 1 To Messages_server
Winsock1.Tag = "FETCH"
Open "C:\WINDOWS\Temp\Delo\EML\" & a & "-eMail.eml" For Binary Access Write As #1

sendMsg "А654 FETCH " & a & " BODY[]"

Next

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Message$

Select Case Winsock1.Tag
Case "FETCH"
Put #1, , Message$
If InStr(Message$, "А654 OK Fetch completed.") Then
Close 1
Winsock1.Tag = ""
received = True
End If
Case Else
sckError = (InStr(Message$, "BAD") <> 0)
received = True
End Select
End Sub


Sub sendMsg(m$)
DoEvents
Winsock1.SendData m$ + vbCrLf
received = False
Do Until received
DoEvents
Loop
End Sub


Private Sub Form_Load()
Winsock1.Tag = ""
Winsock1.Close
End Sub

Private Sub Winsock1_Close()
Winsock1.Close
End Sub
...
Рейтинг: 0 / 0
02.04.2012, 09:45
| Ответить | Цитировать | Написать  
Получение непрочитанных сообщений с помощью IMAP
    #37734162
ilnurav
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
ilnurav
Участник
If Messages_new > 0 Then

For a = (Messages_server - Messages_new) + 1 To Messages_server
Winsock1.Tag = "FETCH"
Open "C:\WINDOWS\Temp\Delo\EML\" & a & "-eMail.eml" For Binary Access Write As #1

sendMsg "А654 FETCH " & a & " BODY[]"

Next

End If
...
Рейтинг: 0 / 0
02.04.2012, 09:47
| Ответить | Цитировать | Написать  
6 сообщений из 6, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Получение непрочитанных сообщений с помощью IMAP
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&msg=37730951&tid=2157931]:
 0ms
get settings:
 10ms
get forum list:
 13ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 36ms
get topic data:
 11ms
get forum data:
 2ms
get page messages:
 50ms
get tp. blocked users:
 1ms
others: 330ms
total:  461ms
созд. / загр.: 461ms
x
x
Закрыть


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