lNet examples

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  lnet, lsmtp, lnetssl;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;      // Send email button
    BodyLabel: TLabel;
    EmailLogLabel: TLabel;
    Memo1: TMemo;          // Mail content
    Memo2: TMemo;          // Mail log
    SubjectEdit: TEdit;    // Mail subject
    SubjectLabel: TLabel;
    MailToEdit: TEdit;     // MailTo
    MailToLabel: TLabel;
    MailFromEdit: TEdit;   // MailFrom
    MailFromLabel: TLabel;
    procedure Button1Click(Sender: TObject);
  private

  public

  end;

  type

  { TLSMTPClientTest }

  TLSMTPClientTest = class(TComponent)
   private
    FSMTP: TLSMTPClient; // this is THE smtp connection
    FSSL: TLSSLSession;
    FQuit: Boolean;  // helper for main loop
    { these events are used to see what happens on the SMTP connection. They are used via "CallAction".
      OnReceive will get fired whenever new data is received from the SMTP server.
      OnConnect will get fired when connecting to the SMTP server ends with success.
      OnDisconnect will get fired when the other side closes the connection gracefully.
      OnError will get called when any kind of error occurs on the connection. }
    procedure OnReceive(aSocket: TLSocket);
    procedure OnConnect(aSocket: TLSocket);
    procedure OnDisconnect(aSocket: TLSocket);
    procedure OnError(const msg: string; aSocket: TLSocket);
    { This event is used to monitor TLS session handshake. If SSL or TLS is used
      we will know if the handshake went ok if this event is fired on the session }
    procedure OnSSLConnect(aSocket: TLSocket);
   public
    constructor Create(aOwner: TComponent); override;
    procedure Run; // main SMTP processing loop
  end;

var
  Form1: TForm1;
  SMTP: TLSMTPClientTest;

implementation

{$R *.lfm}

{ TForm1 }

procedure TLSMTPClientTest.OnReceive(aSocket: TLSocket);
var
  s: string;
begin
  if FSMTP.GetMessage(s) > 0 then // if we actually received something from SMTP server
    begin
     Form1.Memo2.Append(s);       // inform user

     // Check server response to see if we should quit because mail delivered
     If pos('250 2.0.0',s) <> 0 then
       FQuit := True
    end;
end;

procedure TLSMTPClientTest.OnConnect(aSocket: TLSocket);
begin
  Form1.Memo2.Append('Connected' + LineEnding); // inform user of successful connect
end;

procedure TLSMTPClientTest.OnDisconnect(aSocket: TLSocket);
begin
  Form1.Memo2.Append('Lost connection'); // inform user about lost connection
  FQuit := True;      // since SMTP shouldn't do this unless we issued a QUIT,
                      // consider it to be end of session and quit it.
end;

procedure TLSMTPClientTest.OnError(const msg: string; aSocket: TLSocket);
begin
  Form1.Memo2.Append(msg);  // inform user of error
  FQuit := True;            // and quit session.
end;

procedure TLSMTPClientTest.OnSSLConnect(aSocket: TLSocket);
begin
  Form1.Memo2.Append('SSL session handshake was successful');
end;

constructor TLSMTPClientTest.Create(aOwner: TComponent);
begin
  inherited;
  FQuit := False;

  FSSL := TLSSLSession.Create(Self);
  FSSL.SSLActive := False;            // make it "off" by default
  FSSL.OnSSLConnect := @OnSSLConnect; // let's watch if TLS/SSL handshake is ok

  FSMTP := TLSMTPClient.Create(Self);
  FSMTP.Session := FSSL;         // set the SSL session, so if it's a SSL/TLS SMTP we can use it
  FSMTP.Timeout := 100;          // responsive enough, but won't hog CPU
  FSMTP.OnReceive := @OnReceive; // assign all events
  FSMTP.OnConnect := @OnConnect;
  FSMTP.OnDisconnect := @OnDisconnect;
  FSMTP.OnError := @OnError;
end;

// Main SMTP processing loop
procedure TLSMTPClientTest.Run;
var
  Addr, Subject, Sender, Recipients, Message: string;
  Port: Integer;
begin
  Addr := '192.168.1.4';                // hard code my mailserver
  Port := 25;                           // hard code my SMTP port number

  Sender := Form1.MailFromEdit.Text;    // get info about email from Form1 edit fields
  Recipients := Form1.MailToEdit.Text;
  Subject := Form1.SubjectEdit.Text;
  Message := Form1.Memo1.Text;

  Form1.Memo2.Append('Connecting to ' + Addr + ':' + IntToStr(Port) + '... ');

  if FSMTP.Connect(Addr, Port) then
    repeat                          // try to connect
        FSMTP.CallAction;           // if initial connect went ok, wait for acknowledgment/otherwise
    until FSMTP.Connected or FQuit; // if quit (eg error), or we connected, then continue

  If(FQuit) then  // if we need to quit because of a connection error
    exit;         // exit now

  while not FQuit do       // do main loop
    begin
      FSMTP.Ehlo;          // "Polite people say HELO first" (yeah, but nearly everyone is enhanced now)
      FSMTP.CallAction;    // main event mechanism, must call periodicly and ASAP, or specify high timeout
      FSMTP.StartTLS;      // ask for TLS
      FSMTP.SendMail(Sender, Recipients, Subject, Message); // send the email
    end;
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;     // disable button until session finished
  Memo2.Clear;                  // clear email log
  SMTP := TLSMTPClientTest.Create(nil);

  Try
    SMTP.Run;                     // try to deliver the mail
  Finally
    SMTP.Free;
    Button1.Enabled := True;      // enable button now session finished
    Memo1.Clear;                  // clear email content
  End;
end;

end.