mailsndasync1.pas

BaiduMp3 search baidu mp3

{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


Author:       Arno Garrels
Description:  This simple example demonstrates how to manage multiple,
              concurrent socket connections *without* the help of multiple
              threads.

              In order to evaluate all the features of the TSmtpCli component
              you should take a look at the MailSnd demo.

              Real parallel processing is working on multi processor Windows
              systems only. Actually Windows is serializing processing by
              frequently switching between all the threads currently active
              on a single CPU. The more threads are running the more CPU time
              and resources are wasted just for thread management.

              ICS is fully event driven and it uses non-blocking sockets, it
              doesn't require mulithreading in order to build lightning fast
              socket applications with multiple concurrent connections.

Creation:     05 September 2003
Version:      1.00
EMail:        [e-mail]
Support:      Use the mailing list [e-mail]
              Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 2003 by Arno Garrels <[e-mail]>

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

Updates:

 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

unit MailSndAsync1;

interface

{$B-}                                 { Enable partial boolean evaluation   }
{$T-}                                 { Untyped pointers                    }
{$X+}                                 { Enable extended syntax              }
{$H+}                                 { Use long strings                    }
{$J+}                                 { Allow typed constant to be modified }

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IniFiles, SmtpProt, WSocket;

  const
    MailSndAsyncVersion = 100;
    MailSndAsyncDate    = 'Sep 05, 2003';
    MailSndAsyncName    = 'MailSndAsync';
    CopyRight : String  = ' MailSndAsync (c) 2003 Arno Garrels V1.00 ';
    
    SectionData         = 'Data';
    KeyHost             = 'HostName';
    KeyFrom             = 'From';
    KeyTo               = 'To';
    KeySubject          = 'Subject';
    KeyUser             = 'UserName';
    KeyPwd              = 'Password';
    KeyMessage          = 'Message';
    KeyMaxCon           = 'MaximumConnections';
    KeyNumOfMails       = 'NumberOfMails';
    SectionWindow       = 'MainForm';
    KeyTop              = 'Top';
    KeyLeft             = 'Left';
    KeyWidth            = 'Width';
    KeyHeight           = 'Height';
    KeyDisplayLog       = 'DisplayLog';
    KeyDoAuth           = 'DoAuthenticate';
    WM_REMOVEOBJ        = WM_USER + 1;

type
  TMailData = packed record
    RcptName    : String;
    HdrTo       : String;
    HdrSubject  : String;
    MailMessage : String;
  end;
  PMailData = ^TMailData;

  TObj = packed record
    SmtpClient             : TSmtpCli;
    LogList                : TStringList;
  end;
  PObj = ^TObj;

  TForm1 = class(TForm)
    DisplayMemo     : TMemo;
    StartSendbutton : TButton;
    FillQueueButton : TButton;
    AbortButton     : TButton;
    Label1          : TLabel;
    Label2          : TLabel;
    Label3          : TLabel;
    Label4          : TLabel;
    Label5          : TLabel;
    Label6          : TLabel;
    Label7          : TLabel;
    Label8          : TLabel;
    Label9          : TLabel;
    Label10         : TLabel;
    NumOfMailsEdit  : TEdit;
    MaxConEdit      : TEdit;
    HostEdit        : TEdit;
    FromEdit        : TEdit;
    ToEdit          : TEdit;
    SubjectEdit     : TEdit;
    MessageEdit     : TEdit;
    UserEdit        : TEdit;
    PasswordEdit    : TEdit;
    CheckBoxAuth    : TCheckBox;
    CheckBoxDisplay : TCheckBox;
    ClearMemoButton : TButton;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SmtpSessionConnected(Sender: TObject; ErrCode: Word);
    procedure SmtpSessionClosed(Sender: TObject; ErrCode: Word);
    procedure SmtpCommand(Sender: TObject; Msg: String);
    procedure SmtpResponse(Sender: TObject; Msg: String);
    procedure SmtpRequestDone(Sender: TObject; RqType: TSmtpRequest;
                              ErrorCode: Word);
    procedure WMRemoveObj(var Msg : TMessage); Message WM_REMOVEOBJ;
    procedure FillQueueButtonClick(Sender: TObject);
    procedure StartSendbuttonClick(Sender: TObject);
    procedure ClearMemoButtonClick(Sender: TObject);
    procedure AbortButtonClick(Sender: TObject);
    procedure WSocket1DnsLookupDone(Sender: TObject; ErrCode: Word);

  private
    FAbort         : Boolean;
    FHostIP        : String;
    FCount         : Integer;
    FInitialized   : Boolean;
    FProgDir       : String;
    FIniFileName   : String;
    MaxConnections : Integer;
    Queue          : TList;
    Pool           : TList;
    WSocket1       : TWSocket; { Used for name resulution }
    function  FindObj(SmtpClient: TSmtpCli) : Integer;
    procedure AddToPool(MailData: PMailData);
    procedure LogLine(Sender: TObject; Msg: String);
    procedure Display(const Msg : String);
    procedure RefreshDisplay;

  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;


implementation

{$R *.DFM}

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TForm1.FormCreate(Sender: TObject);
begin
    FProgDir     := ExtractFilePath(ParamStr(0));
    if FProgDir[Length(FProgDir)] <> '\' then
        FProgDir := FProgDir + '\';

    FIniFileName             := LowerCase(ExtractFileName(Application.ExeName));
    FIniFileName             := Copy(FIniFileName, 1, Length(FIniFileName) - 3) + 'ini';
    FIniFileName             := FProgDir + FIniFileName;
    FInitialized             := False;
    FCount                   := 0;
    Queue                    := TList.Create;
    Pool                     := TList.Create;
    WSocket1                 := TWsocket.Create(nil);
    WSocket1.OnDnsLookupDone := WSocket1DnsLookupDone;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TForm1.FormDestroy(Sender: TObject);
var
   Obj        : PObj;
   I          : Integer;
begin
   { Just to be sure }
   for I := 0 to Pool.Count -1 do begin
       Obj := Pool.Items[0];
       Obj.LogList.Free;
       Obj.LogList := nil;
       Obj.SmtpClient.Free;
       Obj.SmtpClient := nil;
       Dispose(Obj);
       Pool.Delete(0);
   end;
   Pool.Free;

   { Just to be sure }
   for I := 0 to Queue.Count -1 do begin
       Dispose(PMailData(Queue.Items[0]));
       Queue.Delete(0);
   end;
   Queue.Free;

   WSocket1.Free;
   WSocket1 := nil;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TForm1.FormShow(Sender: TObject);
var
    IniFile: TIniFile;
begin
    if not FInitialized then begin
        FInitialized := TRUE;
        IniFile := TIniFile.Create(FIniFileName);
        HostEdit.Text       := IniFile.ReadString(SectionData, KeyHost,
                                               'localhost');
        FromEdit.Text       := IniFile.ReadString(SectionData, KeyFrom,
                                               '[e-mail]');
        ToEdit.Text         := IniFile.ReadString(SectionData, KeyTo,
                                               'john.doe@acme');
        SubjectEdit.Text    := IniFile.ReadString(SectionData, KeySubject,
                                               'This is the message subject');
        UserEdit.Text       :=  IniFile.ReadString(SectionData, KeyUser,
                                               'account name');
        PasswordEdit.Text   :=  IniFile.ReadString(SectionData, KeyPwd, 'password');
        MessageEdit.Text    :=  IniFile.ReadString(SectionData, KeyMessage,
                                                'This is the message text, here ' +
                                                'just a simple string');
        NumOfMailsEdit.Text := IniFile.ReadString(SectionData, KeyNumOfMails, '10');
        MaxConEdit.Text     := IniFile.ReadString(SectionData, KeyMaxCon, '2');
        CheckBoxDisplay.Checked := IniFile.ReadBool(SectionData, KeyDisplayLog, TRUE);
        CheckBoxAuth.Checked    := IniFile.ReadBool(SectionData, KeyDoAuth, FALSE);

        Top    := IniFile.ReadInteger(SectionWindow, KeyTop,    (Screen.Height - Height) div 2);
        Left   := IniFile.ReadInteger(SectionWindow, KeyLeft,   (Screen.Width - Width) div 2);
        Width  := IniFile.ReadInteger(SectionWindow, KeyWidth,  Width);
        Height := IniFile.ReadInteger(SectionWindow, KeyHeight, Height);
        IniFile.Free;

        Label10.Caption   := IntToStr(Queue.Count) + ' Jobs in Queue';
        Caption := 'ICS Parallel SMTP Demo';
        DisplayMemo.Clear;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
    IniFile: TIniFile;
begin
    IniFile := TIniFile.Create(FIniFileName);
    IniFile.WriteString(SectionData, KeyHost,             HostEdit.Text);
    IniFile.WriteString(SectionData, KeyFrom,             FromEdit.Text);
    IniFile.WriteString(SectionData, KeyTo,               ToEdit.Text);
    IniFile.WriteString(SectionData, KeySubject,          SubjectEdit.Text);
    IniFile.WriteString(SectionData, KeyUser,             UserEdit.Text);
    IniFile.WriteString(SectionData, KeyPwd,              PasswordEdit.Text);
    IniFile.WriteString(SectionData, KeyMessage,          MessageEdit.Text);
    IniFile.WriteString(SectionData, KeyNumOfMails,       NumOfMailsEdit.Text);
    IniFile.WriteBool(SectionData,   KeyDoAuth,           CheckBoxAuth.Checked);
    IniFile.WriteBool(SectionData,   KeyDisplayLog,       CheckBoxDisplay.Checked);

    IniFile.WriteString(SectionData, KeyMaxCon,           MaxConEdit.Text);

    IniFile.WriteInteger(SectionWindow, KeyTop,           Top);
    IniFile.WriteInteger(SectionWindow, KeyLeft,          Left);
    IniFile.WriteInteger(SectionWindow, KeyWidth,         Width);
    IniFile.WriteInteger(SectionWindow, KeyHeight,        Height);

    IniFile.Free;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TForm1.FillQueueButtonClick(Sender: TObject);
var
    I   : Integer;
    Obj : PMailData;
begin
    { Add some mail data to the queue }
    for I := 1 to StrToInt(Trim(NumOfMailsEdit.Text)) do begin
        New(Obj);