Smtp Socket WinApi

0

Smtp Socket WinApi

witam zalaczam przykladowy kod jak za pomoca socetow wyslac emaila, widzialem ze na tym forum pare watkow sie przetoczylo ale nikt nie dal konkretnego przykladu. Moze sie cos komus przyda z tego kiedys...

1xmemo
2xbuton
1xClientSocet (kliknac eventsy odpowiednie)

przydatne linki:
http://www.koders.com/delphi/fidA8D2B6C791C79040DFF23A04C74667EFE8EDBBF1.aspx?s=base64
http://www.delphi-forum.de/viewtopic.php?p=341477&sid=0372c851b3cf31f1064134bedde63dcf

unit Unit1;

interface

uses
  Windows, Messages, Forms, ScktComp, StdCtrls, Classes, Controls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ClientSocket1: TClientSocket;
    Button2: TButton;
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket1Write(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure ClientSocket1Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MailBuffer: array [0..2048] of char;

const
  Base64Code    = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
                + 'abcdefghijklmnopqrstuvwxyz'
                + '0123456789+/';
  Pad           = '=';

implementation

{$R *.dfm}

function StrTobase64( Buf: string ): string;
var
//  B3            : string[3];
  i             : integer;
  x1, x2, x3, x4: byte;
  PadCount      : integer;
begin
  PadCount := 0;

 // we need at least 3 input bytes...
  while length( Buf ) < 3 do
  begin
    Buf := Buf + #0;
    inc( PadCount );
  end;

 // ...and all input must be an even multiple of 3
  while ( length( Buf ) mod 3 ) <> 0 do
  begin
    Buf := Buf + #0; // if not, zero padding is added
    inc( PadCount );
  end;

  Result := '';
  i := 1;

 // process 3-byte blocks or 24 bits
  while i <= length( Buf ) - 2 do
  begin
    // each 3 input bytes are transformed into 4 index values
    // in the range of  0..63, by taking 6 bits each step

    // 6 high bytes of first char
    x1 := ( Ord( Buf[i] ) shr 2 ) and $3F;

    // 2 low bytes of first char + 4 high bytes of second char
    x2 := ( ( Ord( Buf[i] ) shl 4 ) and $3F )
      or Ord( Buf[i + 1] ) shr 4;

    // 4 low bytes of second char + 2 high bytes of third char
    x3 := ( ( Ord( Buf[i + 1] ) shl 2 ) and $3F )
      or Ord( Buf[i + 2] ) shr 6;

    // 6 low bytes of third char
    x4 := Ord( Buf[i + 2] ) and $3F;

    // the index values point into the code array
    Result := Result
      + Base64Code[x1 + 1]
      + Base64Code[x2 + 1]
      + Base64Code[x3 + 1]
      + Base64Code[x4 + 1];
    inc( i, 3 );
  end;

 // if needed, finish by forcing padding chars ('=')
 // at end of string
  if PadCount > 0 then
    for i := Length( Result ) downto 1 do
    begin
      Result[i] := Pad;
      dec( PadCount );
      if PadCount = 0 then BREAK;
    end;

end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.Lines.Add('polaczony');
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
memo1.Lines.Add('error');
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.Lines.Add('read');

end;

procedure TForm1.ClientSocket1Write(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.Lines.Add('write');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Address:='smtp.wp.pl';
ClientSocket1.Host:='smtp.wp.pl';
ClientSocket1.Port:=25;
ClientSocket1.ClientType:= ctBlocking;
ClientSocket1.Active:=true;
end;

procedure TForm1.ClientSocket1Connecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.Lines.Add('Lacze');
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.Lines.Add('Rozlaczony');
end;

procedure TForm1.Button2Click(Sender: TObject);
var odbierz:string;
begin

odbierz:=ClientSocket1.Socket.ReceiveText;

if odbierz<> '220'then
  begin
  memo1.Lines.Add ('HELO smtp.wp.pl');
  ClientSocket1.Socket.SendText('HELO smtp.wp.pl' + #13#10);
  ClientSocket1.Socket.ReceiveText;

  end;

if odbierz<> '250'then
   begin
  memo1.Lines.Add ('AUTH LOGIN');
  ClientSocket1.Socket.SendText('AUTH LOGIN' + #13#10);

  ClientSocket1.Socket.ReceiveText;
  end;

if odbierz<> '250'then
   begin
  memo1.Lines.Add ('login');
  ClientSocket1.Socket.SendText(StrTobase64('login') + #13#10);
  ClientSocket1.Socket.ReceiveText;
  end;

if odbierz<> '250'then
   begin
  memo1.Lines.Add ('haslo');
  ClientSocket1.Socket.SendText(StrTobase64('haslo') + #13#10);
  ClientSocket1.Socket.ReceiveText;
  end;

if odbierz<> '250'then
   begin
  memo1.Lines.Add ('MAIL FROM: [email protected]');
  ClientSocket1.Socket.SendText('MAIL FROM: [email protected]' + #13#10);
  ClientSocket1.Socket.ReceiveText;
  end;
if odbierz<> '250'then
   begin
  memo1.Lines.Add ('RCPT TO: [email protected]');
  ClientSocket1.Socket.SendText('RCPT TO: [email protected]' + #13#10);
  ClientSocket1.Socket.ReceiveText;
  end;

if odbierz<> '250'then
   begin
  memo1.Lines.Add ( 'DATA' );
  ClientSocket1.Socket.SendText(  'DATA' + #13#10);
  ClientSocket1.Socket.ReceiveText;
  end;

if odbierz<>  '354'then
   begin
  memo1.Lines.Add ( 'DATA' );
  ClientSocket1.Socket.SendText('From: [email protected]' + #13#10 + 'To: [email protected]' + #13#10 + 'Subject: temat' + #13#10#13#10 + 'tresc wiadomosci' + #13#10 + '.' + #13#10);
  ClientSocket1.Socket.ReceiveText;
  end;

if odbierz<> '250'then
   begin
  memo1.Lines.Add ( 'QUIT'  );
  ClientSocket1.Socket.SendText( 'QUIT' + #13#10);
  ClientSocket1.Socket.ReceiveText;
  end;

end;

end.
0

taki bajer to raczej na stronę do gotowców daj bo tutaj to sie tylko zmarnuje (IMHO)

1 użytkowników online, w tym zalogowanych: 0, gości: 1, botów: 0