Delphi: Функция для отправки письма с аттачментом c помощью winsock

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by o_OBallers, 13 Oct 2007.

  1. o_OBallers

    o_OBallers Banned

    Joined:
    11 Oct 2007
    Messages:
    23
    Likes Received:
    24
    Reputations:
    0
    Нужна функция которая отправляет письмо с аттачментом на e-mail, минуя любые промежуточные сервера.
    Что-то вроде : function Send(email,FileName:String):boolean;
     
  2. kair

    kair Elder - Старейшина

    Joined:
    12 Oct 2006
    Messages:
    146
    Likes Received:
    83
    Reputations:
    -4
    ну я не очень хорошо вдельфи разбираюсь, но вот какой-то исходник есть

    Code:
    program MailSend; 
    
    {$APPTYPE CONSOLE} 
    
    uses
      windows,
      WinSock;
    
    Function SendMail(Smtp: PChar; Port: dword; From, Dest, Data: PChar): boolean;
    var 
    FSocket: integer; 
    HostEnt: PHostEnt;
    SockAddrIn: TSockAddrIn; 
    dBuff: PChar; 
    dSize: dword; 
    Str: array [0..255] of Char; 
    
    function Success(): boolean; 
    var 
    Bytes: dword; 
    RBuff: array [0..255] of Char; 
    begin 
    Result := false; 
    Bytes := recv(FSocket, RBuff, 255, 0); 
    if (Bytes = 0) or (Bytes = SOCKET_ERROR) then Exit; 
    RBuff[3] := #0; 
    if lstrcmp(RBuff, '220') = 0 then Result := true else 
    if lstrcmp(RBuff, '250') = 0 then Result := true else 
    if lstrcmp(RBuff, '354') = 0 then Result := true; 
    end; 
    
    begin 
    Result := false; 
    FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP); 
    SockAddrIn.sin_family := AF_INET; 
    SockAddrIn.sin_port := htons(Port); 
    SockAddrIn.sin_addr.s_addr := inet_addr(Smtp); 
    if SockAddrIn.sin_addr.s_addr = INADDR_NONE then 
    begin 
    HostEnt := gethostbyname(Smtp); 
    if HostEnt = nil then 
    begin 
    closesocket(FSocket); 
    Exit; 
    end; 
    SockAddrIn.sin_addr.s_addr := PLongint(HostEnt^.h_addr_list^)^; 
    end; 
    if Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn)) <> -1 then 
    begin 
    if Success then 
    begin 
    lstrcpy(Str, PChar('HELO ' + Smtp + #13#10#0)); 
    send(FSocket, Str, lstrlen(Str), 0); 
    if Success then 
    begin 
    lstrcpy(Str, PChar('MAIL FROM: ' + From + #13#10#0)); 
    send(FSocket, Str, lstrlen(Str), 0); 
    if Success then 
    begin 
    lstrcpy(Str, PChar('RCPT TO: ' + Dest + #13#10#0)); 
    send(FSocket, Str, lstrlen(Str), 0); 
    if Success then 
    begin 
    lstrcpy(Str, 'DATA'#13#10#0); 
    send(FSocket, Str, lstrlen(Str), 0); 
    if Success then 
    begin 
    dSize := lstrlen(Data); 
    GetMem(dBuff, dSize + 6); 
    lstrcpy(dBuff, Data); 
    lstrcat(dBuff, #13#10'.'#13#10#0); 
    send(FSocket, dBuff^, dSize + 6, 0); 
    FreeMem(dBuff); 
    if Success then 
    begin 
    lstrcpy(Str, 'QUIT'#13#10#0); 
    send(FSocket, Str, lstrlen(Str), 0); 
    Result := true; 
    end; 
    end; 
    end; 
    end; 
    end; 
    end; 
    end; 
    closesocket(FSocket); 
    end; 
    
    var 
    WSAData: TWSAData; 
    Mail, Data: string; 
    
    begin 
    Write('Send Mail to: '); 
    ReadLn(Mail); 
    Write('Enter Mail Text: '); 
    ReadLn(Data); 
    WSAStartup(257, WSAData); 
    if SendMail('smtp.mail.ru', 25, 
    'yandex@mail.ru',
    PChar(Mail), PChar(Data)) then 
    WriteLn('Mail sended') else WriteLn('Error on sending mail');
    ReadLn;
    WSACleanup();
    end.
    может это оно!? =\
     
  3. W!z@rD

    W!z@rD Борец за русский язык

    Joined:
    12 Feb 2006
    Messages:
    973
    Likes Received:
    290
    Reputations:
    43
    "отправка данных на Delphi то smtp!"
    /thread33820.html

    почему никто не юзает поиск?!?!?
    писец... давайте создавать кучу однотипных топиков и ждать пока в них кинут ссылку на соседний топик, либо откопипастят код с того же соседнего топика...
     
    1 person likes this.
  4. o_OBallers

    o_OBallers Banned

    Joined:
    11 Oct 2007
    Messages:
    23
    Likes Received:
    24
    Reputations:
    0
    Ни здесь ни в той теме которую ты показал нету ничего про аттчмент.
     
  5. KEZ

    KEZ Ненасытный школьник

    Joined:
    18 May 2005
    Messages:
    1,604
    Likes Received:
    754
    Reputations:
    397
    Тема про аттачмент есть в rfc. Читай rfc. Аттачмент там отправляется как multi-part/bounded data, как и по HTTP.
    2616 (HTTP)
    чтобы миновать промежуточные сервера запрашивай mx-запись сервера (то, что после собаки "@") у DNS сервера через DnsQuery_A и посылай через неё.
    Айпи должен быть не в блеке, статический, короче не диалап левый.
     
  6. z01b

    z01b Муджахид

    Joined:
    5 Jan 2007
    Messages:
    494
    Likes Received:
    382
    Reputations:
    22
    Я тоже свой исходник на ачате гдето выкладывал, поиск рулит!
     
  7. o_OBallers

    o_OBallers Banned

    Joined:
    11 Oct 2007
    Messages:
    23
    Likes Received:
    24
    Reputations:
    0
    Re:Kez

    То есть ты хочешь сказать SMTP сервер не будет функционировать на на ip диалапного провайдера.
     
  8. Delimiter

    Delimiter Banned

    Joined:
    8 Apr 2005
    Messages:
    317
    Likes Received:
    173
    Reputations:
    12
    Smtp-server конечно можно поставить.... прописать MX подождать сутки и пользуйся! Только вот в толк не возьму при чем тут сервер, когда ты спрашиваешь о клиенте, который в соответствии с MIME 64 должен аттачить файл.
    А твой клиент должен работать с сервером на котором происходит авторизация.... либо с серверами поддерживающими анонимную авторизацию, но данная функция отключена почти у всех..... никому не хочется платить за spam трафик !
     
    #8 Delimiter, 15 Oct 2007
    Last edited: 15 Oct 2007
  9. KEZ

    KEZ Ненасытный школьник

    Joined:
    18 May 2005
    Messages:
    1,604
    Likes Received:
    754
    Reputations:
    397
    Какой сервер? Тебя забанят просто при попытке послать письмо через mx-сервер напрямую, если айпи у тебя диалапный. Через MX-сервера вообще по нормальному должны посылать другие почтовые сервера.
    А, да, аватара ниче так. Что ещё сказать...
     
    3 people like this.