|
Проектирование и разработка сетевых броузеров на основе теоретико-графовых моделейуправления 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; |
|
