i: Integer;

begin

  for i := 0 to AList.Count - 1 do

    if AList.Objects[i] <> nil then

      DestroyList(TStringList(AList.Objects[i]));

  AList.Free;

end;

procedure BuildTree(Parent: TTreeNode; List: TStrings);

var

  i: Integer;

  Node: TTreeNode;

begin

  for i := 0 to List.Count - 1 do

    if List.Objects[i] <> nil then

    begin

      Node := NewsForm.NewsGroups.Items.AddChild(Parent, List[i]);

      Node.ImageIndex := 0;

      Node.SelectedIndex := 1;

      BuildTree(Node, TStrings(List.Objects[i]));

    end

    else

      NewsForm.NewsGroups.Items.AddChild(Parent, List[i]);

end;

function TNewsForm.NodePath(Node: TTreeNode): String;

begin

  if Node.Parent = nil then

    Result := Node.Text

  else

    Result := NodePath(Node.Parent) + '.' + Node.Text;

end;

procedure TNewsForm.FileConnectItemClick(Sender: TObject);

begin

  ConnectDlg := TConnectDlg.Create(Self);

  try

    if ConnectDlg.ShowModal = mrOk then

      with NNTP1 do

        Connect(ConnectDlg.ServerEdit.Text, RemotePort);

  finally

    ConnectDlg.Free;

  end;

end;

procedure TNewsForm.NNTP1ProtocolStateChanged(Sender: TObject;

  ProtocolState: Smallint);

begin

  case ProtocolState of

    nntpBase: ;

    nntpTransaction:

      begin

        EventFlag := efListGroups;

        Nodes := TStringList.Create;

        Nodes.Sorted := True;

        NNTP1.ListGroups;

      end;

  end;

end;

procedure TNewsForm.NNTP1StateChanged(Sender: TObject; State: Smallint);

begin

  with Memo1.Lines do

    case NNTP1.State of

      prcConnecting   : Add('Connecting');

      prcResolvingHost: Add('Resolving Host: ' + NNTP1.RemoteHost);

      prcHostResolved : Add('Host resolved');

      prcConnected    :

        begin

          Add('Connected to: ' + NNTP1.RemoteHost);

          Statusbar.Panels[0].Text := 'Connected to: ' + NNTP1.RemoteHost;

          ConnectBtn.Enabled := False;

          FileConnectItem.Enabled := False;

          RefreshBtn.Enabled := True;

        end;

      prcDisconnecting: Text := NNTP1.ReplyString;

      prcDisconnected :

        begin

          Statusbar.Panels[0].Text := 'Disconnected';

          Caption := 'News Reader';

          Label1.Caption := '';

          ConnectBtn.Enabled := True;

          FileConnectItem.Enabled := True;

          RefreshBtn.Enabled := False;

        end;

    end;

end;

procedure TNewsForm.Exit1Click(Sender: TObject);

begin

  if NNTP1.State <> prcDisconnected then

  begin

    if NNTP1.Busy then NNTP1.Cancel;

    NNTP1.Quit;

    while NNTP1.State <> prcDisconnected do

      Application.ProcessMessages;

  end;

  Close;

end;

procedure TNewsForm.MsgHeadersDblClick(Sender: TObject);

var

  Article: Integer;

begin

  if NNTP1.Busy then exit;

  EventFlag := efGetArticle;

  Memo1.Clear;

  if MsgHeaders.ItemIndex = -1 then exit;

  Caption := 'News Reader: ' + MsgHeaders.Items[MsgHeaders.ItemIndex];

  Article := Integer(MsgHeaders.Items.Objects[MsgHeaders.ItemIndex]);

  NNTP1.GetArticlebyArticleNumber(Article);

end;

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

begin

  if NNTP1.State <> prcDisconnected then

  begin

    if NNTP1.Busy then NNTP1.Cancel;

    NNTP1.Quit;

    while NNTP1.State <> prcDisconnected do

      Application.ProcessMessages;

  end;

end;

procedure TNewsForm.NewsGroupsChange(Sender: TObject; Node: TTreeNode);

var

  NP: String;

begin

  if (NNTP1.State = prcConnected) and not NNTP1.Busy then

    with MsgHeaders do

    begin

      Items.BeginUpdate;

      try

        Items.Clear;

        Memo1.Lines.Clear;

        NP := NodePath(NewsGroups.Selected);

        Statusbar.Panels[2].Text := 'Bytes: 0';

        Statusbar.Panels[1].Text := '0 Article(s)';

        if NNTP1.Busy then

          NNTP1.Cancel;

        NNTP1.SelectGroup(NP);

        Label1.Caption := 'Contents of ''' + NP + '''';

      finally

        Items.EndUpdate;

      end;

    end;

end;

procedure TNewsForm.RefreshBtnClick(Sender: TObject);

begin

  if NewsGroups.Selected <> nil then

    NewsGroupsChange(nil, NewsGroups.Selected);

end;

procedure TNewsForm.FileDisconnectItemClick(Sender: TObject);

begin

  if NNTP1.Busy then NNTP1.Cancel;

  NNTP1.Quit;

  while NNTP1.Busy do

    Application.ProcessMessages;

  with NewsGroups.Items do

  begin

    BeginUpdate;

    Clear;

    EndUpdate;

  end;

  MsgHeaders.Items.Clear;

  Memo1.Lines.Clear;

end;

procedure TNewsForm.NNTP1Banner(Sender: TObject; const Banner: WideString);

begin

  Memo1.Lines.Add(Banner);

end;

procedure TNewsForm.NNTP1DocOutput(Sender: TObject;

  const DocOutput: DocOutput);

begin

  Statusbar.Panels[2].Text := Format('Bytes: %d',[DocOutput.BytesTransferred]);

  case DocOutput.State of

    icDocBegin:

      begin

        if EventFlag = efListGroups then

          Memo1.Lines.Add('Retrieving news groups...');

        Data := '';

        GroupCount := 0;

      end;

    icDocData:

      begin

        Data := Data + DocOutput.DataString;

        if EventFlag = efGetArticle then

          Memo1.Lines.Add(Data);

      end;

    icDocEnd:

      begin

        case EventFlag of

          efListGroups:

            begin

              ParseGroups(Data);

              Memo1.Lines.Add('Done.'#13#10'Building news group tree...');

              NewsGroups.Items.BeginUpdate;

              try

                BuildTree(nil, Nodes);

                DestroyList(Nodes);

                Statusbar.Panels[1].Text := Format('%d Groups',[GroupCount]);

              finally

                NewsGroups.Items.EndUpdate;

                Memo1.Lines.Add('Done.');

              end;

            end;

          efGetArticleHeaders: ParseHeaders(Data);

          efGetArticle:

            begin

              Memo1.SelStart := 0;

              SendMessage(Memo1.Handle, EM_ScrollCaret, 0, 0);

            end;

        end;

        SetLength(Data, 0);

      end;

  end;

  Refresh;

end;

procedure TNewsForm.NNTP1Error(Sender: TObject; Number: Smallint;

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

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

begin

//  MessageDlg(Description, mtError, [mbOk], 0);

end;

procedure TNewsForm.NNTP1SelectGroup(Sender: TObject;

  const groupName: WideString; firstMessage, lastMessage,

  msgCount: Integer);

begin

  EventFlag := efGetArticleHeaders;

  Statusbar.Panels[1].Text := Format('%d Article(s)',[msgCount]);

  NNTP1.GetArticleHeaders('subject', FirstMessage, lastMessage);

end;

end.

файл smtp.pas

unit Smtp;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,

  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, OleCtrls,

  ISP3;

type

  TMail = class(TForm)

    OpenDialog: TOpenDialog;

    SMTP1: TSMTP;

    POP1: TPOP;

    PageControl1: TPageControl;

    SendPage: TTabSheet;

    RecvPage: TTabSheet;

    ConPage: TTabSheet;

    Panel1: TPanel;

    Label1: TLabel;

    Label3: TLabel;

    Label2: TLabel;

    eTo: TEdit;

    eCC: TEdit;

    eSubject: TEdit;

    SendBtn: TButton;

    ClearBtn: TButton;

    reMessageText: TRichEdit;

    SMTPStatus: TStatusBar;

    Panel3: TPanel;

    mReadMessage: TMemo;

    POPStatus: TStatusBar;

    cbSendFile: TCheckBox;

    GroupBox1: TGroupBox;

    ePOPServer: TEdit;

    Label6: TLabel;

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