Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Офф-топ

Страница: 1 |

 

  Вопрос: Ещё один ~Почтовый клиент~ Добавлено: 06.08.11 05:49  

Автор вопроса:  Smith | ICQ: adamis@list.ru 
Хотел спросить, кто, что думает об этом безобразии.

Ехе’шник никто запускать не станет, сорцы на VB6 тоже не интересны, а так, обсудить ...

Прога одним файлом, портабельная, весит 222Кб.
Прием писем POP3 с поддержкой Proxy HTTP 1.1
Отправка службой SMTP (Microsoft cdosys.dll)

По-моему симпатично получилось. Альфа версия :)
Функция "Ответить" не дописана.
Нет оповещения о новом письме.

Определялки новое/неновое нет потому, что не решил как работать с письмами.

Сейчас прочитанное сохраняется локально в
ПапкаПроги\Входящие\ящик@сервак.ру\*.eml
При удалении два вопроса, удалять файл и удалять на серваке.

Думаю это неправильно.
Может лучше качнуть, чтоб показать и сразу удалить?
И так пас не шифрован, прикрыт от дурака, а тут ещё и письма читай нехочу :)

безобразие …

Ответить

  Ответы Всего ответов: 5  

Номер ответа: 1
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | | #1 Добавлено: 06.08.11 06:36
Хм, непонял, а где линк делся?

PNG 1920x1080(1.8Mb) http://img-fotki.yandex.ru/get/5012/39402780.4/0_6cbe3_ef829cc4_orig

Ответить

Номер ответа: 2
Автор ответа:
 AWP



ICQ: 345685652 

Вопросов: 96
Ответов: 1212
  Web-сайт: xawp.narod.ru
 Профиль | | #2 		Добавлено: 06.08.11 23:31
Сорсов не будет?)

Ответить

Номер ответа: 3
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | | #3 Добавлено: 06.08.11 23:47
А нафига они? Будешь читать чтоли? :) неверю

Если что-то конкретно интересует говори, покажу с удовольствием, приму замечания.

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

Интересно мнение, советы, поэтому и тему создал с вопросами.

Ответить

Номер ответа: 4
Автор ответа:
 AWP



ICQ: 345685652 

Вопросов: 96
Ответов: 1212
  Web-сайт: xawp.narod.ru
 Профиль | | #4 		Добавлено: 07.08.11 01:00
Ну я люблю читать.)
интересует:
Прием писем POP3 с поддержкой Proxy HTTP 1.1. - как реализована.
Отправка службой SMTP (Microsoft cdosys.dll) - как её едят.
и... как ты письма с разметкой отображаешь? через IE?

По проге:
Что-то серьезное/функциональное хочешь сделать? Тогда нужно дать пользователю выбор удалять на серваке или нет.
Если что-то оч. легкое, то можно просто помечать как прочитанное.

Ответить

Номер ответа: 5
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | | #5 Добавлено: 07.08.11 01:56
Прием писем POP3 с поддержкой Proxy HTTP 1.1. - как реализована.
Винсокетом, таймером, костылями и чьей-то матерью :)

  1. Option Explicit
  2.  
  3. 'API и константы взаимодействия
  4. Private Const WM_SETTEXT = &HC
  5. Private Const LB_ADDSTRING = &H180
  6. Private Const LB_SETITEMDATA = &H19A
  7. Private Const WM_USER = &H400
  8. Private Const PBM_SETPOS = (WM_USER + 2)
  9.  
  10. 'Рабочие константы
  11. Private Const CPT = "Pochta "
  12. Private Const CnP = "> Соединение с почтой..."
  13. Private Const OK_ = "+OK"  'положительный ответ сервера
  14. Private Const STT = "STAT" & vbCrLf 'кол-во писем
  15. Private Const PSS = "PASS "
  16. Private Const TP_ = "TOP"  'фрагмент письма
  17. Private Const LIS = "LIST" 'размер письма
  18.  
  19. 'Начальные переменные
  20. Private Host As String      'pop.mail.ru
  21. Private Conn As String      '"CONNECT " & Host & ":110 HTTP/1.1" & vbCrLf & vbCrLf
  22. Private Mail As String      '"USER " & Arr(1) & vbCrLf
  23. Private Pass As String      'пароль к ящику
  24. Private MaxL As Integer     'кол-во запрашиваемых писем
  25. Private Wind As Long        'hWnd главного окна программы
  26. Private Lst1 As Long        'hWnd ListBox'а приемника
  27. Private Prog As Long        'hWnd ProgressBar'а
  28. Private Prxy As String      'Proxy сервер 172.16.1.194
  29. Private Port As String      'порт Proxy сервера:8888
  30.  
  31. 'Статус ящика
  32. Private Index As Integer    'индекс письма на POP3 сервере
  33. Private Letters  As Integer 'количество писем
  34.  
  35. Private HTTPErr  As Boolean 'флаг ошибки сервера
  36. Private Flag As Boolean     'флаг получения фрагмента письма
  37.  
  38. Private Log      As String  'лог последнего сеанса
  39. Private Stage    As Integer 'текущий этап
  40.                             '0 - коннект Proxy
  41.                             '1 - коннект POP3
  42.                             '2 - логин
  43.                             '3 - пароль
  44.                             '4 - запрос STAT
  45.                             '5 и далее запросы LIST и TOP
  46. 'Рабочие переменные
  47. Private sDat As String      'буферная переменная сокета
  48. Private tLet As String      'путь\имя временного EML
  49.  
  50.  
  51. Private Sub Form_Initialize()
  52.   InitCommonControlsXP
  53. End Sub
  54.  
  55. Private Sub Form_Load()
  56.   Dim Arr() As String
  57.  
  58.   Arr = Split(Command, "|")
  59.   Host = Arr(0)
  60.   Mail = "USER " & Arr(1) & vbCrLf
  61.   Pass = Arr(2)
  62.   MaxL = CInt(Arr(3))
  63.   Wind = CLng(Arr(4))
  64.   Lst1 = CLng(Arr(5))
  65.   Prog = CLng(Arr(6))
  66.   Prxy = Arr(7)
  67.   Port = Arr(8)
  68. 'MsgBox Replace$(Command, "|", vbCr) 'контроль коммандной строки
  69.   Conn = "CONNECT " & Host & ":110 HTTP/1.1" & vbCrLf & vbCrLf
  70.   tLet = PathWrk & "Temp.eml"
  71.  
  72.   If Len(Prxy) > 0 Then
  73.     Stage = 0
  74.   Else
  75.     Stage = 1
  76.   End If
  77.   Tim.Enabled = True
  78. End Sub
  79.  
  80. Private Sub Form_Unload(Cancel As Integer)
  81.   SendMessage Prog, PBM_SETPOS, 100, 0  'признак окончания работы
  82.   SendMessage Wind, WM_SETTEXT, 0, ByVal CPT
  83.   End
  84. End Sub
  85.  
  86. Private Sub Tim_Timer()
  87.  
  88.   Tim.Enabled = False
  89.  
  90.   With Sck
  91.  
  92.     Select Case Stage
  93.  
  94.       Case 0 'соединение с Proxy
  95.         SendMessage Wind, WM_SETTEXT, 0, ByVal CPT & "> Соединение с прокси..."
  96.         Log = Stage & "> Proxy " & Prxy & ":" & Port & vbCrLf
  97.         .Close
  98.         .Connect Prxy, Port
  99.  
  100.       Case 1 'соединение с POP3
  101.         SendMessage Wind, WM_SETTEXT, 0, ByVal CPT & CnP
  102.         Log = Log & Stage & "> Mail " & Host & ":110" & vbCrLf
  103.         .Close
  104.         .Connect Host, 110
  105.  
  106.       Case 2 'передача логина
  107.         SendMessage Wind, WM_SETTEXT, 0, ByVal CPT & "> Передача логина..."
  108.         Log = Log & Stage & "> " & Mail         '"USER " & Arr(0) & vbCrLf
  109.         Sck.SendData Mail
  110.  
  111.       Case 3 'передача пароля
  112.         SendMessage Wind, WM_SETTEXT, 0, ByVal CPT & "> Передача пароля..."
  113.         Log = Log & Stage & "> " & PSS & vbCrLf '"PASS "
  114.         Sck.SendData PSS & Pass & vbCrLf
  115.  
  116.       Case 4 'передача запроса STAT
  117.         SendMessage Wind, WM_SETTEXT, 0, ByVal CPT & "> Запрос писем..."
  118.         Log = Log & Stage & "> " & STT          '"STAT" & vbCrLf
  119.         Sck.SendData STT
  120.  
  121.       Case Else 'запрос данных
  122.         If Flag = False Then 'LIST сначала узнаем размер письма
  123.           If Stage - 4 > MaxL Or _
  124.              Index < 1 Or _
  125.              Index > Letters Then 'если загрузка закончена
  126.             Log = Log & Stage & ". Last" & Str$(Stage - 5) & " of" & Str$(Letters) & " letters" & vbCrLf
  127.             Sck_Close
  128.           Else
  129.             Log = Log & Stage & "> " & LIS & Str$(Index) & vbCrLf
  130.             Sck.SendData LIS & Str$(Index) & vbCrLf
  131.           End If
  132.  
  133.         Else 'TOP а потом запрашиваем фрагмента письма
  134.           Log = Log & Stage & "> " & TP_ & Str$(Index) & " 40" & vbCrLf ' "TOP"
  135.           Sck.SendData TP_ & Str$(Index) & " 40" & vbCrLf
  136.         End If
  137.  
  138.     End Select
  139.  
  140.   End With
  141.  
  142. End Sub
  143.  
  144. Private Sub Sck_Connect()
  145.   sDat = vbNullString
  146.  
  147.   If Stage = 0 Then 'Proxy сервер соединен
  148.     SendMessage Wind, WM_SETTEXT, 0, ByVal CPT & CnP
  149.     Log = Log & Stage & "> " & Conn
  150.     Sck.SendData Conn
  151.   End If
  152.  
  153. End Sub
  154.  
  155. Private Sub Sck_DataArrival(ByVal bytesTotal As Long)
  156. Static Size As Double      'размер письма в байтах
  157.   Dim strData As String
  158.   Dim sArry() As String
  159.  
  160.   Sck.GetData strData, vbString, bytesTotal
  161.   sDat = sDat & strData
  162.  
  163.   Select Case Stage
  164.  
  165.     Case 0 'Proxy сервер откликнулся
  166.       Log = Log & Stage & "< " & sDat
  167.       If InStr(sDat, " 200 ") > 0 Then
  168.         sDat = vbNullString
  169.         Stage = 1
  170.       Else: HTTPErr = True 'если это не положительный ответ 200
  171.       End If
  172.  
  173.     Case 1 'POP сервер откликнулся
  174.       Log = Log & Stage & "< " & sDat
  175.       If InStr(sDat, OK_) > 0 Then
  176.         sDat = vbNullString
  177.         Stage = 2
  178.         NewIndex
  179.         Tim.Enabled = True
  180.       Else: HTTPErr = True 'если это не положительный ответ +OK
  181.       End If
  182.  
  183.     Case 2 'логин принят
  184.       If InStr(sDat, OK_) > 0 Then
  185.         Log = Log & Stage & "< " & sDat
  186.         sDat = vbNullString
  187.         Stage = 3 'отправить пароль
  188.         NewIndex
  189.         Tim.Enabled = True
  190.       End If
  191.  
  192.     Case 3 'пароль принят
  193.       Log = Log & Stage & "< " & sDat
  194.       If InStr(sDat, OK_) = 1 Then
  195.         sDat = vbNullString
  196.         Stage = 4 'отправить запрос STAT
  197.         NewIndex
  198.         Tim.Enabled = True
  199.       Else: HTTPErr = True 'если это не положительный ответ +OK
  200.       End If
  201.  
  202.     Case 4 'кол-во писем принято
  203.       If InStr(sDat, OK_) > 0 Then
  204.         sArry = Split(sDat, " ")
  205.         Letters = CInt(Val(sArry(1)))
  206.         Log = Log & Stage & "< " & sDat & vbCrLf
  207.         sDat = vbNullString
  208.         Stage = 5
  209.         NewIndex
  210.         Tim.Enabled = True 'отправить запрос на первое письмо
  211.       End If
  212.  
  213.     Case Else
  214.       If Flag = False Then 'LIST получили размер письма
  215.         If InStr(sDat, OK_) > 0 Then
  216.           sArry = Split(sDat, " ")
  217.           Size = Val(sArry(2))
  218.           Log = Log & Stage & "< " & sDat
  219.           Flag = True
  220.           sDat = vbNullString
  221.           Tim.Enabled = True
  222.         End If
  223.  
  224.       Else 'TOP получили фрагмент письма
  225.         If InStr(sDat, vbCrLf & "." & vbCrLf) > 0 Then
  226.           Log = Log & Stage & "< Received" & vbCrLf & vbCrLf
  227.           EML sDat, Size
  228.           Flag = False
  229.           sDat = vbNullString
  230.           Stage = Stage + 1
  231.           NewIndex
  232.           Tim.Enabled = True
  233.         End If
  234.       End If
  235.   End Select
  236. End Sub
  237.  
  238. Private Sub Sck_Error(ByVal Number As Integer, _
  239.                          Description As String, _
  240.                          ByVal Scode As Long, _
  241.                          ByVal Source As String, _
  242.                          ByVal HelpFile As String, _
  243.                          ByVal HelpContext As Long, _
  244.                          CancelDisplay As Boolean)
  245.  
  246.   Log = Log & Stage & ". " & Description & vbCrLf
  247.   HTTPErr = True
  248.   Err.Clear
  249.   Sck_Close
  250. End Sub
  251.  
  252. Private Sub Sck_Close()
  253.   Dim Ind As Long       'индекс письма на POP3
  254.   Dim Msg As String     'строка списка писем
  255.   Dim Tmp As Integer    'пункт временного списка
  256.  
  257. 'On Error Resume Next
  258.   Log = Log & Stage & ". Connection closed"
  259.   Sck.Close
  260. 'Err.Clear
  261.   Open PathWrk & "Проверка ящика.txt" For Output As 1
  262.     Print #1, Log;
  263.   Close
  264. 'On Error GoTo 0

дальше там ещё куча всего.
Получаю то я 40 строк сверху каждого письма, это надо в письмо заглянуть, чтоб в список добавить (когда, от кого, тема, размер, вложения).

Отправка службой SMTP (Microsoft cdosys.dll) - как её едят.

  1. Option Explicit
  2.  
  3. 'Отправка письма
  4. Public Sub SendLetter()
  5.   Dim Msg As New CDO.Message
  6.   Dim Max As Integer
  7.   Dim Tmp As Integer
  8.   Dim Text As String
  9.   Dim Arr() As String
  10.  
  11. On Error Resume Next
  12.   Open PathWrk & "\Текст.txt" For Input Access Read As 1
  13.     Text = Input(LOF(1), #1)
  14.   Close
  15.   Text = Text & vbCrLf & vbCrLf & vbCrLf & String$(30, "_") & vbCrLf & "Почтовый клиент Pochta"
  16.   Arr = Split(Command, "|")
  17.  
  18. 'Отправить сообщение с помощью локальной службы SMTP
  19. '  Set Msg = CreateObject("CDO.Message")
  20.  
  21.   With Msg.Configuration.Fields
  22. ' Секция настроек SMTP сервера для отправки почты.
  23.     .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  24. ' Имя или IP адрес SMTP Server
  25.     .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Arr(0) 'smtp.mail.ru
  26. ' Порт SMTP Server port (обычно 25, но может быть и другим)
  27.     .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
  28. ' Тип авторизации cdoAnonymous=0, Base64 encoded cdoBasic=1, cdoNTLM=2
  29.     .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
  30. ' Авторизация на SMTP server
  31.     .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Arr(1) '"Ящик@list.ru"
  32. ' Пароль SMTP server
  33.     .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Arr(2) 'пароль к ящику
  34. ' Использование SSL для соединения (False или True)
  35.     '.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
  36. ' Время ожидания соединения с почтовым сервером
  37.     .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
  38. ' Руссификация
  39.     .Item("http://schemas.microsoft.com/cdo/configuration/languagecode") = 1049
  40.     '.Item("http://schemas.microsoft.com/cdo/configuration/usemessageresponsetext") = True
  41. ' Сохранить настройки CDO для отправки сообщения
  42.     .Update
  43.   End With
  44.  
  45.   Max = UBound(Arr)
  46.   With Msg
  47.     .AddAttachment PathWrk & "\Текст.txt"
  48.     If Max > 4 Then
  49. ' Добавляем файл - вложение для отправки отчета по EMail
  50.       For Tmp = 5 To Max
  51.         .AddAttachment Arr(Tmp)
  52.       Next
  53.     End If
  54. ' Тема сообщения и адрес отправителя
  55.     .From = Arr(1)
  56.     .Subject = Arr(3)
  57. ' Получатели письма указываются через " ; "
  58.     .To = Arr(4)
  59. ' Содержимое тела письма.
  60.     .TextBody = Text
  61.  
  62. ' Отправить созданное почтовое сообщение с вложением по указанному адресу
  63.     .Send
  64.   End With
  65.  
  66.   If Err.LastDllError <> 0 Or Err.Number <> 0 Then MsgBox Err.Number & Str$(Err.LastDllError) & vbCrLf & vbCrLf & Err.Description, vbCritical, "Ошибка отправки на: " & Arr(1)
  67. Err.Clear
  68.  
  69.   End
  70. End Sub
тут моего минимум, выдрал где-то в инэте.

и... как ты письма с разметкой отображаешь? через IE?
конечно Microsoft Internet Controls, тут тоже не без гемора, приходится блокировать контекстное меню, парсить EML, переписывать PNG на случай наличия тэгов в файлах, иначе IE их не тянет.

До серьезного/функционального как пешком до луны.
Думаю что-то изи ту юз, легковесное, шустрое и чтобы трафик экономило.
Но тем не менее яркое, чтоб запоминалось, я там даже PNG фон основной формы сделал, если приглядеться, видно.

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам