Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Winsock+send mail+authorization / 2 сообщений из 2, страница 1 из 1
23.05.2006, 09:51
    #33744244
anjekos
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Winsock+send mail+authorization
Помогите пожалуйста с SMTP авторизацией.

Private Sub btSend_Click()
'
Dim i As Integer
'
'prepare attachments
'
m_strEncodedFiles = ""
For i = 0 To lstAttachments.ListCount - 1
lstAttachments.ListIndex = i
m_strEncodedFiles = m_strEncodedFiles & _
UUEncodeFile(lstAttachments.Text) & vbCrLf
Next i
'
Winsock1.Connect Trim$(txtHost), 25
m_State = MAIL_CONNECT
'

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim strServerResponse As String
Dim strResponseCode As String
Dim strDataToSend As String
'
'Retrive data from winsock buffer
'
Winsock1.GetData strServerResponse
'
Debug.Print strServerResponse
'
'Get server response code (first three symbols)
'
strResponseCode = Left(strServerResponse, 3)
'
'Only these three codes tell us that previous
'command accepted successfully and we can go on
'
If strResponseCode = "250" Or _
strResponseCode = "220" Or _
strResponseCode = "354" Then

Select Case m_State
Case MAIL_CONNECT
'Change current state of the session
m_State = MAIL_HELO
'
'Remove blank spaces
strDataToSend = Trim$(txtSender)
'
'Retrieve mailbox name from e-mail address
strDataToSend = Left$(strDataToSend, _
InStr(1, strDataToSend, "@") - 1)
'Send HELO command to the server
Winsock1.SendData "HELO " & strDataToSend & vbCrLf
'
Debug.Print "HELO " & strDataToSend
'
Case MAIL_HELO
'
'Change current state of the session
m_State = MAIL_FROM
'
'Send MAIL FROM command to the server
Winsock1.SendData "MAIL FROM:" & Trim$(txtSender) & vbCrLf
'
Debug.Print "MAIL FROM:" & Trim$(txtSender)
'
Case MAIL_FROM
'
'Change current state of the session
m_State = MAIL_RCPTTO
'
'Send RCPT TO command to the server
Winsock1.SendData "RCPT TO:" & Trim$(txtRecipient) & vbCrLf
'
Debug.Print "RCPT TO:" & Trim$(txtRecipient)
'
Case MAIL_RCPTTO
'
'Change current state of the session
m_State = MAIL_DATA
'
'Send DATA command to the server
Winsock1.SendData "DATA" & vbCrLf
'
Debug.Print "DATA"
'
Case MAIL_DATA
'
'Change current state of the session
m_State = MAIL_DOT
'
'So now we are sending a message body
'Each line of text must be completed with
'linefeed symbol (Chr$(10) or vbLf) not with vbCrLf
'
'Send Subject line
Winsock1.SendData "Subject:" & txtSubject & vbLf & vbCrLf
'
Debug.Print "Subject:" & txtSubject
'
Dim varLines As Variant
Dim varLine As Variant
Dim strMessage As String
'
'Add atacchments
strMessage = txtMessage & vbCrLf & vbCrLf & m_strEncodedFiles
'clear memory
m_strEncodedFiles = ""
'Parse message to get lines (for VB6 only)
varLines = Split(strMessage, vbCrLf)
'clear memory
strMessage = ""
'
'Send each line of the message
For Each varLine In varLines
Winsock1.SendData CStr(varLine) & vbLf
'
Debug.Print CStr(varLine)
Next
'
'Send a dot symbol to inform server
'that sending of message comleted
Winsock1.SendData "." & vbCrLf
'
Debug.Print "."
'
Case MAIL_DOT
'Change current state of the session
m_State = MAIL_QUIT
'
'Send QUIT command to the server
Winsock1.SendData "QUIT" & vbCrLf
'
Debug.Print "QUIT"
Case MAIL_QUIT
'
'Close connection
Winsock1.Close
'
End Select

Else
'
'If we are here server replied with
'unacceptable respose code therefore we need
'close connection and inform user about problem
'
Winsock1.Close
'
If Not m_State = MAIL_QUIT Then
MsgBox "Ошибка SMTP: " & strServerResponse, _
vbExclamation, "Ошибка SMTP"
Else
MsgBox "сообщение успешно отправлено.", vbInformation
End If
'
End If

End Sub
...
Рейтинг: 0 / 0
23.05.2006, 14:25
    #33745568
anjekos
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Winsock+send mail+authorization
Сам нашел решение, может кому интересно будет:-)

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim strServerResponse As String
Dim strResponseCode As String
Dim strDataToSend As String
'
'Retrive data from winsock buffer
'
Winsock1.GetData strServerResponse
MsgBox (m_State & "**" & strServerResponse)
'
Debug.Print strServerResponse
'
'Get server response code (first three symbols)
'
strResponseCode = Left(strServerResponse, 3)
'
'Only these three codes tell us that previous
'command accepted successfully and we can go on
'
If strResponseCode = "250" Or _
strResponseCode = "220" Or _
strResponseCode = "334" Or _
strResponseCode = "354" Then

Select Case m_State
Case MAIL_CONNECT
'Change current state of the session
m_State = MAIL_HELO
'
'Remove blank spaces
strDataToSend = Trim$(txtSender)
'
'Retrieve mailbox name from e-mail address
strDataToSend = Left$(strDataToSend, _
InStr(1, strDataToSend, "@") - 1)
'Send HELO command to the server
Winsock1.SendData "HELO " & strDataToSend & vbCrLf
'
Debug.Print "HELO " & strDataToSend
'
Case MAIL_HELO
'
'Change current state of the session
m_State = MAIL_FROM
'
'Send MAIL FROM command to the server
Winsock1.SendData "AUTH LOGIN " & vbCrLf
Winsock1.SendData Base64Encode("login") & vbCrLf
Winsock1.SendData Base64Encode("password") & vbCrLf
Winsock1.SendData "MAIL FROM:" & Trim$(txtSender) & vbCrLf
'
Debug.Print "MAIL FROM:" & Trim$(txtSender)
'
Case MAIL_FROM
'
'Change current state of the session
m_State = MAIL_RCPTTO
'
'Send RCPT TO command to the server
Winsock1.SendData "RCPT TO:" & Trim$(txtRecipient) & vbCrLf
'
Debug.Print "RCPT TO:" & Trim$(txtRecipient)
'
Case MAIL_RCPTTO
'
'Change current state of the session
m_State = MAIL_DATA
'
'Send DATA command to the server
Winsock1.SendData "DATA" & vbCrLf
'
Debug.Print "DATA"
'
Case MAIL_DATA
'
'Change current state of the session
m_State = MAIL_DOT
'
'So now we are sending a message body
'Each line of text must be completed with
'linefeed symbol (Chr$(10) or vbLf) not with vbCrLf
'
'Send Subject line
Winsock1.SendData "Subject:" & txtSubject & vbLf & vbCrLf
'
Debug.Print "Subject:" & txtSubject
'
Dim varLines As Variant
Dim varLine As Variant
Dim strMessage As String
'
'Add atacchments
strMessage = txtMessage & vbCrLf & vbCrLf & m_strEncodedFiles
'clear memory
m_strEncodedFiles = ""
'Parse message to get lines (for VB6 only)
varLines = Split(strMessage, vbCrLf)
'clear memory
strMessage = ""
'
'Send each line of the message
For Each varLine In varLines
Winsock1.SendData CStr(varLine) & vbLf
'
Debug.Print CStr(varLine)
Next
'
'Send a dot symbol to inform server
'that sending of message comleted
Winsock1.SendData "." & vbCrLf
'
Debug.Print "."
'
Case MAIL_DOT
'Change current state of the session
m_State = MAIL_QUIT
'
'Send QUIT command to the server
Winsock1.SendData "QUIT" & vbCrLf
'
Debug.Print "QUIT"
Case MAIL_QUIT
'
'Close connection
Winsock1.Close
'
End Select

Else
'
'If we are here server replied with
'unacceptable respose code therefore we need
'close connection and inform user about problem
'
Winsock1.Close
'
If Not m_State = MAIL_QUIT Then
MsgBox "Îøèáêà SMTP: " & strServerResponse, _
vbExclamation, "Îøèáêà SMTP"
Else
MsgBox "Áîðäåðî óñïåøíî îòïðàâëåíî.", vbInformation
End If
'
End If

End Sub

Private Sub Winsock1_Error(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)

MsgBox "Îøèáêà ñîåäèíåíèÿ ¹ " & Number & vbCrLf & _
Description, vbExclamation, "Îøèáêà ñîåäèíåíèÿ"
Winsock1.Close

End Sub

Private Function Base64Encode(ByVal inData) As String
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, i

'For each group of 3 bytes
For i = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup

'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, i, 1)) + &H100 * MyASC(Mid(inData, i + 1, 1)) + MyASC(Mid(inData, i + 2, 1))

'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)

'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup

'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)

'Add the part To OutPut string
sOut = sOut + pOut

'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next
Select Case Len(inData) Mod 3
Case 1 '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2 '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function

Private Function MyASC(ByVal OneChar) As Integer
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Winsock+send mail+authorization / 2 сообщений из 2, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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