46231 (Проектирование и разработка сетевых броузеров на основе теоретико-графовых моделей), страница 3

with FileList do

begin

SmallImages := TImageList.CreateSize(16,16);

SmallImages.ShareImages := True;

SmallImages.Handle := ShGetFileInfo('*.*', 0, SHFileInfo,

SizeOf(SHFileInfo), SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX);

LargeImages := TImageList.Create(nil);

LargeImages.ShareImages := True;

LargeImages.Handle := ShGetFileInfo('*.*', 0, SHFileInfo,

SizeOf(SHFileInfo), SHGFI_LARGEICON or SHGFI_ICON or SHGFI_SYSICONINDEX);

end;

end;

procedure TMyFtp.FTPBusy(Sender: TObject; isBusy: Wordbool);

begin

if isBusy then

begin

Screen.Cursor := crHourGlass;

FileList.Items.BeginUpdate;

FileList.Items.Clear;

end

else

begin

Screen.Cursor := crDefault;

FileList.Items.EndUpdate;

end;

end;

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

begin

if Node = Root then

Result := '.'

else

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

end;

procedure TMyFtp.DirTreeChange(Sender: TObject; Node: TTreeNode);

var

NP: String;

begin

if (FTP.State <> prcConnected) or FTP.Busy then exit;

if Node <> nil then

begin

NP := NodePath(DirTree.Selected);

FTP.List(NP);

Label2.Caption := Format('Contents of: ''%s/''',[NP]);

end;

end;

procedure TMyFtp.RefreshBtnClick(Sender: TObject);

begin

FTP.List(NodePath(DirTree.Selected));

end;

procedure TMyFtp.DirTreeChanging(Sender: TObject; Node: TTreeNode;

var AllowChange: Boolean);

begin

AllowChange := not FTP.Busy;

end;

procedure TMyFtp.FTPStateChanged(Sender: TObject; State: Smallint);

begin

with FTP, Statusbar.Panels[0] do

case State of

prcConnecting : Text := 'Connecting';

prcResolvingHost: Text := 'Connecting';

prcHostResolved : Text := 'Host resolved';

prcConnected :

begin

Text := 'Connected to: ' + RemoteHost;

ConnectBtn.Hint := 'Disconnect';

FileNewItem.Enabled := True;

ViewLargeItem.Enabled := True;

ViewSmallItem.Enabled := True;

ViewListItem.Enabled := True;

ViewDetailsItem.Enabled := True;

ViewRefreshItem.Enabled := True;

ToolsDisconnectItem.Enabled := True;

LargeBtn.Enabled := True;

SmallBtn.Enabled := True;

ListBtn.Enabled := True;

DetailsBtn.Enabled := True;

RefreshBtn.Enabled := True;

end;

prcDisconnecting: Text := 'Disconnecting';

prcDisconnected :

begin

Text := 'Disconnected';

ConnectBtn.Hint := 'Connect';

DirTree.Items.Clear;

FileNewItem.Enabled := False;

ViewLargeItem.Enabled := False;

ViewSmallItem.Enabled := False;

ViewListItem.Enabled := False;

ViewDetailsItem.Enabled := False;

ViewRefreshItem.Enabled := False;

ToolsDisconnectItem.Enabled := False;

LargeBtn.Enabled := False;

SmallBtn.Enabled := False;

ListBtn.Enabled := False;

DetailsBtn.Enabled := False;

RefreshBtn.Enabled := False;

end;

end;

end;

procedure TMyFtp.Open1Click(Sender: TObject);

begin

FTP.Quit;

DirTree.Items.BeginUpdate;

try

DirTree.Items.Clear;

finally

DirTree.Items.EndUpdate;

end;

end;

procedure TMyFtp.FileExitItemClick(Sender: TObject);

begin

Close;

end;

procedure TMyFtp.FormResize(Sender: TObject);

begin

Statusbar.Panels[0].Width := Width - 150;

end;

procedure TMyFtp.ViewLargeItemClick(Sender: TObject);

begin

FileList.ViewStyle := vsIcon;

end;

procedure TMyFtp.ViewSmallItemClick(Sender: TObject);

begin

FileList.ViewStyle := vsSmallIcon;

end;

procedure TMyFtp.ViewListItemClick(Sender: TObject);

begin

FileList.ViewStyle := vsList;

end;

procedure TMyFtp.ViewDetailsItemClick(Sender: TObject);

begin

FileList.ViewStyle := vsReport;

end;

procedure TMyFtp.ViewRefreshItemClick(Sender: TObject);

begin

DirTreeChange(nil, DirTree.Selected);

end;

procedure TMyFtp.CopyItemClick(Sender: TObject);

begin

SaveDialog1.FileName := FileList.Selected.Caption;

if SaveDialog1.Execute then

FTP.GetFile(NodePath(DirTree.Selected) + '/' + FileList.Selected.Caption,

SaveDialog1.FileName);

end;

procedure TMyFtp.ToolsDisconnectItemClick(Sender: TObject);

begin

DisConnect;

end;

procedure TMyFtp.FileNewItemClick(Sender: TObject);

var

DirName: String;

begin

if InputQuery('Input Box', 'Prompt', DirName) then

FTP.CreateDir(NodePath(DirTree.Selected) + '/' + DirName);

end;

procedure TMyFtp.DeleteItemClick(Sender: TObject);

begin

if ActiveControl = DirTree then

FTP.DeleteDir(NodePath(DirTree.Selected));

if ActiveControl = FileList then

FTP.DeleteFile(NodePath(DirTree.Selected) + '/' + FileList.Selected.Caption);

end;

procedure TMyFtp.PasteFromItemClick(Sender: TObject);

begin

if OpenDialog1.Execute then

FTP.PutFile(OpenDialog1.FileName, NodePath(DirTree.Selected));

end;

procedure TMyFtp.FilePopupPopup(Sender: TObject);

begin

CopyItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

PasteFromItem.Enabled := (ActiveControl = DirTree) and (DirTree.Selected <> nil);

DeleteItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

RenameItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

end;

procedure TMyFtp.FileMenuClick(Sender: TObject);

begin

FileCopyItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

FileDeleteItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

FileRenameItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);

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);