Нашел пример отправки писем через SMTP протокол на этом сайте, как оказалось, он не авторизируется на сервере что делает отправку писем в наше время невозможной. Так вот, как авторизироваться на smtp сервере или возможно существуют другие пути обхода авторизации? Жду ответа, зарание спасибо!
Вот исходник:
- Код: Выделить всё
Const SMTP = 25
Dim HOST As String
Dim SMTP_STATE As Byte
Private Sub Command1_Click()
Call SaveAppSetting
Dim I As Byte
Dim Temp As Byte 'для мелочей
Winsock.Close ' на всякий случай вдруг кто-то несколько раз пошлёт
For I = 1 To Len(RCPT.Text)
If Mid(RCPT.Text, I, 1) = "@" Then Temp = 1
Next I
If Not Temp = 1 Then
MsgBox "Введённый E-Mail Адрес получателя не верный.", vbCritical + vbApplicationModal + vbOKOnly, "Внимание!"
Exit Sub
End If
'определяем хост получателя, чтоб сообщение не ходило по куче серверов
RCPT = Trim$(RCPT)
FROM = Trim$(FROM)
SMTP_HOST = Trim$(SMTP_HOST)
For I = 1 To Len(RCPT)
If Mid(RCPT, I, 1) = "@" Then HOST = Right(RCPT, Len(RCPT) - I)
Next I
Winsock.RemotePort = SMTP
Winsock.RemoteHost = SMTP_HOST
Winsock.Connect
Text1 = ""
Text1 = "Connecting..."
State = MAIL_CONNECT
End Sub
Private Sub Form_Load()
Dim t As String
t = GetSetting("E-Mail", "Settings", "SMTP")
If Not t = "" Then SMTP_HOST.Text = t Else SMTP_HOST.Text = "smtp.mail.ru"
t = ""
t = GetSetting("E-Mail", "Settings", "User_Adress")
If t <> "" Then
FROM.Text = t
Else
FROM.Text = ""
End If
End Sub
Sub SaveAppSetting()
SaveSetting "E-Mail", "Settings", "SMTP", SMTP_HOST.Text
SaveSetting "E-Mail", "Settings", "User_Adress", FROM.Text
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call SaveAppSetting
End Sub
Private Sub Winsock_Connect()
Text1 = Text1 & "OK" & vbCrLf
End Sub
Private Sub Winsock_DataArrival(ByVal bytesTotal As Long)
Winsock.GetData Data, vbString
Text1 = Text1 & Data & vbCrLf
Text1.SelStart = Len(Text1.Text) - 1
If Left(Data, 3) = "220" Or Left(Data, 3) = "250" Or Left(Data, 3) = "354" Then
Select Case SMTP_STATE
Case 0
SMTP_STATE = 1
Data = "RSET" & vbCrLf
Winsock.SendData Data
Text1 = Text1 & Data
Case 1
SMTP_STATE = 2
Data = "HELO " & HOST & vbCrLf
Text1 = Text1 & Data
Winsock.SendData Data
Case 2
SMTP_STATE = 3
Data = "MAIL FROM: " & FROM & vbCrLf
Text1 = Text1 & Data
Winsock.SendData Data
Case 3
SMTP_STATE = 4
Data = "RCPT TO: " & RCPT & vbCrLf
Text1 = Text1 & Data
Winsock.SendData Data
Case 4
SMTP_STATE = 5
Data = "DATA" & vbCrLf
Text1 = Text1 & Data
Winsock.SendData Data
Case 5
SMTP_STATE = 6
Data = "Subject: " & Subject & vbCrLf & _
"From: " & FROM & vbCrLf & _
"To: " & RCPT & vbCrLf & _
"MIME-Version: 1.0" & vbCrLf & _
"Content-Type: text/plain; charset=" & Chr(34) & "windows-1251" & Chr(34) & vbCrLf
Text1 = Text1 & Data
Winsock.SendData Data
Data = MESSAGE & vbCrLf & "." & vbCrLf
Text1 = Text1 & Data
Winsock.SendData Data
Case 6
SMTP_STATE = 7
Data = "QUIT" & vbCrLf
Winsock.SendData Data
Winsock.Close
SMTP_STATE = 0
MsgBox "Сообщение было отправленно!", vbInformation + vbOKOnly, "E-Mail"
Case Else
Winsock.Close
SMTP_STATE = 0
MsgBox "Сообщение НЕ было отправленно!", vbCritical + vbOKOnly, "ERROR - E-Mail"
End Select
Text1.SelStart = Len(Text1) - 1
Else
Dim MSG
Select Case Left(Data, 3)
Case "421"
MSG = SMTP_HOST & " служба недоступна, соединение закрывается"
Case "450"
MSG = "Запрошенная команда почтовой транзакции не выполнена, так как почтовый ящик недоступен"
Case "451"
MSG = "Запрошенная команда не выполнена; произошла локальная ошибка при обработке сообщения"
Case "452"
MSG = "Запрошенная команда не выполнена; системе не хватило ресурсов"
Case "500"
MSG = "Синтаксическая ошибка в тексте команды; команда не опознана"
Case "501"
MSG = "Синтаксическая ошибка в аргументах или параметрах команды"
Case "502"
MSG = "Данная команда не реализована"
Case "503"
MSG = "Неверная последовательность команд"
Case "504"
MSG = "У данной команды не может быть аргументов"
Case "550"
MSG = "Запрошенная команда не выполнена, так как почтовый ящик недоступен"
Case "551"
MSG = "Данный адресат не является местным; попробуйте передать сообщение по маршруту <forward-path>"
Case "552"
MSG = "Запрошенная команда почтовой транзакции прервана; дисковое пространство, доступное системе, переполнилось"
Case "553"
MSG = "Запрошенная команда не выполнена; указано недопустимое имя почтового ящика"
Case "554"
MSG = "Сообщение не было отправленно"
End Select
If Not MSG = "" Then MsgBox MSG, vbCritical + vbOKOnly, "Ошибка!!!"
End If
End Sub
