end;

procedure TMyFtp.FileDeleteItemClick(Sender: TObject);

begin

  if (DirTree.Selected <> nil) and (FileList.Selected <> nil) then

    FTP.DeleteFile(FileList.Selected.Caption);

end;

procedure TMyFtp.FTPListItem(Sender: TObject; const Item: FTPDirItem);

var

  Node: TTreeNode;

begin

  CreateItem(Item.FileName, Item.Attributes, Item.Size, Item.Date);

  if Item.Attributes = 1 then

    if DirTree.Selected <> nil then

     begin

       if DirTree.Selected <> nil then

         Node := DirTree.Selected.GetFirstChild

       else

         Node := nil;

       while Node <> nil do

         if AnsiCompareFileName(Node.Text, Item.FileName) = 0 then

           exit

         else

           Node := DirTree.Selected.GetNextChild(Node);

       if Node = nil then

       begin

         Node := DirTree.Items.AddChild(DirTree.Selected,

           Item.FileName);

         Node.ImageIndex := Folder;

         Node.SelectedIndex := OpenFolder;

       end;

     end

     else

       DirTree.Items.AddChild(Root, Item.FileName);

end;

end.

файл nntp.pas

unit nntp;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  Menus, OleCtrls, StdCtrls, ComCtrls, ExtCtrls, Buttons, ActiveX, isp3;

const

  efListGroups = 0;

  efGetArticleHeaders = 1;

  efGetArticleNumbers = 2;

  efGetArticle = 3;

type

  TNewsForm = class(TForm)

    NNTP1: TNNTP;

    MainMenu1: TMainMenu;

    File1: TMenuItem;

    Exit1: TMenuItem;

    N1: TMenuItem;

    FileDisconnectItem: TMenuItem;

    FileConnectItem: TMenuItem;

    Panel1: TPanel;

    Bevel1: TBevel;

    StatusBar: TStatusBar;

    SmallImages: TImageList;

    Panel2: TPanel;

    NewsGroups: TTreeView;

    Bevel2: TBevel;

    Panel3: TPanel;

    Memo1: TMemo;

    Panel5: TPanel;

    Panel4: TPanel;

    ConnectBtn: TSpeedButton;

    RefreshBtn: TSpeedButton;

    Bevel3: TBevel;

    MsgHeaders: TListBox;

    Label1: TLabel;

    Label2: TLabel;

    procedure FileConnectItemClick(Sender: TObject);

    procedure NNTP1ProtocolStateChanged(Sender: TObject;

      ProtocolState: Smallint);

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

    procedure Exit1Click(Sender: TObject);

    procedure MsgHeadersDblClick(Sender: TObject);

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

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

    procedure RefreshBtnClick(Sender: TObject);

    procedure FileDisconnectItemClick(Sender: TObject);

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

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

    procedure NNTP1Error(Sender: TObject; Number: Smallint;

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

      HelpFile: WideString; HelpContext: Integer;

      var CancelDisplay: WordBool);

    procedure NNTP1SelectGroup(Sender: TObject;

      const groupName: WideString; firstMessage, lastMessage,

      msgCount: Integer);

  private

    EventFlag: Integer;

    function NodePath(Node: TTreeNode): String;

  public

    Data: String;

  end;

var

  NewsForm: TNewsForm;

  Remainder: String;

  Nodes: TStringList;

  CurrentGroup: String;

  GroupCount: Integer;

implementation

uses Connect;

{$R *.DFM}

{ TParser }

type

  TToken = (etEnd, etSymbol, etName, etLiteral);

  TParser = class

  private

    FFlags: Integer;

    FText: string;

    FSourcePtr: PChar;

    FSourceLine: Integer;

    FTokenPtr: PChar;

    FTokenString: string;

    FToken: TToken;

    procedure SkipBlanks;

    procedure NextToken;

  public

    constructor Create(const Text: string; Groups: Boolean);

  end;

const

  sfAllowSpaces = 1;

constructor TParser.Create(const Text: string; Groups: Boolean);

begin

  FText := Text;

  FSourceLine := 1;

  FSourcePtr := PChar(Text);

  if Groups then

    FFlags := sfAllowSpaces

  else

    FFlags := 0;

  NextToken;

end;

procedure TParser.SkipBlanks;

begin

  while True do

  begin

    case FSourcePtr^ of

      #0:

        begin

          if FSourcePtr^ = #0 then Exit;

          Continue;

        end;

      #10:

        Inc(FSourceLine);

      #33..#255:

        Exit;

    end;

    Inc(FSourcePtr);

  end;

end;

procedure TParser.NextToken;

var

  P, TokenStart: PChar;

begin

  SkipBlanks;

  FTokenString := '';

  P := FSourcePtr;

  while (P^ <> #0) and (P^ <= ' ') do Inc(P);

  FTokenPtr := P;

  case P^ of

    '0'..'9':

      begin

        TokenStart := P;

        Inc(P);

        while P^ in ['0'..'9'] do Inc(P);

        SetString(FTokenString, TokenStart, P - TokenStart);

        FToken := etLiteral;

      end;

    #13: Inc(FSourceLine);

    #0:

      FToken := etEnd;

  else

    begin

      TokenStart := P;

      Inc(P);

      if FFlags = sfAllowSpaces then

        while not (P^ in [#0, #13, ' ']) do Inc(P)

      else

        while not (P^ in [#0, #13]) do Inc(P);

      SetString(FTokenString, TokenStart, P - TokenStart);

      FToken := etSymbol;

    end;

  end;

  FSourcePtr := P;

end;

function FirstItem(var ItemList: ShortString): ShortString;

var

  P: Integer;

begin

  P := AnsiPos('.', ItemList);

  if P = 0 then

  begin

    Result := ItemList;

    P := Length(ItemList);

  end

  else

    Result := Copy(ItemList, 1, P - 1);

  Delete(ItemList, 1, P);

end;

procedure AddItem(GroupName: ShortString);

var

  Index, i: Integer;

  Groups: Integer;

  Item: ShortString;

  TheNodes: TStringList;

begin

  Groups := 1;

  for i := 0 to Length(GroupName) do

    if GroupName[i] = '.' then

      Inc(Groups);

  TheNodes := Nodes;

  for i := 0 to Groups - 1 do

  begin

    Item := FirstItem(GroupName);

    Index := TheNodes.IndexOf(Item);

    if Index = -1 then

    begin

      Index := TheNodes.AddObject(Item, TStringList.Create);

      TheNodes := TStringList(TheNodes.Objects[Index]);

      TheNodes.Sorted := True;

    end

    else

      TheNodes := TStringList(TheNodes.Objects[Index]);

  end;

  Inc(GroupCount);

end;

procedure ParseGroups(Data: String);

var

  Parser: TParser;

  OldSrcLine: Integer;

begin

  Parser := TParser.Create(Data, True);

  OldSrcLine := 0;

  while Parser.FToken <> etEnd do

  begin

    if Parser.FSourceLine <> OldSrcLine then

    begin

      AddItem(Parser.FTokenString);

      OldSrcLine := Parser.FSourceLine;

    end;

    Parser.NextToken;

  end;

end;

procedure ParseHeaders(Data: String);

var

  Parser: TParser;

  MsgNo: LongInt;

  Header: String;

  OldSrcLine: Integer;

begin

  Parser := TParser.Create(Data, False);

  while Parser.FToken <> etEnd do

  begin

    MsgNo := StrToInt(Parser.FTokenString);

    OldSrcLine := Parser.FSourceLine;

    Parser.NextToken;

    Header := '';

    while (OldSrcLine = Parser.FSourceLine) do

    begin

      Header := Header + ' ' + Parser.FTokenString;

      Parser.NextToken;

      if Parser.FToken = etEnd then

        Break;

    end;

    NewsForm.MsgHeaders.Items.AddObject(Header, Pointer(MsgNo));

  end;

end;

procedure DestroyList(AList: TStringList);

var

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