МІНІСТЕРСТВО ОСВІТИ І НАУКИ УКРАЇНИ
ТАВРІЙСЬКИЙ НАЦІОНАЛЬНИЙ УНІВЕРСИТЕТ ім. В. І. Вернандского
МАТЕМАТИЧНИЙ ФАКУЛЬТЕТ
КАФЕДРА ІНФОРМАТИКИ
ДИПЛОМНА РОБОТА
Проектування та розробка мережевих броузерів на основі теоретико-Графова моделей
Виконав студент 5 курсу
спеціальності «інформатика»
_________________Поляков Т.І.
Науковий керівник, к.ф. - м . н., доцент
___________________Попов В.Б.
Рішення про допуск до захисту:
_________________________
Зав.кафедри інформатики
д.ф.-м.н., професор
________________Донской В.І.
Сімферополь
2000
| Зміст | |
| Вступ | 2 |
| | |
| Глава I. Теоретико-Графова моделі організації мережевих | 3 |
| структур | |
| | |
| 1.1. Основні поняття теорії графів | 3 |
| | |
| 1.2. Графова алгоритми | 5 |
| Глава II. Мережеві структури на базі теоретико-Графова | 11 |
| моделей | |
| 2.1. Методи побудови мережевих структур | 11 |
| 2.2. Класифікація існуючих методів | 12 |
| організації мереж | |
| 2.3. Глобальна мережа Internet | 16 |
| 2.4. Основи мережевої маршрутизації | 20 |
| 2.5. Алгоритми маршрутизації | 24 |
| Глава III. Мережеві броузери | 33 |
| 3.1. Опис стандартного броузера | 33 |
| 3.2. Характеристика існуючих систем пошуку | 33 |
| 3.3. Особливості створення броузерів в | 40 |
| візуальних середовищах | |
| | |
| програмування | |
| | |
| Глава??. Програмна реалізація | 44 |
| | |
| 4.1. Архітектура системи "броузер" | 44 |
| | |
| 4.2. Основні процедури броузера | 45 |
| | |
| 4.3. Архітектура імітаційної моделі глобальної мережі | 47 |
| | |
| 4.4. Основні процедури імітаційної моделі | 48 |
| | |
| Висновок | 50 |
| | |
| Список літератури | 51 |
| | |
| Додаток 1 - вихідний текст програми "броузер" | 52 |
| | |
| Додаток 2 - вихідний текст моделі корпоративної мережі | 91 |
Введення
Актуальність
У зв'язку з розширенням глобальної мережі Internet зростає необхідністьвпровадження нових оптимізаційних алгоритмів, пов'язаних зі швидкістю обмінуданих між комп'ютерами в єдиній мережі. Комп'ютерні мережі завойовують світ.
Системи з маленьких комп'ютерів перетворюються у величезні сховища даних,доступні всьому світу. Будь-яка сучасна фірма, будь-який офіс оснащений хоча бнайпростішою мережею. Не виходячи з дому, сотні тисяч людей працюють наперсональних комп'ютерах, на користь всьому світу. В основному для роботив Internet використовуються програми-броузери. Ці програми дозволяють легкообмінюватися текстової, графічної та звуковою інформацією, використовуючипопулярну, просту в обігу мультемедійную службу ІНТЕРНЕТ World Wide
Web.
Мета
Мета даної роботи полягає в наступному:
- розробка математичної моделі мережевого оглядача і корпоративноїсередовища;
- створення імітаційної моделі розподіл інформації в глобальнихмережах.
Для досягнення даної мети були вирішені наступні завдання:
1.) Проведено аналіз існуючих броузерів;
2.) Розглянуто основні топології існуючих корпоративних мереж;
3.) Розроблено алгоритм визначення оптимального маршруту передачі
інформації по глобальній мережі.
1.Теоретіко - Графова моделі організації мережевих структур
1.1. Основні поняття теорії графів
Визначення. Безліч Х = і набір U невпорядкованих пар об'єктів
() З Х називається графом Г. Об'єкти множини Х називаються вершинамиграфа, а набори об'єкта U - ребрами графа. Про ребра будемо говорити,що вони з'єднують вершини і. У випадку, якщо безліч Х інабір U складаються з кінцевого числа об'єктів і пар, то граф Г називаєтьсякінцевим.
Нехай і - довільні вершини графа Г.
Визначення. Система ребер графа Г називається шляхом, що з'єднує вершини та.
Определеніе.Путь, що не проходить двічі одне ребро, називаєтьсяциклом, якщо =. Зокрема, цикл будемо називати петлею.
Визначення. Граф Г називається зв'язковим, якщо для будь-яких двох різних
вершин і графа Г існує шлях, що з'єднує ці вершини.
Рис. 1
Легко бачити, що граф з прикладу 1 є кінцевим, незв'язних іщо містить петлі.
Визначення. графи Г і Г `називаються ізоморфні, якщо існуєвзаємно однозначна відповідність між їх вершинами і ребрами таке, щовідповідні ребра з'єднують відповідні вершини.
Визначення. Граф Г `називається подграфом Г, якщо його вершини і ребраналежать графу Г.
Завдовжки шляху в графі називають суму довжин що входять в цей шлях ребер.
Визначення. Деревом називається кінцевий зв'язний граф з виділеноювершиною, що іменується коренем, що не містить циклів.
Якщо в графі можна виділити більше одного дерева, які не пов'язні міжсобою, то такий граф називають лісом.
Рис 2. Ліс, що має два компоненти зв'язності (2 дерева).
Будемо далі позначати через Х - безліч вершин і U - безліч реберграфа, а сам граф, який визначається цією парою об'єктів, будемо позначати
;x? X, u? U. Позначимо довжину дуги u = (x, y) через d (u). Найкоротшу довжину шляхуз х в
z позначимо D (x, z).
Очевидно, якщо найкоротший шлях з x в z існує і проходить черезпроміжну вершину w, то D (x, z) = D (x, w) + D (w, z). Ця формуласправедлива для будь-якої проміжної вершини w розглянутого шляхи, у томучислі і для останньої, суміжній з кінцевою вершиною w. Тому найкоротшийшлях можна відшукати, послідовно переходячи від кінцевої вершини z внайближчу суміжну і запам'ятовуючи ланцюжок побудованих вершин (звичайно, заумови, що хоча б один шлях між вершинами x і z існує і граф немістить циклів. Ця ідея і є по суті принципом Р. Беллмана.
1.2. Графова алгоритми
Алгоритм Беллмана пошуку найкоротшого шляху між двома вершинами зв'язковогографа, що не має циклів з невід'ємними довжинами ребер. Його описнаводиться нижче за допомогою алгоритмічної схеми.
Ідентифікатори:
D [w] - робочий масив, при обчисленнях інтерпретується як найкоротшадовжина з вершини w в вершину z. w? X. d [s, t] - масив довжин ребер графа для кожної пари вершин s, t? X. Якщодеяке ребро відсутній, то в елементі цього масиву покладаєтьсязаписаним деякий достатньо велика кількість, що перевищує суму довжин всіхребер графа.
Stack - послідовність вершин, що визначає найкоротший шлях з x вz.
Begin
Stack :='';// Очистити Stack.
Stack 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; < p> 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 < p> SubItems.Add (SHFileInfo.szTypeName);
ImageIndex: = SHFileInfo.iIcon; end;
SubItems.Add (Date); end; end; < p> 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; < p> 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.
Дз п № л ? ркозтфрCх; уАчх (и, хXюKхеюИф @ ьuу ('fфяьюМ ‡
1EF
№
юЕьsхmу0хттиьшфайл 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; < p> 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 ^ 0 then
SMTPStatus.SimpleText: = Format ( 'Sending data:% d of% d bytes
(% d %%)',
[Trunc (DocInput.BytesTransferred), Trunc (DocInput.BytesTotal),
Trunc (DocInput.BytesTransferred/DocInput.BytesTotal * 100)] ) else
SMTPStatus.SimpleText: = 'Sending ...'; icDocEnd: if SMTPError then
SMTPStatus.SimpleText: =' Transfer aborted 'else
SMTPStatus.SimpleText: = Format ( 'Mail sent to% s (% d bytesdata) ', [eTo.Text,
Trunc (DocInput.BytesTransferred)]); end;
SMTPStatus.Update; end;
(The Error event is called whenever an error occurs in the backgroundprocessing. In addition to providing an error code and brief description, you can alsoaccess the SMTP component's Errors property (of type icErrors, an OLE object) to getmore detailed information) procedure TMail.SMTP1Error (Sender: TObject; Number: Smallint; var Description: WideString; Scode: Integer; const Source,
HelpFile: WideString; HelpContext: Integer; var CancelDisplay:
WordBool); var
I: Integer;
ErrorStr: string; begin
SMTPError: = True;
CancelDisplay: = True ;
(Get extended error information) for I: = 1 to SMTP1.Errors.Count do
ErrorStr: = Format (# 13 '(% s)', [SMTP1. Errors.Item (I). Description ]);
(Display error code, short and long error description)
MessageDlg (Format ( '% d -% s% s', [Number, Description, Trim (ErrorStr)]),mtError, [mbOK], 0); end;
(Unlike POP, SMTP does not require a user account on the host machine,so no user authorization is necessary) procedure TMail.SMTPConnectBtnClick (Sender: TObject); begin if SMTP1.State = prcConnected then
SMTP1.Quit else if SMTP1.State = prcDisconnected then begin
SMTP1.RemoteHost: = eSMTPServer.Text;
SMTPError: = False;
SMTP1.Connect (NoParam, NoParam); end; end;
(Unlike SMTP, users must be authorized on the POP server. The componentdefines a special protocol state, popAuthorization, when it requestsauthorization. If authorization is successful, the protocol state changes topopTransaction and
POP commands can be issued. Note that server connection is independentof the authorization state.) procedure TMail.POP1ProtocolStateChanged (Sender: TObject;
ProtocolState: Smallint); begin case ProtocolState of popAuthorization:
POP1.Authenticate (POP1.UserID, POP1. Password); popTransaction:
ConnectStatus.SimpleText: = Format ( 'User% s authorized on server
% s ', [eUsername.Text, ePOPServer.Text]); end; end;
(This event is called every time the connection status of the POP serverchanges) procedure TMail.POP1StateChanged (Sender: TObject; State: Smallint); begin case State of prcConnecting:
ConnectStatus.SimpleText: = 'Connecting to POP server:
'+ POP1.RemoteHost +'...'; prcResolvingHost:
ConnectStatus.SimpleText: =' Resolving Host '; prcHostResolved:
ConnectStatus.SimpleText: =' Host Resolved '; prcConnected : begin
ConnectStatus.SimpleText: = 'Connected to POP server:
'+ POP1.RemoteHost;
POPConnectBtn.Caption: =' Disconnect '; end; prcDisconnecting:
ConnectStatus.SimpleText: =' Disconnecting from POP server:
'+ POP1.RemoteHost +'...'; prcDisconnected: begin
ConnectStatus.SimpleText: =' Disconnected from POP server:
'+ POP1.RemoteHost;
POPConnectBtn.Caption: =' Connect '; end; end; ePOPServer.Enabled: = not (State = prcConnected); eUsername.Enabled: = not (State = prcConnected); ePassword.Enabled: = not (State = prcConnected); end;
(The Error event is called whenever an error occurs in the backgroundprocessing. In addition to providing an error code and brief description, you can alsoaccess the POP component's Errors property (of type icErrors, an OLE object) to getmore detailed information) procedure TMail.POP1Error (Sender: TObject; Number: Smallint; var Description: WideString; Scode: Integer; const Source,
HelpFile: WideString; HelpContext: Integer; var CancelDisplay:
WordBool); var
I: Integer;
ErrorStr: string; begin
POPError: = True;
CancelDisplay: = True ; if POP1.ProtocolState = popAuthorization then
ConnectStatus.SimpleText: = 'Authorization error';
(Get extended error information) for I: = 1 to POP1.Errors.Count do
ErrorStr: = Format (# 13 '(% s)', [POP1.Errors.Item (I). Description ]);
(Display error code, short and long error description)
MessageDlg (Format ( '% d -% s% s', [Number, Description, Trim (ErrorStr)]),mtError, [mbOK], 0); end;
(POP requires a valid user account on the host machine) procedure TMail.POPConnectBtnClick (Sender: TObject); begin if (POP1.State = prcConnected) and (POP1.ProtocolState =popTransaction) and not POP1.Busy then begin mReadMessage.Lines.Clear;
POP1.Quit; end else if POP1.State = prcDisconnected then begin
POP1.RemoteHost: = ePOPServer. Text;
POP1.UserID: = eUserName.Text;
POP1.Password: = ePassword.Text;
POP1.Connect (NoParam, NoParam); end; end;
(The DocOutput event is the just like the DocInput event in 'reverse'.
It is called each time the component's DocOutput state changes during retrieval of mail fromthe server. When the state = icDocData, you can call DocOutput.GetData to decode each datablock based on the MIME content type specified in the headers.) procedure TMail.POP1DocOutput (Sender: TObject; const DocOutput:
DocOutput); var
Buffer: WideString;
I: Integer; begin case DocOutput.State of icDocBegin:
POPStatus.SimpleText: = 'Initiating document transfer '; icDocHeaders: begin
POPStatus.SimpleText: =' Retrieving headers '; for I: = 1 to DocOutput.Headers.Count do mReadMessage.Lines.Add (DocOutput.Headers.Item (I). Name + ':' +
DocOutput.Headers.Item (I). Value); end; icDocData: begin
POPStatus.SimpleText: = Format ( 'Retrieving data -% d bytes' ,
[Trunc (DocOutput.BytesTransferred )]);
Buffer: = DocOutput.DataString; mReadMessage.Text: = mReadMessage.Text + Buffer; end; icDocEnd: if POPError then
POPStatus.SimpleText: = 'Transfer aborted' else
POPStatus.SimpleText: = Format ( 'Retrieval complete (% d bytesdata )',
[Trunc (DocOutput.BytesTransferred)]); end;
POPStatus.Update; end;
(Retrieve message from the server) procedure TMail.udCurMessageClick (Sender: TObject; Button: TUDBtnType); begin if (POP1.State = prcConnected) and (POP1.ProtocolState =popTransaction) then begin
POPError: = False; mReadMessage.Lines.Clear;
POP1.RetrieveMessage (udCurMessage.Position); end; end;
( The RefreshMessageCount event is called whenever the
RefreshMessageCount method is called, and also when a connection to the POP server is first made) procedure TMail.POP1RefreshMessageCount (Sender: TObject;
Number: Integer); begin
FMessageCount: = Number; udCurMessage.Max: = Number; udCurMessage.Enabled: Number = 0; lMessageCount.Caption: = IntToStr (Number); if Number> 0 then begin udCurMessage.Min: = 1; udCurMessage.Position: = 1;
POP1.RetrieveMessage (udCurMessage.Position); end; end;
end.
Z
.
ф
х
Mqе ... ° в: зозZјз <
ил »ц" | я 7 я'Пцpпу лd
hл | япBIщQє? ЕE K-файл webbrows.dpr
program Webbrows;
uses
Forms, main in 'Main.pas' (MainForm),
SMTP in 'Smtp.pas', (Mail)
FTP in 'ftp.pas', (MyFtp)
NNTP in 'nntp.pas', (NewsForm )
CHAT in 'chat.pas'; (ChatForm)
($ R *. RES)
begin
Application. Initialize;
Application.CreateForm (TMainForm, MainForm);
Application.CreateForm (TDocSourceFrm, DocSourceFrm);
Application.run; end.
Додаток 1. Оригінальний текст моделі корпоративної мережі
uses crt, dos, graph;
CONST VertexQuantity = 7;
DelayInDomain = 1000;
DelaySendToRouter = 1000;
DelayRouterReceive = 1000;
AdjacencyMatrix: array [1 .. VertexQuantity, 1 .. VertexQuantity] of byte = (
(0,1 , 0,1,0,0,0),
(1,0,1,0,1,0,1),
(0,1,0,1 , 0,0,0),
(1,0,1,0,1,0,0),
(0,1,0,1,0,1 , 0),
(0,0,0,0,1,0,1),
(0,1,0,0,0,1,0)) ;
TYPE TAddr = record (address format) router: byte; domain: byte; comp: byte;
END;
TYPE TBatch = record (batch format) from: TAddr; to_: TAddr; data: string; path: array [1 .. 20] of byte; (path is chain of router numbers)
END;
TYPE TComp = object (terminal) addr: TAddr; (adress) mem: TBatch; (memory)
Procedure Send2Router (batch: TBatch); (send batch)
Procedure Send ( batch: TBatch); (send batch into domain)
Procedure Receive (batch: TBatch; byRouter: boolean); (receive batch)
END;
TYPE TRouter = object num: byte; x, y: integer; memory: Tbatch; state: boolean; (active or inactive)
Procedure Receive (routerNum: byte; batch: TBatch);
Procedure Send2Comp (batch: TBatch);
Procedure CalcMinPath (sender, target: byte);
Procedure Send2NextRouter (batch: TBatch; currentRouter: byte);
END;
VAR computers: array [1 .. 38] of TComp; (all computers in the globalnet) routers: array [1 .. 7] of TRouter; (all routers in the global net)
OptimalPath: array [1 .. 49] of byte; (1 -> [1,2 , 3,4,5])
OptPathPtr: byte;
type TMark = record delta: integer; prevPtr: byte; end; type vertex = record mark: TMark; marked: boolean; end;
AdjacencyRec = record link: byte; weight: integer; end;
VAR AMatr: array [1 .. 7,1 .. 7] of AdjacencyRec; vertexArr : array [1 .. 7] of vertex;
PROCEDURE HiddenCursor; assembler; asm mov ah, 01 mov ch, 20 mov cl, 18 int 10h end;
PROCEDURE NormalCursor; assembler; asm mov ah, 01 mov ch, 9 mov cl, 10 int 10h end;
Procedure Push (num: byte);
Begin
OptimalPath [OptPathPtr 1]: = num; inc (OptPathPtr);
End;
Procedure Pop;
Begin
OptimalPath [ OptPathPtr]: = 0; dec (OptPathPtr);
End;
Procedure ShowGraphics (second: boolean);
Var grDr, grMode: integer; i : integer;
Begin grDr: = vga; grMode: = 2;
InitGraph (grDr, grMode, 'd: langtpbgi');
SetTextStyle ( DefaultFont, HorizDir, 2); SetColor (lightRed);
OutTextXY (10,20, 'Arrangement scheme of routers');
SetColor (white); Rectangle (5,15,480 , 40);
Rectangle (5,48,480,70); SetTextStyle (DefaultFont, HorizDir, 1); setcolor (lightgreen);
OutTextXY (10,55, 'Main address: Router.Domain.Computer (for ex.,
4.2.4) '); setcolor (white); setFillStyle (7, lightblue); floodfill (5,5, white);
setlinestyle (0,0,3); rectangle (0,0, getmaxX-20, getmaxY-20); setFillStyle (9, lightgray); floodfill (getmaxX, getmaxY, white); setlinestyle (0,0, NormWidth);
SetFillStyle (1, red);
{------------------- router circles ----------------------- )
Circle (routers [1]. x, routers [1]. y, 10); FloodFill (routers [1]. x, routers [1]. y, white);
Circle (routers [2]. x, routers [2]. y, 10); FloodFill (routers [2]. x, routers [2]. y, white);
Circle (routers [3]. x, routers [3]. y, 10); FloodFill (routers [3]. x, routers [3]. y, white);
Circle (routers [4]. x, routers [4]. y, 10); FloodFill (routers [4]. x, routers [4]. y, white);
Circle (routers [5]. x, routers [5]. y, 10); FloodFill (routers [5]. x, routers [5]. y, white);
Circle (routers [6]. x, routers [6]. y, 10); FloodFill (routers [6]. x, routers [6]. y, white);
Circle (routers [7]. x, routers [7]. y, 10); FloodFill (routers [7]. x, routers [7]. y, white);
SetFillStyle (1, yellow);
SetColor (red );{------------------- router lines -------------------------
)
Line (routers [1]. x, routers [1]. y-10, routers [2]. x-2, routers [2]. y +10); < p> Line (routers [1]. x, routers [1]. y 10, routers [4]. x-10, routers [4]. y-6);
Line (routers [ 3]. x, routers [3]. y-10, routers [2]. x 2, routers [2]. y +10);
Line (routers [3]. x, routers [3]. y 10, routers [4]. x, routers [4]. y-10);
Line (routers [2]. x 4, routers [2]. y + 10, routers [5]. x-2, routers [5]. y-10);
Line (routers [2]. x 10, routers [2]. y, routers [7] . x-10, routers [7]. y);
Line (routers [5]. x 2, routers [5]. y-10, routers [6]. x, routers [6 ]. y +10);
Line (routers [6]. x, routers [6]. y-10, routers [7]. x, routers [7]. y +10);
Line (routers [4]. x 10, routers [4]. y, routers [5]. x-10, routers [5]. y);
(domains ) {------------- domain 1.1 --------------------------------- -
)
SetTextStyle (DefaultFont, HorizDir, 1); SetColor (white);
Rectangle (routers [1]. x-50, routers [1]. y-50, routers [1]. x-30, routers [1]. y-
20);
FloodFill (routers [1]. X-48, routers [1]. Y-48, white);
Circle (20, routers [1]. Y -30,8); FloodFill (20, routers [1]. y-30, white);
Circle (40, routers [1]. y-30, 8); FloodFill (40, routers [1]. y-30, white);
Circle (60, routers [1]. y-30, 8); FloodFill (60, routers [1]. y-30, white);
SetColor (white);
Line (routers [1]. x-5, routers [1]. y-10, routers [1]. x-20, routers [ 1]. y-30);
Line (routers [1]. x-20, routers [1]. y-30, routers [1]. x-110, routers [1]. y -
30);
{------------- domain 1.2 ------------------------ ----------}
Rectangle (routers [1]. x-30, routers [1]. y 80, routers [1]. x-
5, routers [1]. Y +92);
FloodFill (routers [1]. X-28, routers [1]. Y 82, white);
Line (routers [1]. x-2, routers [1]. y 10, routers [1]. x-20, routers [1]. y +80);
Circle (routers [1 ]. x-48, routers [1]. y +62,9);
FloodFill (routers [1]. x-48, routers [1]. y 62, white);
Line (routers [1]. x-28, routers [1]. y 82, routers [1]. x-52, routers [1]. y +62);
Circle (routers [1]. x 10, routers [1]. y +62,8);
FloodFill (routers [1]. x 10, routers [1]. y 62 , white);
Line (routers [1]. x-5, routers [1]. y 82, routers [1]. x 10, routers [1]. y +62);
Circle (routers [1]. x-48, routers [1]. y +92,8);
FloodFill (routers [1]. x-48, routers [ 1]. y 92, white);
Line (routers [1]. x-28, routers [1]. y 90, routers [1]. x-48, routers [1] . y +92);
Circle (routers [1]. x-43, routers [1]. y +115,8);
FloodFill (routers [1]. x-43, routers [1]. y 115, white);
Line (routers [1]. x-23, routers [1]. y 90, routers [1]. x -
48, routers [1]. Y +115);
Circle (routers [1]. X-18, routers [1]. Y +115,8);
FloodFill (routers [1]. x-18, routers [1]. y 115, white);
Line (routers [1]. x-18, routers [1]. y 90, routers [1]. x-
18, routers [1]. Y +115);
Circle (routers [1]. X 13, routers [1]. Y +113,8);
FloodFill (routers [1]. x 13, routers [1]. y 113, white);
Line (routers [1]. x-5, routers [1]. y 92, routers [1]. x 13, routers [1]. y +113);
{------------- domain 2.1 --------- -------------------------}
Rectangle (routers [2]. x-
25, routers [2]. Y 70, routers [2]. X 16, routers [2]. Y +79);
FloodFill (routers [2]. X-24, routers [ 2]. y 72, white);
Line (routers [2]. x, routers [2]. y 10, routers [2]. x-5, routers [2]. y +70);
Circle (routers [2]. x-24, routers [2]. y +100,8);
FloodFill (routers [2]. x - 24, routers [2]. y 100, white);
Line (routers [2]. x, routers [2]. y 72, routers [2]. x-24, routers [ 2]. y +100);
{------------- domain 2.2 ------------------- ---------------}
Rectangle (routers [2]. x-80, routers [2]. y 10, routers [2]. x -
60, routers [2]. Y +37);
FloodFill (routers [2]. X-78, routers [2]. Y 12, white);
Line (routers [2]. x-10, routers [2]. y, routers [2]. x-70, routers [2]. y +20);
Circle (routers [2]. x-110, routers [2]. y +20,8);
FloodFill (routers [2]. x-110, routers [2]. y 20, white);
Circle (routers [2]. x-140, routers [2]. y +20,8);
FloodFill (routers [2]. x-140, routers [2]. y 20, white);
Line (routers [2]. x-70, routers [2]. y 20, routers [2]. x-
150, routers [2]. Y +20);
{------------- domain 3.1 --------------- -------------------}
Rectangle (routers [3]. x-45, routers [3]. y-47, routers [3 ]. x-25, routers [3]. y-
20);
FloodFill (routers [3]. X-43, routers [3]. Y-45, white);
Circle (routers [3]. X-60 , routers [3]. y-37, 8);
FloodFill (routers [3]. x-60, routers [3]. y-37, white);
Circle (routers [3]. x-80, routers [3]. y-37, 8);
FloodFill (routers [3]. x-80, routers [3]. y-37, white);
Line (routers [3]. x-7, routers [3]. y-8, routers [3]. x-35, routers [3]. y-37);
Line (routers [3]. x-35, routers [3]. y-37, routers [3]. x-90, routers [3]. y-37); < p> {------------- domain 4.1 -------------------------------- --}
Rectangle (routers [4]. x-39, routers [4]. y-82, routers [4]. x-13, routers [4]. y-
70);
FloodFill (routers [4]. X-37, routers [4]. Y-81, white);
Line (routers [4]. X-4 , routers [4]. y-10, routers [4]. x-25, routers [4]. y-70);
Circle (routers [4]. x-40, routers [4 ]. y-105, 8);
FloodFill (routers [4]. x-40, routers [4]. y-105, white);
Line (routers [ 4]. x-25, routers [4]. y-75, routers [4]. x-40, routers [4]. y-
105);
Circle (routers [4]. X-60, routers [4]. Y-70, 8);
FloodFill (routers [4]. X-60 , routers [4]. y-70, white);
Line (routers [4]. x-25, routers [4]. y-75, routers [4]. x-60, routers [4]. y-70);
Circle (routers [4]. x-40, routers [4]. y-50, 8);
FloodFill (routers [ 4]. x-40, routers [4]. y-50, white);
Line (routers [4]. x-25, routers [4]. y-75, routers [4] . x-40, routers [4]. y-50);
{------------- domain 4.2 ------------ ----------------------}
Rectangle (routers [4]. x 25, routers [4]. y-35, routers [4]. x 45, routers [4]. y-
5);
FloodFill (routers [4]. X 27, routers [4]. Y-33, white);
Circle (routers [4]. X 57 , routers [4]. y-25, 8);
FloodFill (routers [4]. x 57, routers [4]. y-25, white);
Circle (routers [4]. x 77, routers [4]. y-25, 8);
FloodFill (routers [4]. x 77, routers [4]. y-25, white);
Circle (routers [4]. x 97, routers [4]. y-25, 8);
FloodFill (routers [4]. x 97 , routers [4]. y-25, white);
Circle (routers [4]. x 117, routers [4]. y-25, 8);
FloodFill (routers [4]. x 117, routers [4]. y-25, white);
Line (routers [4]. x 9, routers [4]. y-7, routers [4]. x 20, routers [4]. y-25);
Line (routers [4]. x 20, routers [4]. y-25, routers [4] . x 127, routers [4]. y-
25);
{------------- domain 5.1 ------------------------ ----------}
Rectangle (routers [5]. x-30, routers [5]. y-130, routers [5]. x-
10, routers [5]. Y-100);
FloodFill (routers [5]. X-25, routers [5]. Y-128, white);
Line (routers [5]. x, routers [5]. y-10, routers [5]. x-20, routers [5]. y-120);
Circle (routers [5]. x-48, routers [5]. y-90, 8);
FloodFill (routers [5]. x-48, routers [5]. y-120 +30, white);
Line (routers [5]. x-20, routers [5]. y-120, routers [5]. x-48, routers [5]. y-
90);
Circle (routers [5]. X-50, routers [5]. Y-120, 8);
FloodFill (routers [5]. X-50 , routers [5]. y-120, white);
Line (routers [5]. x-20, routers [5]. y-120, routers [5]. x-50, routers [5]. y-
120);
Circle (routers [5]. X-25, routers [5]. Y-150, 8);
FloodFill (routers [5]. X-25 , routers [5]. y-150, white);
Line (routers [5]. x-20, routers [5]. y-120, routers [5]. x-25, routers [5]. y-
150);
Circle (routers [5]. X 2, routers [5]. Y-150, 8);
FloodFill (routers [5]. X 2 , routers [5]. y-150, white);
Line (routers [5]. x-20, routers [5]. y-120, routers [5]. x 2, routers [5]. y-
150);
{------------- domain 6.1 ------------------------ ----------}
Rectangle (routers [6]. x-30, routers [6]. y-10, routers [6]. x-
14, routers [6]. Y +14);
FloodFill (routers [6]. X-28, routers [6]. Y-8, white);
Circle (routers [6]. x-42, routers [6]. y, 8);
FloodFill (routers [6]. x-42, routers [6]. y, white);
Circle (routers [6]. x-62, routers [6]. y, 8);
FloodFill (routers [6]. x-62, routers [6]. y , white);
Circle (routers [6]. x-82, routers [6]. y, 8);
FloodFill (routers [6]. x-82, routers [6]. y, white);
Line (routers [6]. x-10, routers [6]. y, routers [6]. x-92, routers [6]. y );
{------------- domain 7.1 ------------------------- ---------}
Rectangle (routers [7]. x-10, routers [7]. y-50, routers [7]. x 10, routers [7] . y-
25);
FloodFill (routers [7]. X-8, routers [7]. Y-48, white);
Line (routers [7]. X, routers [7]. y-10, routers [7]. x, routers [7]. y-50);
Circle (routers [7]. x-35, routers [7]. y - 20,8);
FloodFill (routers [7]. x-35, routers [7]. y-20, white);
Line (routers [7]. x , routers [7]. y-50, routers [7]. x-35, routers [7]. y-20);
Circle (routers [7]. x-35, routers [7 ]. y-60, 8);
FloodFill (routers [7]. x-35, routers [7]. y-60, white);
Circle (routers [ 7]. x 15, routers [7]. y-70, 8);
FloodFill (routers [7]. x 15, routers [7]. y-70, white);
Line (routers [7]. x, routers [7]. y-50, routers [7]. x 15, routers [7]. y-70);
Line (routers [7]. x, routers [7]. y-50, routers [7]. x-35, routers [7]. y-60);
SetColor (cyan);
OuttextXY (18, routers [1]. y-32, '4');
OuttextXY (38, routers [1]. y-32, '3 '); OuttextXY (58, routers [1]. y-32, '2');
OutTextXY (routers [1]. x-48, routers [1]. y-48, 'FS');
OuttextXY (78, routers [1]. y-32, '1');
OutTextXY (routers [1]. x 8, routers [1]. y 60 , '1');
OutTextXY (routers [1]. x-50, routers [1]. y 60, '6');
OutTextXY (routers [1 ]. x-50, routers [1]. y 89, '5');
OutTextXY (routers [1]. x-45, routers [1]. y 113, '4 ' );
OutTextXY (routers [1]. x-20, routers [1]. y 112, '3');
OutTextXY (routers [1]. x - 28, routers [1]. y 82, 'hub');
OutTextXY (routers [1]. x 11, routers [1]. y 111, '2');
OutTextXY (routers [2]. x-24, routers [2]. y 72, 'modem');
OutTextXY (routers [2]. x-26, routers [ 2]. y 98, '1');
OutTextXY (routers [2]. x-78, routers [2]. y 12, 'FS');
OutTextXY (routers [2]. x-73, routers [2]. y 24, '1');
OutTextXY (routers [2]. x-112, routers [2]. y 18, '2');
OutTextXY (routers [2]. x-142, routers [2]. y 18, '3');
OutTextXY (routers [3]. x-42, routers [3]. y-45, 'FS');
OutTextXY (routers [3]. x-38, routers [3]. y-30,' 1');
OutTextXY (routers [3]. x-62, routers [3]. y-40, '2');
OutTextXY (routers [3]. x-82, routers [3]. y-40, '3');
OutTextXY (routers [4]. x-37, routers [4]. y-80, 'hub');
OutTextXY (routers [4]. x-42, routers [4]. y-107, '1');
OutTextXY (routers [4]. x-62, routers [4]. y-73, '2');
OutTextXY (routers [4]. x-42, routers [4]. y-53, '3');
OutTextXY (routers [4]. x 28, routers [4]. y-33, 'FS');
OutTextXY (routers [4]. x 33, routers [4] . y-20, '1');
OutTextXY (routers [4]. x 55, routers [4]. y-27, '2');
OutTextXY (routers [4]. x 75, routers [4]. y-27, '3');
OutTextXY (routers [4]. x 95, routers [4]. y-27 , '4');
OutTextXY (routers [4]. x 115, routers [4]. y-27, '5');
OutTextXY (routers [5 ]. x-27, routers [5]. y-127, 'FS');
OutTextXY (routers [5]. x-21, routers [5]. y-110, '1' );
OutTextXY (routers [5]. x-51, routers [5]. y-92, '2');
OutTextXY (routers [5]. x - 51, routers [5]. y-122, '3');
OutTextXY (routers [5]. x-27, routers [5]. y-152, '4');
OutTextXY (routers [5]. x, routers [5]. y-152, '5');
OutTextXY (routers [6]. x-29, routers [6] . y-8, 'FS');
OutTextXY (routers [6]. x-25, routers [6]. y 4, '1');
OutTextXY (routers [6]. x-44, routers [6]. y-2, '2');
OutTextXY (routers [6]. x-64, routers [6]. y-2 , '3');
OutTextXY (routers [6]. x-84, routers [6]. y-2, '4');
OutTextXY (routers [7 ]. x-7, routers [7]. y-48, 'FS');
OutTextXY (routers [7]. x-2, routers [7]. y-35, '1' );
OutTextXY (routers [7]. x-37, routers [7]. y-22, '2');
OutTextXY (routers [7]. x - 37, routers [7]. y-62, '3');
OutTextXY (routers [7]. x 12, routers [7]. y-72, '4');
SetColor (white);
OutTextXY (10,230, 'Domain 1.1'); OutTextXY (10,338, 'Domain 1.2');
OutTextXY (200,220,' Domain 2.1 '); OutTextXY (110,150,' Domain 2.2');
OutTextXY (210,240, 'Domain 3.1');
OutTextXY (170,320,' Domain 4.1 '); OutTextXY ( 330,370, 'Domain 4.2');
OutTextXY (430,250,' Domain 5.1');
OutTextXY (450,175, 'Domain 6.1');
( ------------- router numbers -------------------------)
SetColor ( black);
OutTextXY (routers [1]. x-2, routers [1]. y-2, '1');
OutTextXY (routers [2]. x -2, routers [2]. y-2, '2');
OutTextXY (routers [3]. x-2, routers [3]. y-2, '3 ');
OutTextXY (routers [4]. x-2, routers [4]. y-2, '4');
OutTextXY (routers [5]. x-2, routers [5]. y-2, '5');
OutTextXY (routers [6]. x-2, routers [6]. y-2, '6'); < p> OutTextXY (routers [7]. x-2, routers [7]. y-2, '7 '); if second then begin setlinestyle (0,0,3); setcolor ((white) green); for i : = 1 to OptPathPtr-2 do
Line (routers [OptimalPath [i]]. x, routers [OptimalPath [i]]. y, routers [OptimalPath [i +1]]. x, routers [OptimalPath [i +1]]. y); while not keypressed do for i: = 1 to 63 do SetRGBPalette (green, 0, i, 0); end; if not second then while not keypressed do for i: = 1 to 63 do SetRGBPalette (red, i, 0,0);
End;
Procedure ShowTime (x, y: integer);
VAR h, m, s, hund: Word;
Function LeadingZero (w: Word): String; var s: String; begin
Str (w: 0, s); if Length ( s) = 1 then s: = '0 '+ s;
LeadingZero: = s; end;
Begin
GetTime (h, m, s , hund); TextColor (Green); GotoXY (x, y); Write (LeadingZero (h ),':',
LeadingZero (m ),':', LeadingZero (s), '. ', LeadingZero (hund ));
End;
Function Dist (x1, y1, x2, y2: longint): longint; var temp: longint; < p> Begin temp: = sqr (x2-x1) + sqr (y2-y1); temp: = trunc ((sqrt (temp )));
Dist: = temp; < p> End;
{----------------- objects implementation part -----------------)
{--------------- Computer procedures ---------------)
Procedure TComp . Send2Router (batch: TBatch); (send batch to it's router)
VAR i: byte; tmpFrom: TAddr;
Begin
Delay (DelaySendToRouter) ; tmpFrom: = batch.from; i: = batch.from.router; routers [i]. memory: = batch; (router receive data from his domain'scomputer) showtime (wherex, wherey); writeln ( '>', tmpFrom.router ,'.', tmpFrom.domain ,'.', tmpFrom.comp,
'says: I send data', ' "', batch.data ,'"',' for
', batch.to_.router ,'.', batch.to_.domain ,'.', batch.to_.comp,' to router ', i); for i: = 1 to 38 do if < p> (computers [i]. addr.router = tmpFrom.router) AND
(computers [i]. addr.domain = tmpFrom.domain)
AND (computers [i]. addr.comp = tmpFrom.comp) then break; computers [i]. mem.data: = ' '; (clear memory)
End;
Procedure TComp.Send (batch: TBatch); (into domain)
VAR i: byte; tmpTo, tmpFrom: TAddr;
Begin
Delay (DelayInDomain); tmpTo: = batch.to_; tmpFrom: = batch.from; for i: = 1 to 38 do if
(computers [i]. addr.router = tmpTo.router) AND
(computers [i]. addr.domain = tmpTo.domain)
AND (computers [i]. addr.comp = tmpTo.comp) then break; computers [i]. mem: = batch; ( Send!) showtime (wherex, wherey); writeln ( '>', tmpFrom.router ,'.', tmpFrom.domain ,'.', tmpFrom.comp,
'says: I send data' ,'"', batch.data ,'"',' to
', batch.to_.router ,'.', batch.to_.domain ,'.', batch.to_.comp); for i: = 1 to 38 do if
(computers [i] . addr.router = tmpFrom.router) AND
(computers [i]. addr.domain = tmpFrom.domain)
AND (computers [i]. addr.comp = tmpFrom.comp) then break; computers [i]. mem.data: = ' '; (clear memory)
End;
Procedure TComp.Receive (batch: TBatch; byRouter: boolean); (computer receivedata from his domain's router)
VAR tmpTo: TAddr;
Begin
Delay (DelayInDomain); tmpTo: = batch.to_; showtime (wherex, wherey ); write ( '>', tmpTo.router ,'.', tmpTo.domain ,'.', tmpTo.comp,
'says: I receive data','"', batch.data ,'"',' from
', batch.from.router ,'.', batch.from.domain ,'.', batch.from.comp); if byRouter then writeln (' by router ', tmpTo.router);
End;
{------------- Router procedures -------------------)
Procedure TRouter.CalcMinPath (sender, target: byte);
VAR i, j: byte; k: byte;
AllVertexMarked: boolean;
Begin
{----------------------- Initialization ---------------- ----------} for i: = 1 to 7 do for j: = 1 to 7 do if AdjacencyMatrix [i, j] = 1 then AMatr [i, j]. link: = 1 else AMatr [i, j]. link: = 0; for i: = 1 to 7 do for j: = 1 to 7 do AMatr [i, j]. weight: = 0;
Randomize;
For j: = 2 to7 do for i: = 1 to j-1 do AMatr [i, j]. weight: = random (50); for i: = 1 to 7 do vertexArr [i]. marked: = false;
{-------------------------- Make marks --------- --------------------}
{---- mark last vertex ----}
vertexArr [ target]. mark.delta: = 0; vertexArr [target]. mark.prevPtr: = target; vertexArr [target]. marked: = true;
AllVertexMarked: = false;
While not AllVertexMarked do BEGIN
For j: = 1 to 7 do
For i: = 1 to 7 do begin (j ---> i) if (AMatr [i , j]. link0) AND (vertexArr [j]. marked)
AND (not vertexArr [i]. marked) then begin if not ((vertexArr [j]. marked) AND (j = sender )) then begin
vertexArr [i]. mark.delta: = vertexArr [j]. mark.delta + AMatr [j, i]. weight; vertexArr [i]. mark.prevPtr: = j ; vertexArr [i]. marked: = true; end; end;
End;
AllVertexMarked: = true; for i: = 1 to 7 do if vertexArr [i]. marked = false then
AllVertexMarked: = false;
END; (While not AllVertexMarked)
{----------------------- --- Main test -----------------------------} for i: = 1 to 49 do OptimalPath [i]: = 0 ;
For i: = 1 to 7 do vertexArr [i]. marked: = false; vertexArr [sender]. marked: = true;
For j: = 1 to 7 do
For i: = 1 to 7 do begin {---- deltaA-deltaB> d (AB) then changemark)
() if (vertexArr [j]. marked) AND (not (vertexArr [i]. marked)) then begin vertexArr [i]. marked: = true; for k: = 1 to 7 do if (AMatr [k, j]. link = 1) then begin
if vertexArr [j]. mark.delta -vertexArr [k]. mark.delta> AMatr [k, j]. weight then begin vertexArr [j]. mark.prevPtr: = k; vertexArr [j]. mark.delta: = vertexArr [k]. mark.delta + AMatr [k, j]. weight; vertexArr [k]. marked: = true; end (else vertexArr [k]. marked: = true); end; end;
() end; (if adjacency vertex found) push (sender);
k: = vertexArr [sender]. mark.prevPtr; push (k);
While ktarget do begin push (vertexArr [k] . mark.PrevPtr); k: = vertexArr [k]. mark.PrevPtr;
End;
End;
Procedure TRouter.Send2NextRouter (batch: TBatch; currentRouter: byte);
Begin
Delay (DelayRouterReceive + AMatr [currentRouter, OptimalPath [OptPathPtr]]. link);
showtime (wherex, wherey); writeln ( '> router', currentRouter,
'says: I send data','"', batch.data ,'"',' from
', batch.from.router ,'.', batch.from.domain ,'.', batch.from.comp,' to router ', OptimalPath [OptPathPtr]); routers [OptimalPath [OptPathPtr]]. memory: = batch; inc (OptPathPtr); routers [currentRouter]. memory.data :=''{ clear memory)
End;
Procedure TRouter.receive (routerNum: byte; batch: TBatch);
Begin
Delay (DelayRouterReceive); showtime (wherex, wherey); writeln ( '> router', routerNum,
'says: I receive data','"', batch.data ,'"',' from
', batch.from.router ,'.', batch.from.domain ,'.', batch.from.comp);
End;
Procedure TRouter.send2comp ( batch: TBatch);
VAR i: byte; tmpTo, tmpFrom: TAddr;
Begin
Delay (DelayInDomain); tmpTo: = batch.to_; tmpFrom: = batch.from; for i: = 1 to 38 do if
(computers [i]. addr.router = tmpTo.router) AND
(computers [i]. addr.domain = tmpTo.domain)
AND (computers [i]. addr.comp = tmpTo.comp) then break; computers [i]. mem: = batch; ( Send!) showtime (wherex, wherey); writeln ( '> router', tmpTo.router,
'says: I send data','"', batch.data ,'"',' to
', batch.to_.router ,'.', batch.to_.domain ,'.', batch.to_.comp); routers [tmpTo.router]. memory.data :='';{ clear memory)
End;
Procedure Initialization;
VAR i, j: integer;
Begin
(--- ---------- INITIALIZATION PART -------------}
FOR i: = 1 to 7 do begin (routers initialization) routers [i] . num: = i; routers [i]. state: = true; routers [i]. memory.data :=''; for j: = 1 to 20 do routers [i]. memory.path [j]: = 0;
END; routers [1]. x: = 120; routers [1]. y: = 300; routers [2]. x: = 250; routers [2]. y: = 100 ; routers [3]. x: = 320; routers [3]. y: = 300; routers [4]. x: = 300; routers [4]. y: = 420; routers [5]. x: = 500 ; routers [5]. y: = 420; routers [6]. x: = 540; routers [6]. y: = 200; routers [7]. x: = 550; routers [7]. y: = 100 ;
FOR i: = 1 to 38 do computers [i]. mem.data :='';{ computersinitialization) j: = 1; for i: = 1 to 4 do begin (router 1, domain 1) computers [i]. addr.router: = 1; computers [i]. addr.domain: = 1; computers [i ]. addr.comp: = j; inc (j); end; j: = 1; for i: = 5 to 10 do begin (router 1, domain 2) computers [i]. addr.router: = 1; computers [i]. addr.domain: = 2; computers [i]. addr.comp: = j; inc (j); end; (router 2, domain 1)
computers [11]. addr . router: = 2; computers [11]. addr.domain: = 1; computers [11]. addr
. comp: = 1; j: = 1; for i: = 12 to 14 do begin (router 2, domain 2) computers [i]. addr.router: = 2; computers [i]. Addr.domain: = 2; computers [i]. Addr.comp: = j; inc (j); end; j: = 1; for i: = 15 to 17 do begin ( router 3, domain 1) computers [i]. addr.router: = 3; computers [i]. addr.domain: = 1; computers [i]. addr.comp: = j; inc (j); end; j : = 1; for i: = 18 to 20 do begin (router 4, domain 1) computers [i]. addr.router: = 4; computers [i]. addr.domain: = 1; computers [i]. addr . comp: = j; inc (j); end; j: = 1; for i: = 21 to 25 do begin (router 4, domain 2) computers [i]. addr.router: = 4; computers [i] . addr.domain: = 2; computers [i]. addr.comp: = j; inc (j); end; j: = 1; for i: = 26 to 30 do begin (router 5, domain 1) computers [ i]. addr.router: = 5; computers [i]. addr.domain: = 1; computers [i]. addr.comp: = j; inc (j); end; j: = 1; for i: = 31 to 34 do begin (router 6, domain 1) computers [i]. addr.router: = 6; computers [i]. addr.domain: = 1; computers [i]. addr.comp: = j; inc ( j); end; j: = 1; for i: = 35 to 38 do begin (router 7, domain 1) computers [i]. addr.router: = 7; computers [i]. addr.domain: = 1; computers [i]. addr.comp: = j; inc (j); end;
{------------- END OF INITIALIZATION PART ------ -------}
End;
Procedure Error (ErrorNum: byte);
Begin textcolor (lightred); writeln ( 'Error! '); case ErrorNum of
1: writeln (' One (or two) of above addresses are not exist');
2: writeln ( 'FROM and TO are same' ); end; readln; halt;
End;
VAR tmpStr: string; tmpFrom: TAddr; tmpTo: TAddr; tmpData: string; i, j: integer; tmpX, tmpY : integer;
FromNum, ToNum: byte; (index FROM and TO computers in array)
BEGIN {------------- MAIN PROGRAM -- --------------}
Initialization;
ShowGraphics (false); readln; CloseGraph;
ClrScr; TextColor (LightGreen); write ( 'Global Network Emulation'); ShowTime (70,1); writeln;
{------------- ADDRESS AND DATA REQUEST --- ------------}
Write ( 'Enter FROM address (XXX):'); readln (tmpStr); (FROM request -
-----}
Val (tmpStr [1], tmpFrom.router, i); Val (tmpStr [3], tmpFrom.domain, i);
Val ( tmpStr [5], tmpFrom.comp, i); (target request -------------------------
----}
Write ( 'Enter TO address (XXX):'); readln (tmpStr);
Val (tmpStr [1], tmpTo.router, i) ; Val (tmpStr [3], tmpTo.domain, i);
Val (tmpStr [5], tmpTo.comp, i);
Write ( 'Enter string-type DATA: '); readln (tmpData);
{------------- SEARCH' FROM 'TERMINAL -------------- -----} for i: = 1 to 38 do if
(computers [i]. addr.router = tmpFrom.router) AND
(computers [i]. addr.domain = tmpFrom.domain)
AND (computers [i]. addr.comp = tmpFrom.comp) then FromNum: = i;
( ------------- SEARCH 'TO' TERMINAL ----------------------} for i: = 1 to 38 do if
(computers [i]. addr.router = tmpTo.router) AND
(computers [i]. addr.domain = tmpTo.domain)
AND (computers [i]. addr.comp = tmpTo.comp) then ToNum: = i; if (FromNum = 0) OR ( ToNum = 0) then Error (1); if FromNum = ToNum then Error (2); (computer cannot send batch to itself)
{------------- FILL 'ADDRESS' FIELDS ---
