Label5: TLabel;

    eUserName: TEdit;

    ePassword: TEdit;

    Label4: TLabel;

    GroupBox2: TGroupBox;

    Label7: TLabel;

    eSMTPServer: TEdit;

    SMTPConnectBtn: TButton;

    POPConnectBtn: TButton;

    eHomeAddr: TEdit;

    Label8: TLabel;

    Panel2: TPanel;

    Label9: TLabel;

    lMessageCount: TLabel;

    Label10: TLabel;

    eCurMessage: TEdit;

    udCurMessage: TUpDown;

    ConnectStatus: TStatusBar;

    procedure FormCreate(Sender: TObject);

    procedure POP1StateChanged(Sender: TObject; State: Smallint);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure SMTP1StateChanged(Sender: TObject; State: Smallint);

    procedure FormResize(Sender: TObject);

    procedure ClearBtnClick(Sender: TObject);

    procedure SMTP1Verify(Sender: TObject);

    procedure SendBtnClick(Sender: TObject);

    procedure POP1ProtocolStateChanged(Sender: TObject;

      ProtocolState: Smallint);

    procedure SMTPConnectBtnClick(Sender: TObject);

    procedure POPConnectBtnClick(Sender: TObject);

    procedure eSMTPServerChange(Sender: TObject);

    procedure ePOPServerChange(Sender: TObject);

    procedure cbSendFileClick(Sender: TObject);

    procedure udCurMessageClick(Sender: TObject; Button: TUDBtnType);

    procedure POP1RefreshMessageCount(Sender: TObject; Number: Integer);

    procedure POP1DocOutput(Sender: TObject; const DocOutput: DocOutput);

    procedure POP1Error(Sender: TObject; Number: Smallint;

      var Description: WideString; Scode: Integer; const Source,

      HelpFile: WideString; HelpContext: Integer;

      var CancelDisplay: WordBool);

    procedure SMTP1DocInput(Sender: TObject; const DocInput: DocInput);

    procedure SMTP1Error(Sender: TObject; Number: Smallint;

      var Description: WideString; Scode: Integer; const Source,

      HelpFile: WideString; HelpContext: Integer;

      var CancelDisplay: WordBool);

  private

    RecvVerified,

    SMTPError,

    POPError: Boolean;

    FMessageCount: Integer;

    procedure SendFile(Filename: string);

    procedure SendMessage;

    procedure CreateHeaders;

  end;

var

  Mail: TMail;

implementation

{$R *.DFM}

const

  icDocBegin = 1;

  icDocHeaders = 2;

  icDocData = 3;

  icDocEnd = 5;

{When calling a component method which maps onto an OLE call, NoParam substitutes

for an optional parameter. As an alternative to calling the component method, you

may access the component's OLEObject directly -

i.e., Component.OLEObject.MethodName(,Foo,,Bar)}

function NoParam: Variant;

begin

  TVarData(Result).VType := varError;

  TVarData(Result).VError := DISP_E_PARAMNOTFOUND;

end;

procedure TMail.FormCreate(Sender: TObject);

begin

  SMTPError := False;

  POPError := False;

  FMessageCount := 0;

end;

procedure TMail.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  if POP1.State = prcConnected then POP1.Quit;

  if SMTP1.State = prcConnected then SMTP1.Quit;

end;

procedure TMail.FormResize(Sender: TObject);

begin

  SendBtn.Left := ClientWidth - SendBtn.Width - 10;

  ClearBtn.Left := ClientWidth - ClearBtn.Width - 10;

  cbSendFile.Left := ClientWidth - cbSendFile.Width - 10;

  eTo.Width := SendBtn.Left - eTo.Left - 10;

  eCC.Width := SendBtn.Left - eCC.Left - 10;

  eSubject.Width := SendBtn.Left - eSubject.Left - 10;

end;

procedure TMail.ClearBtnClick(Sender: TObject);

begin

  eTo.Text := '';

  eCC.Text := '';

  eSubject.Text := '';

  OpenDialog.Filename := '';

  reMessageText.Lines.Clear;

end;

procedure TMail.eSMTPServerChange(Sender: TObject);

begin

  SMTPConnectBtn.Enabled := (eSMTPServer.Text <> '') and (eHomeAddr.Text <> '');

end;

procedure TMail.ePOPServerChange(Sender: TObject);

begin

  POPConnectBtn.Enabled := (ePOPServer.Text <> '') and (eUsername.Text <> '')

    and (ePassword.Text <> '');

end;

procedure TMail.cbSendFileClick(Sender: TObject);

begin

  if cbSendFile.Checked then

  begin

    if OpenDialog.Execute then

      cbSendFile.Caption := cbSendFile.Caption + ': '+OpenDialog.Filename

    else

      cbSendFile.Checked := False;

  end else

    cbSendFile.Caption := '&Attach Text File';

end;

{Clear and repopulate MIME headers, using the component's DocInput property. A

separate DocInput OLE object could also be used. See RFC1521/1522 for complete

information on MIME types.}

procedure TMail.CreateHeaders;

begin

  with SMTP1 do

  begin

    DocInput.Headers.Clear;

    DocInput.Headers.Add('To', eTo.Text);

    DocInput.Headers.Add('From', eHomeAddr.Text);

    DocInput.Headers.Add('CC', eCC.Text);

    DocInput.Headers.Add('Subject', eSubject.Text);

    DocInput.Headers.Add('Message-Id', Format('%s_%s_%s', [Application.Title,

      DateTimeToStr(Now), eHomeAddr.Text]));

    DocInput.Headers.Add('Content-Type', 'TEXT/PLAIN charset=US-ASCII');

  end;

end;

{Send a simple mail message}

procedure TMail.SendMessage;

begin

  CreateHeaders;

  with SMTP1 do

    SendDoc(NoParam, DocInput.Headers, reMessageText.Text, '', '');

end;

{Send a disk file. Leave SendDoc's InputData parameter blank and

specify a filename for InputFile to send the contents of a disk file. You can

use the DocInput event and GetData methods to do custom encoding (Base64, UUEncode, etc.) }

procedure TMail.SendFile(Filename: string);

begin

  CreateHeaders;

  with SMTP1 do

  begin

    DocInput.Filename := FileName;

    SendDoc(NoParam, DocInput.Headers, NoParam, DocInput.FileName, '');

  end;

end;

{Set global flag indicating recipients are addressable (this only ensures that the

address is in the correct format, not that it exists and is deliverable), then

send the text part of the message}

procedure TMail.SMTP1Verify(Sender: TObject);

begin

  SendMessage;

  RecvVerified := True;

end;

{Verify addressees, send text message in the Verify event, and if an attachment is

specified, send it}

procedure TMail.SendBtnClick(Sender: TObject);

var

  Addressees: string;

begin

  if SMTP1.State = prcConnected then

  begin

    RecvVerified := False;

    SMTPError := False;

    Addressees := eTo.Text;

    if eCC.Text <> '' then

      Addressees := Addressees + ', '+ eCC.Text;

    SMTP1.Verify(Addressees);

    {wait for completion of Verify-Text message send}

    while SMTP1.Busy do

      Application.ProcessMessages;

    {Check global flag indicating addresses are in the correct format - if true,

    the text part of the message has been sent}

    if not RecvVerified then

    begin

      MessageDlg('Incorrect address format', mtError, [mbOK], 0);

      Exit;

    end

    else

      if cbSendFile.Checked then

        SendFile(OpenDialog.Filename);

  end

  else

    MessageDlg('Not connected to SMTP server', mtError, [mbOK], 0);

end;

{SMTP component will call this event every time its connection state changes}

procedure TMail.SMTP1StateChanged(Sender: TObject; State: Smallint);

begin

  case State of

    prcConnecting:

      ConnectStatus.SimpleText := 'Connecting to SMTP server: '+SMTP1.RemoteHost+'...';

    prcResolvingHost:

      ConnectStatus.SimpleText := 'Resolving Host';

    prcHostResolved:

      ConnectStatus.SimpleText := 'Host Resolved';

    prcConnected:

      begin

        ConnectStatus.SimpleText := 'Connected to SMTP server: '+SMTP1.RemoteHost;

        SMTPConnectBtn.Caption := 'Disconnect';

      end;

    prcDisconnecting:

      ConnectStatus.SimpleText := 'Disconnecting from SMTP server: '+SMTP1.RemoteHost+'...';

    prcDisconnected:

      begin

        ConnectStatus.SimpleText := 'Disconnected from SMTP server: '+SMTP1.RemoteHost;

        SMTPConnectBtn.Caption := 'Connect';

      end;

   end;

   eSMTPServer.Enabled := not (State = prcConnected);

   eHomeAddr.Enabled := not (State = prcConnected);

end;

{The DocInput event is called each time the DocInput state changes during a mail transfer.

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17