Проектирование и разработка сетевых броузеров на основе теоретико-графовых моделей

управления ActiveX, встроенными в упаковщики компонентов Delphi. Ниже

приведены компоненты управления Internet ActiveX в порядке их расположения

на экране.

FTP (Internet File Transfer Protocol). Пересылает файлы и данные между

локальным компьютером и клиентом.

HTML (Hypertext Markup Language). Поддерживает просмотр документов

формата HTML. Также может использоваться для синтаксического анализа команд

HTML.

HTTP (Hypretext Transport Protocol). Извлекает документы в формате HTTP

без предварительного просмотра и возможности обработки изображений.

NNTP (Network News Transport Protocol). Поддерживает чтение и отправку

новостей.

POP (Post Office Protocol). Поддерживает почтовую службу UNIX или других

серверов, соответствующих стандарту POP3.

SMTP (Simple Mail Transfer Protocol). Обеспечивает доступ к почтовым

сервером SMTP.

TCP (Transmission Control Protocol). Поддерживает протокол TCP для

приложений класса клиент/сервер.

Приложения Delphi для Internet

Для формирования средств доступа к HTML – документам через Internet

достаточно поместить компонент HTML в экранную форму и создать процедуру

обработки события, которая будет вызывать метод RequestDoc этого

компонента, как показано ниже :

HTML1.RequestDoc(URLs.text);

Предполагается, что параметр URLs является объектом ComboBox или каким-

то другим компонентом, имеющим свойство text. Из указанного диапазона

объектов параметру URL может быть назначен любой объект. Компоненту

RequestDoc можно передать и параметр-строку :

HTML1.RequestDoc(‘www.inprise.com’);

Объекты компонента HTML весьма полезны для получения доступа к исходным

текстовым данным HTML – документов. С этой целью нужно связаться с узлом,

вызвав метод компонента RequestDoc. В результате будет получен доступ к

свойству SourceText HTML – документа, которое представляет собой построчный

список с «сырым» текстом документа. Предлагаемый вместе с Delphi

демонстрационный Web – броузер использует свойство SourceText для того,

чтобы показать в окне исходный HTML – документ, добавляя при этом текст в

окно редактора Memo. Можно использовать такое выражение :

Memo1.Lines.Clear;

Memo1.Lines.Add (HTML1.SourceText);

Есть два события компонента HTML, очень полезных для определения

моментов начала и окончания поиска и выбора документа. Сначала нужно

выбрать объект HTML и щелкнуть на вкладке Events окна Object Inspector.

Затем нужно дважды щелкнуть в строках событий OnBeginRetrieval и

OnEndRetrieval, чтобы Delphi сформировала заготовки процедур обработки

каждого из них.

4.Программная реализация

4.1.Архитектура системы “Броузер”

Модель броузера, представленная в данной дипломной работе, предоставляет

следующие возможности:

- Загрузка Web-страниц;

- Операции по отправке и получению почты;

- Обмен файлами по протоколу FTP;

- Возможность обмена символьной информацией между двумя удаленными

компьютерами, на которых должен быть запущен данный броузер.

Броузер написан на языке Borland Delphi 3.0.

Рис.7. Панель демонстрационного броузера.

4.2.Основные процедуры броузера

WWW-сервис:

procedure TMainForm.Exit1Click – осуществляет выход из программы;

procedure TMainForm.FindAddress – запрашивает HTML-файл по указанному

адресу;

procedure TMainForm.DocumentSource1Click – выводит исходный текст

полученного HTML-файла;

procedure TMainForm.StopBtnClick – останавливает загрузку HTML-файла;

procedure TMainForm.RefreshBtnClick – перегружает последний полученный

HTML-файл;

procedure TMainForm.BackBtnClick – вызывает предыдущий загруженный HTML-

файл;

procedure TMainForm.ForwardBtnClick – вызывает последующий загруженный

HTML-файл;

procedure TMainForm.ToolButton2Click – загружает объект TMail,

ответственный за отправку и получение почты;

procedure TMainForm.ToolButton3Click – загружает объект TMyFtp,

ответственный за обмен данных в протоколе FTP;

procedure TMainForm.ToolButton4Click – загружает объект TNewsForm,

ответственный за получение и отправку новостей;

procedure TMainForm.ToolButton9Click – загружает объект TChatForm,

ответственный за обмен символьной информацией между двумя удаленными

компьютерами;

FTP-сервис:

procedure TMyFtp.ConnectBtnClick – соединяется с указанным FTP-сервером;

procedure TMyFtp.Disconnect – обрывает соединение с FTP-сервером;

procedure TMyFtp.CopyItemClick – выполняет копирование выбранного

файла с FTP-сервера;

procedure TMyFtp.PasteFromItemClick – отсылает файл на FTP-сервер;

Chat-сервис:

procedure TChatForm.FileConnectItemClick – выполняет запрос адреса

компьютера, с которым будет происходить обмен символльной информацией;

procedure TChatForm.Memo1KeyDown – считывание символа с клавиатуры

и отправка его в сокет клиента;

procedure TChatForm.Disconnect1Click – разрывает соединение с

удаленным компьютером;

procedure TChatForm.ClientSocketRead – считывание информации с

удаленного компьютера;

News-сервис:

procedure TNewsForm.FileConnectItemClick – выполняет соединение с

сервером новостей;

procedure TNewsForm.FileDisconnectItemClick – разрывает соединение с

сервером новостей;

procedure TNewsForm.NNTP1DocOutput – вывод групп новостей;

Mail-сервис:

procedure TMail.CreateHeaders – создает заголовок для почтового

сообщения;

procedure TMail.SendMessage – отправляет сообщение;

procedure TMail.SendFile – отправляет файл, “привязанный” к письму;

procedure TMail.SMTP1DocInput – ввод текста почтового сообщения;

procedure TMail.SMTPConnectBtnClick – выполняет соединение с

почтовывм сервером;

4.3.Архитектура имитационной модели глобальной сети

Имитационная модель глобальной корпоративной сети имитирует пересылку

пакета от одного компьютера к другому. При запуске программы на экране

возникает схема сети, показанная на рисунке 8. Затем, при нажатии клавиши

ENTER, программа переходит в текстовый режим с UNIX-подобным интерфейсом,

запрашивая пользователя адрес получателя, адрес отправителя, и данные типа

“String”.

Затем каждый компьютер или маршрутизатор, по которому проходит пакет,

выводит на экран сообщение о приеме и дальнейшей отправке пакета адресату и

время, в которое он получил и отправил пакет. Оптимальный маршрут

рассчитывается на основе усовершенствованного алгоритма Форда-Беллмана.

Программа написана на языке Object Pascal 7.0.

Рис.8. Схема глобальной корпоративной сети.

4.4.Основные процедуры имитационной модели

Типы данных и переменные основной подпрограммы:

const AdjacencyMatrix : array[1..VertexQuantity,1..VertexQuantity] of byte

=(

(0,1,0,1,0,0,0),

(1,1,1,0,1,0,1),

(0,1,0,1,0,0,0),

(1,0,1,0,1,0,0),

(0,1,0,0,1,1,0),

(0,0,0,0,1,0,1),

(0,1,0,0,0,1,0) ) – матрица смежности

маршрутизаторов;

TYPE TAddr = record

router:byte;

domain:byte;

comp :byte;

END - адрес компьютера, состоящий из номера маршрутизатора, номера области

данного маршрутизатора и номера компьютера в этой области;

TYPE TBatch = record

from:TAddr;

to_ :TAddr;

data:string;

path:array[1..20] of byte; {path is chain of router numbers}

END – пакет, состоящий из адреса отправителя, адреса получателя, данных и

пути следования пакета;

TYPE TComp = object - модель компьютера, состоящая из адреса, ячейки памяти

для

получения или пересылки пакета;

addr:TAddr;

mem :TBatch;

Procedure Send2Router(batch:TBatch) – процедура посылки пакета на

маршрутизатор;

Procedure Send(batch:TBatch) – процедура посылки пакета внутри своей сети;

Procedure Receive(batch:TBatch;byRouter:boolean) – прием пакета;

END;

TYPE TRouter = object - модель маршрутизатора, состоящая из номера

маршрутизатора,

его координат, и ячейки памяти;

num :byte;

x,y :integer;

memory :Tbatch;

state :boolean;

VAR computers : array[1..38] of TComp - массив компьютеров глобальной

сети;

routers : array[1..7] of TRouter – массив маршрутизаторов;

OptimalPath : array[1..49] of byte – оптимальный путь, рассчитанный

маршрутизатором;

Procedure Receive(routerNum:byte;batch:TBatch) – прием пакета;

Procedure Send2Comp(batch:TBatch) – отправка пакета в своей сети;

Procedure CalcMinPath(sender,target:byte) – вычисление оптимального пути

отправки;

Procedure Send2NextRouter(batch:TBatch;currentRouter:byte) – отправка на

следующий

маршрутизатор;

END;

Заключение

В данной дипломной работе был получен следующий результат :

1.) Разработана модель сетевого броузера и корпоративной среды;

2.) Создана имитационная модель распределения информации в глобальных

сетях.

3.) Написано соответствующее программное обеспечение – сетевой броузер с

возможностью доступа как к WWW- протоколу, так и к сервису FTP, почтовому

сервису SMTP, а также возможностью обмена символьной информацией между

двумя компьютерами в ON-LINE режиме – CHAT и математическая модель

корпоративной сети, имитирующая передачу информации в глобальной среде, в

которой реализован разработанный усовершенствованный алгоритм поиска

оптимального пути между маршрутизаторами.

Список литературы :

1. Блэк Ю. Сети ЭВМ: протоколы, стандарты, интерфейсы. М.:Мир,1990. –506

с.

2. Донской В.И. Компьютерные сети и сетевые технологии.- Симферополь:

Таврида,1999. – 135 с.

3. Калверт Ч. Delphi 4. Самоучитель. – К.: ДиаСофт, 1999. – 192 с.

4. Крамлиш К. Азбука Internet. К.:Юниор, 1998. –336 с.

5. Нанс Б. Компьютерные сети. М.:Бином, 1996. –400 с.

6. Нотон П., Шилдт Г. Полный справочник по Java. – К.: Диалектика,1997.

–450 с.

7. Сван Т. Delphi 4 – “Библия” разработчика. –К.: Диалектика,1998. –500

с.

8. Яблонский С.В. Введение в дискретную математику. –М.: Наука,1986.

–384 с.

9. Журнал «Компьютерное Обозрение», N36 (109) ‘97, N44 (117) ‘97

Приложение 1. Исходный текст программы “броузер”

файл main.pas

unit Main;

interface

uses

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

Dialogs,

StdCtrls, ExtCtrls, Menus, ComCtrls, OleCtrls, Buttons, ToolWin, Isp3;

const

CM_HOMEPAGEREQUEST = WM_USER + $1000;

type

TMainForm = class(TForm)

StatusBar1: TStatusBar;

MainMenu1: TMainMenu;

File1: TMenuItem;

Exit1: TMenuItem;

View1: TMenuItem;

DocumentSource1: TMenuItem;

NavigatorImages: TImageList;

NavigatorHotImages: TImageList;

LinksImages: TImageList;

LinksHotImages: TImageList;

CoolBar1: TCoolBar;

ToolBar1: TToolBar;

BackBtn: TToolButton;

ForwardBtn: TToolButton;

StopBtn: TToolButton;

RefreshBtn: TToolButton;

URLs: TComboBox;

HTML1: THTML;

Help1: TMenuItem;

About1: TMenuItem;

N1: TMenuItem;

Toolbar3: TMenuItem;

Statusbar2: TMenuItem;

ToolButton1: TToolButton;

ToolButton2: TToolButton;

ToolButton3: TToolButton;

ToolButton4: TToolButton;

ToolButton9: TToolButton;

SpeedButton1: TSpeedButton;

Animate1: TAnimate;

procedure Exit1Click(Sender: TObject);

procedure About1Click(Sender: TObject);

procedure DocumentSource1Click(Sender: TObject);

procedure StopBtnClick(Sender: TObject);

procedure HTML1BeginRetrieval(Sender: TObject);

procedure HTML1EndRetrieval(Sender: TObject);

procedure URLsKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure FormCreate(Sender: TObject);

procedure LinksClick(Sender: TObject);

procedure RefreshBtnClick(Sender: TObject);

procedure BackBtnClick(Sender: TObject);

procedure ForwardBtnClick(Sender: TObject);

procedure HTML1DoRequestDoc(Sender: TObject; const URL: WideString;

const Element: HTMLElement; const DocInput: DocInput;

var EnableDefault: WordBool);

procedure FormDestroy(Sender: TObject);

procedure URLsClick(Sender: TObject);

procedure FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure Toolbar3Click(Sender: TObject);

procedure Statusbar2Click(Sender: TObject);

procedure ToolButton2Click(Sender: TObject);

procedure ToolButton3Click(Sender: TObject);

procedure ToolButton4Click(Sender: TObject);

procedure ToolButton9Click(Sender: TObject);

private

HistoryIndex: Integer;

HistoryList: TStringList;

UpdateCombo: Boolean;

procedure FindAddress;

procedure HomePageRequest(var message: tmessage); message

CM_HOMEPAGEREQUEST;

end;

var

MainForm: TMainForm;

implementation

uses DocSrc, About, SMTP, FTP, NNTP, CHAT;

{$R *.DFM}

procedure TMainForm.Exit1Click(Sender: TObject);

begin

Close;

end;

procedure TMainForm.FindAddress;

begin

HTML1.RequestDoc(URLs.Text);

end;

procedure TMainForm.About1Click(Sender: TObject);

begin

ShowAboutBox;

end;

procedure TMainForm.DocumentSource1Click(Sender: TObject);

begin

with DocSourceFrm do

begin

Show;

Memo1.Lines.Clear;

Memo1.Lines.Add(AdjustLineBreaks(HTML1.SourceText));

Memo1.SelStart := 0;

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

end;

end;

procedure TMainForm.StopBtnClick(Sender: TObject);

begin

HTML1.Cancel('Cancel');

HTML1EndRetrieval(nil);

end;

procedure TMainForm.HTML1BeginRetrieval(Sender: TObject);

begin

{ Turn the stop button dark red }

StopBtn.ImageIndex := 4;

{ Play the avi from the first frame indefinitely }

Animate1.Active := True;

end;

procedure TMainForm.HTML1EndRetrieval(Sender: TObject);

begin

{ Turn the stop button grey }

StopBtn.ImageIndex := 2;

{ Stop the avi and show the first frame }

Animate1.Active := False;

end;

procedure TMainForm.URLsKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Key = VK_Return then

begin

UpdateCombo := True;

FindAddress;

end;

end;

procedure TMainForm.URLsClick(Sender: TObject);

begin

UpdateCombo := True;

FindAddress;

end;

procedure TMainForm.LinksClick(Sender: TObject);

begin

if (Sender as TToolButton).Hint = '' then Exit;

URLs.Text := (Sender as TToolButton).Hint;

FindAddress;

end;

procedure TMainForm.RefreshBtnClick(Sender: TObject);

begin

FindAddress;

end;

procedure TMainForm.BackBtnClick(Sender: TObject);

begin

URLs.Text := HistoryList[HistoryIndex - 1];

FindAddress;

end;

procedure TMainForm.ForwardBtnClick(Sender: TObject);

begin

URLs.Text := HistoryList[HistoryIndex + 1];

FindAddress;

end;

procedure TMainForm.HTML1DoRequestDoc(Sender: TObject;

const URL: WideString; const Element: HTMLElement;

const DocInput: DocInput; var EnableDefault: WordBool);

var

NewIndex: Integer;

begin

NewIndex := HistoryList.IndexOf(URL);

if NewIndex = -1 then

begin

{ Remove entries in HistoryList between last address and current

address }

if (HistoryIndex >= 0) and (HistoryIndex < HistoryList.Count - 1)

then

while HistoryList.Count > HistoryIndex do

HistoryList.Delete(HistoryIndex);

HistoryIndex := HistoryList.Add(URL);

end

else

HistoryIndex := NewIndex;

if HistoryList.Count > 0 then

begin

ForwardBtn.Enabled := HistoryIndex < HistoryList.Count - 1;

BackBtn.Enabled := HistoryIndex > 0;

end

else

begin

ForwardBtn.Enabled := False;

BackBtn.Enabled := False;

end;

if UpdateCombo then

begin

UpdateCombo := False;

NewIndex := URLs.Items.IndexOf(URL);

if NewIndex = -1 then

URLs.Items.Insert(0, URL)

else

URLs.Items.Move(NewIndex, 0);

end;

URLs.Text := URL;

Statusbar1.Panels[0].Text := URL;

end;

procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Shift = [ssAlt] then

if (Key = VK_RIGHT) and ForwardBtn.Enabled then

ForwardBtn.Click

else if (Key = VK_LEFT) and BackBtn.Enabled then

BackBtn.Click;

end;

procedure TMainForm.Toolbar3Click(Sender: TObject);

begin

with Sender as TMenuItem do

begin

Checked := not Checked;

Coolbar1.Visible := Checked;

end;

end;

procedure TMainForm.Statusbar2Click(Sender: TObject);

begin

with Sender as TMenuItem do

begin

Checked := not Checked;

StatusBar1.Visible := Checked;

end;

end;

procedure TMainForm.HomePageRequest(var Message: TMessage);

begin

URLs.Text := 'http://www.altavista.com';

UpdateCombo := True;

FindAddress;

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

HistoryIndex := -1;

HistoryList := TStringList.Create;

{ Load the animation from the AVI file in the startup directory. An

alternative to this would be to create a .RES file including the

cool.avi

as an AVI resource and use the ResName or ResId properties of

Animate1 to

point to it. }

Animate1.FileName := ExtractFilePath(Application.ExeName) +

'cool.avi';

{ Find the home page - needs to be posted because HTML control hasn't

been

registered yet. }

PostMessage(Handle, CM_HOMEPAGEREQUEST, 0, 0);

end;

procedure TMainForm.FormDestroy(Sender: TObject);

begin

HistoryList.Free;

end;

procedure TMainForm.ToolButton2Click(Sender: TObject);

begin

TMail.create(Application).showmodal;

end;

procedure TMainForm.ToolButton3Click(Sender: TObject);

begin

TMyFtp.create(Application).showmodal;

end;

procedure TMainForm.ToolButton4Click(Sender: TObject);

begin

TNewsForm.create(Application).showmodal;

end;

procedure TMainForm.ToolButton9Click(Sender: TObject);

begin

TChatForm.create(Application).showmodal;

end;

end.

файл chat.pas

unit chat;

interface

uses

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

Dialogs,

Menus, StdCtrls, Buttons, ScktComp, ExtCtrls, ComCtrls;

type

TChatForm = class(TForm)

MainMenu1: TMainMenu;

File1: TMenuItem;

Exit1: TMenuItem;

FileConnectItem: TMenuItem;

FileListenItem: TMenuItem;

StatusBar1: TStatusBar;

Bevel1: TBevel;

Panel1: TPanel;

Memo1: TMemo;

Memo2: TMemo;

N1: TMenuItem;

SpeedButton1: TSpeedButton;

Disconnect1: TMenuItem;

ServerSocket: TServerSocket;

ClientSocket: TClientSocket;

procedure FileListenItemClick(Sender: TObject);

procedure FileConnectItemClick(Sender: TObject);

procedure Exit1Click(Sender: TObject);

procedure Memo1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure FormCreate(Sender: TObject);

procedure ServerSocketError(Sender: TObject; Number: Smallint;

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

HelpFile: string; HelpContext: Integer; var CancelDisplay:

Wordbool);

procedure Disconnect1Click(Sender: TObject);

procedure ClientSocketConnect(Sender: TObject;

Socket: TCustomWinSocket);

procedure ClientSocketRead(Sender: TObject; Socket:

TCustomWinSocket);

procedure ServerSocketClientRead(Sender: TObject;

Socket: TCustomWinSocket);

procedure ServerSocketAccept(Sender: TObject;

Socket: TCustomWinSocket);

procedure ServerSocketClientConnect(Sender: TObject;

Socket: TCustomWinSocket);

procedure ClientSocketDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

procedure ClientSocketError(Sender: TObject; Socket:

TCustomWinSocket;

ErrorEvent: TErrorEvent; var ErrorCode: Integer);

procedure ServerSocketClientDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

protected

IsServer: Boolean;

end;

var

ChatForm: TChatForm;

Server: String;

implementation

{$R *.DFM}

procedure TChatForm.FileListenItemClick(Sender: TObject);

begin

FileListenItem.Checked := not FileListenItem.Checked;

if FileListenItem.Checked then

begin

ClientSocket.Active := False;

ServerSocket.Active := True;

Statusbar1.Panels[0].Text := 'Listening...'

end

else

begin

if ServerSocket.Active then

ServerSocket.Active := False;

Statusbar1.Panels[0].Text := '';

end;

end;

procedure TChatForm.FileConnectItemClick(Sender: TObject);

begin

if ClientSocket.Active then ClientSocket.Active := False;

if InputQuery('Computer to connect to', 'Address Name:', Server) then

if Length(Server) > 0 then

with ClientSocket do

begin

Host := Server;

Active := True;

end;

end;

procedure TChatForm.Exit1Click(Sender: TObject);

begin

ServerSocket.Close;

ClientSocket.Close;

Close;

end;

procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Key = VK_Return then

if IsServer then

ServerSocket.Socket.Connections[0].SendText(Memo1.Lines[Memo1.Lines.Count -

1])

else

ClientSocket.Socket.SendText(Memo1.Lines[Memo1.Lines.Count - 1]);

end;

procedure TChatForm.FormCreate(Sender: TObject);

begin

FileListenItemClick(nil);

end;

procedure TChatForm.ServerSocketError(Sender: TObject; Number: Smallint;

var Description: string; Scode: Integer; const Source, HelpFile:

string;

HelpContext: Integer; var CancelDisplay: Wordbool);

begin

ShowMessage(Description);

end;

procedure TChatForm.Disconnect1Click(Sender: TObject);

begin

ClientSocket.Close;

FileListenItemClick(nil);

end;

procedure TChatForm.ClientSocketConnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteHost;

end;

procedure TChatForm.ClientSocketRead(Sender: TObject;

Socket: TCustomWinSocket);

begin

Memo2.Lines.Add(Socket.ReceiveText);

end;

procedure TChatForm.ServerSocketClientRead(Sender: TObject;

Socket: TCustomWinSocket);

begin

Memo2.Lines.Add(Socket.ReceiveText);

end;

procedure TChatForm.ServerSocketAccept(Sender: TObject;

Socket: TCustomWinSocket);

begin

IsServer := True;

Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteAddress;

end;

procedure TChatForm.ServerSocketClientConnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

Memo2.Lines.Clear;

end;

procedure TChatForm.ClientSocketDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

FileListenItemClick(nil);

end;

procedure TChatForm.ClientSocketError(Sender: TObject;

Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;

var ErrorCode: Integer);

begin

Memo2.Lines.Add('Error connecting to : ' + Server);

ErrorCode := 0;

end;

procedure TChatForm.ServerSocketClientDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

ServerSocket.Active := False;

FileListenItem.Checked := not FileListenItem.Checked;

FileListenItemClick(nil);

end;

end.

файл ftp.pas

unit ftp;

interface

uses

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

Dialogs,

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

const

FTPServer = 0;

Folder = 1;

OpenFolder = 2;

type

TMyFtp = class(TForm)

Bevel1: TBevel;

Panel1: TPanel;

Panel2: TPanel;

Panel3: TPanel;

StatusBar: TStatusBar;

FileList: TListView;

DirTree: TTreeView;

ConnectBtn: TSpeedButton;

FTP: TFTP;

RefreshBtn: TSpeedButton;

MainMenu1: TMainMenu;

FileMenu: TMenuItem;

FileNewItem: TMenuItem;

FileDeleteItem: TMenuItem;

FileRenameItem: TMenuItem;

N2: TMenuItem;

FileExitItem: TMenuItem;

View1: TMenuItem;

ViewLargeItem: TMenuItem;

ViewSmallItem: TMenuItem;

ViewListItem: TMenuItem;

ViewDetailsItem: TMenuItem;

N1: TMenuItem;

ViewRefreshItem: TMenuItem;

FilePopup: TPopupMenu;

DeleteItem: TMenuItem;

RenameItem: TMenuItem;

CopyItem: TMenuItem;

Bevel2: TBevel;

Label1: TLabel;

Bevel3: TBevel;

Bevel5: TBevel;

Label2: TLabel;

SaveDialog1: TSaveDialog;

CopyButton: TSpeedButton;

LargeBtn: TSpeedButton;

SmallBtn: TSpeedButton;

ListBtn: TSpeedButton;

DetailsBtn: TSpeedButton;

Tools1: TMenuItem;

ToolsConnectItem: TMenuItem;

ToolsDisconnectItem: TMenuItem;

FileCopyItem: TMenuItem;

PasteFromItem: TMenuItem;

OpenDialog1: TOpenDialog;

SmallImages: TImageList;

procedure ConnectBtnClick(Sender: TObject);

procedure FTPProtocolStateChanged(Sender: TObject;

ProtocolState: Smallint);

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

procedure FormCreate(Sender: TObject);

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

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

procedure RefreshBtnClick(Sender: TObject);

procedure DirTreeChanging(Sender: TObject; Node: TTreeNode;

var AllowChange: Boolean);

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

procedure Open1Click(Sender: TObject);

procedure FileExitItemClick(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure ViewLargeItemClick(Sender: TObject);

procedure ViewSmallItemClick(Sender: TObject);

procedure ViewListItemClick(Sender: TObject);

procedure ViewDetailsItemClick(Sender: TObject);

procedure ViewRefreshItemClick(Sender: TObject);

procedure CopyItemClick(Sender: TObject);

procedure ToolsDisconnectItemClick(Sender: TObject);

procedure FileNewItemClick(Sender: TObject);

procedure DeleteItemClick(Sender: TObject);

procedure PasteFromItemClick(Sender: TObject);

procedure FilePopupPopup(Sender: TObject);

procedure FileMenuClick(Sender: TObject);

procedure FileDeleteItemClick(Sender: TObject);

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

private

Root: TTreeNode;

function CreateItem(const FileName, Attributes, Size, Date:

Variant): TListItem;

procedure Disconnect;

public

function NodePath(Node: TTreeNode): String;

end;

var

Myftp: TMyFtp;

UserName,

Pwd: String;

implementation

{$R *.DFM}

uses ShellAPI, UsrInfo;

function FixCase(Path: String): String;

var

OrdValue: byte;

begin

if Length(Path) = 0 then exit;

OrdValue := Ord(Path[1]);

if (OrdValue >= Ord('a')) and (OrdValue 0 then

begin

if Size div 1024 <> 0 then

begin

SubItems.Add(IntToStr(Size div 1024));

SubItems[0] := SubItems[0] + 'KB';

end

else

SubItems.Add(Size);

end

else

SubItems.Add('');

if Attributes = '1' then

begin

SubItems.Add('File Folder');

ImageIndex := 3;

end

else

begin

Ext := ExtractFileExt(FileName);

ShGetFileInfo(PChar('c:\*' + Ext), 0, SHFileInfo,

SizeOf(SHFileInfo),

SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_TYPENAME);

if Length(SHFileInfo.szTypeName) = 0 then

begin

if Length(Ext) > 0 then

begin

System.Delete(Ext, 1, 1);

SubItems.Add(Ext + ' File');

end

else

SubItems.Add('File');

end

else

SubItems.Add(SHFileInfo.szTypeName);

ImageIndex := SHFileInfo.iIcon;

end;

SubItems.Add(Date);

end;

end;

procedure TMyFtp.Disconnect;

begin

FTP.Quit;

Application.ProcessMessages;

end;

procedure TMyFtp.FormCreate(Sender: TObject);

var

SHFileInfo: TSHFileInfo;

begin

with DirTree do

begin

DirTree.Images := SmallImages;

SmallImages.ResourceLoad(rtBitmap, 'IMAGES', clOlive);

end;

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;

Страницы: 1, 2, 3, 4, 5