DocInput holds all the information about the current transfer, including the headers, the

number of bytes transferred, and the message data itself. Although not shown in this example,

you may call DocInput's SetData method if DocInput.State = icDocData to encode the data before

each block is sent.}

procedure TMail.SMTP1DocInput(Sender: TObject;

  const DocInput: DocInput);

begin

  case DocInput.State of

    icDocBegin:

      SMTPStatus.SimpleText := 'Initiating document transfer';

    icDocHeaders:

      SMTPStatus.SimpleText := 'Sending headers';

    icDocData:

      if DocInput.BytesTotal > 0 then

        SMTPStatus.SimpleText := Format('Sending data: %d of %d bytes (%d%%)',

          [Trunc(DocInput.BytesTransferred), Trunc(DocInput.BytesTotal),

           Trunc(DocInput.BytesTransferred/DocInput.BytesTotal*100)])

      else

        SMTPStatus.SimpleText := 'Sending...';

    icDocEnd:

      if SMTPError then

        SMTPStatus.SimpleText := 'Transfer aborted'

      else

        SMTPStatus.SimpleText := Format('Mail sent to %s (%d bytes data)', [eTo.Text,

          Trunc(DocInput.BytesTransferred)]);

  end;

  SMTPStatus.Update;

end;

{The Error event is called whenever an error occurs in the background processing. In

addition to providing an error code and brief description, you can also access the SMTP

component's Errors property (of type icErrors, an OLE object) to get more detailed

information}

procedure TMail.SMTP1Error(Sender: TObject; Number: Smallint;

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

  HelpFile: WideString; HelpContext: Integer; var CancelDisplay: WordBool);

var

  I: Integer;

  ErrorStr: string;

begin

  SMTPError := True;

  CancelDisplay := True;

  {Get extended error information}

  for I := 1 to SMTP1.Errors.Count do

    ErrorStr := Format(#13'(%s)', [SMTP1.Errors.Item(I).Description]);

  {Display error code, short and long error description}

  MessageDlg(Format('%d - %s%s', [Number, Description, Trim(ErrorStr)]), mtError, [mbOK], 0);

end;

{Unlike POP, SMTP does not require a user account on the host machine, so no user

authorization is necessary}

procedure TMail.SMTPConnectBtnClick(Sender: TObject);

begin

  if SMTP1.State = prcConnected then

    SMTP1.Quit

  else

  if SMTP1.State = prcDisconnected then

    begin

      SMTP1.RemoteHost := eSMTPServer.Text;

      SMTPError := False;

      SMTP1.Connect(NoParam, NoParam);

   end;

end;

{Unlike SMTP, users must be authorized on the POP server. The component defines

a special protocol state, popAuthorization, when it requests authorization. If

authorization is successful, the protocol state changes to popTransaction and

POP commands can be issued. Note that server connection is independent of the

authorization state.}

procedure TMail.POP1ProtocolStateChanged(Sender: TObject;

  ProtocolState: Smallint);

begin

  case ProtocolState of

    popAuthorization:

      POP1.Authenticate(POP1.UserID, POP1.Password);

    popTransaction:

      ConnectStatus.SimpleText := Format('User %s authorized on server %s', [eUsername.Text,

        ePOPServer.Text]);

  end;

end;

{This event is called every time the connection status of the POP server changes}

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

begin

  case State of

    prcConnecting:

      ConnectStatus.SimpleText := 'Connecting to POP server: '+POP1.RemoteHost+'...';

    prcResolvingHost:

      ConnectStatus.SimpleText := 'Resolving Host';

    prcHostResolved:

      ConnectStatus.SimpleText := 'Host Resolved';

    prcConnected:

      begin

        ConnectStatus.SimpleText := 'Connected to POP server: '+POP1.RemoteHost;

        POPConnectBtn.Caption := 'Disconnect';

      end;

    prcDisconnecting:

      ConnectStatus.SimpleText := 'Disconnecting from POP server: '+POP1.RemoteHost+'...';

    prcDisconnected:

      begin

        ConnectStatus.SimpleText := 'Disconnected from POP server: '+POP1.RemoteHost;

        POPConnectBtn.Caption := 'Connect';

      end;

   end;

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

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

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

end;

{The Error event is called whenever an error occurs in the background processing. In

addition to providing an error code and brief description, you can also access the POP

component's Errors property (of type icErrors, an OLE object) to get more detailed

information}

procedure TMail.POP1Error(Sender: TObject; Number: Smallint;

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

  HelpFile: WideString; HelpContext: Integer; var CancelDisplay: WordBool);

var

  I: Integer;

  ErrorStr: string;

begin

  POPError := True;

  CancelDisplay := True;

  if POP1.ProtocolState = popAuthorization then

    ConnectStatus.SimpleText := 'Authorization error';

  {Get extended error information}

  for I := 1 to POP1.Errors.Count do

    ErrorStr := Format(#13'(%s)', [POP1.Errors.Item(I).Description]);

  {Display error code, short and long error description}

  MessageDlg(Format('%d - %s%s', [Number, Description, Trim(ErrorStr)]), mtError, [mbOK], 0);

end;

{POP requires a valid user account on the host machine}

procedure TMail.POPConnectBtnClick(Sender: TObject);

begin

  if (POP1.State = prcConnected) and (POP1.ProtocolState = popTransaction)

  and not POP1.Busy then

  begin

    mReadMessage.Lines.Clear;

    POP1.Quit;

  end

  else

    if POP1.State = prcDisconnected then

    begin

      POP1.RemoteHost := ePOPServer.Text;

      POP1.UserID := eUserName.Text;

      POP1.Password := ePassword.Text;

      POP1.Connect(NoParam, NoParam);

    end;

end;

{The DocOutput event is the just like the DocInput event in 'reverse'. It is called each time

the component's DocOutput state changes during retrieval of mail from the server. When the

state = icDocData, you can call DocOutput.GetData to decode each data block based on the MIME

content type specified in the headers.}

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

var

  Buffer: WideString;

  I: Integer;

begin

  case DocOutput.State of

    icDocBegin:

      POPStatus.SimpleText := 'Initiating document transfer';

    icDocHeaders:

      begin

        POPStatus.SimpleText := 'Retrieving headers';

        for I := 1 to DocOutput.Headers.Count do

          mReadMessage.Lines.Add(DocOutput.Headers.Item(I).Name+': '+

            DocOutput.Headers.Item(I).Value);

      end;

    icDocData:

      begin

        POPStatus.SimpleText := Format('Retrieving data - %d bytes',

            [Trunc(DocOutput.BytesTransferred)]);

        Buffer := DocOutput.DataString;

        mReadMessage.Text := mReadMessage.Text + Buffer;

      end;

    icDocEnd:

      if POPError then

        POPStatus.SimpleText := 'Transfer aborted'

      else

        POPStatus.SimpleText := Format('Retrieval complete (%d bytes data)',

          [Trunc(DocOutput.BytesTransferred)]);

  end;

  POPStatus.Update;

end;

{Retrieve message from the server}

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

begin

  if (POP1.State = prcConnected) and (POP1.ProtocolState = popTransaction) then

  begin

    POPError := False;

    mReadMessage.Lines.Clear;

    POP1.RetrieveMessage(udCurMessage.Position);

  end;

end;

{The RefreshMessageCount event is called whenever the RefreshMessageCount method is

called, and also when a connection to the POP server is first made}

procedure TMail.POP1RefreshMessageCount(Sender: TObject;

  Number: Integer);

begin

  FMessageCount := Number;

  udCurMessage.Max := Number;

  udCurMessage.Enabled := Number <> 0;

  lMessageCount.Caption := IntToStr(Number);

  if Number > 0 then

  begin

    udCurMessage.Min := 1;

    udCurMessage.Position := 1;

    POP1.RetrieveMessage(udCurMessage.Position);

  end;

end;

end.

файл webbrows.dpr

program Webbrows;

uses

  Forms,

  main in 'Main.pas' {MainForm},

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