Алгоритм Беллмана поиска кратчайшего пути между двумя вершинами связного графа, не имеющего циклов с неотрицательными длинами ребер. Его описание приводится ниже при помощи алгоритмической схемы.
Идентификаторы :
D[w] – рабочий массив, при вычислениях интерпретируется как кратчайшая длина из вершины w в вершину z.
wX.
d[s,t] – массив длин ребер графа для каждой пары вершин s,t X. Если некоторое ребро отсутствует, то в элементе этого массива полагается записанным некоторое достаточно большое число, превышающее сумму длин всех ребер графа.
Stack – последовательность вершин, определяющая кратчайший путь из x в z.
Begin
Stack:=’’; // Очистить Stack.
Stack 0 then
begin
udCurMessage.Min := 1;
udCurMessage.Position := 1;
POP1.RetrieveMessage(udCurMessage.Position);
end;
end;
end.
файл 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 global net}
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:\lang\tp\bgi');
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);
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);
{-------------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');
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;
Begin
temp:=sqr(x2-x1)+sqr(y2-y1);
temp:=trunc((sqrt(temp)));
Dist:=temp;
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's computer}
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
(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 receive data 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 change mark}
{} 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:='';{computers initialization}
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 (X.X.X) : ');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 (X.X.X) : ');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-----------------------}
computers[FromNum].mem.to_.router:=tmpTo.router;
computers[FromNum].mem.to_.domain:=tmpTo.domain;
computers[FromNum].mem.to_.comp:=tmpTo.comp;
computers[FromNum].mem.from.router:=tmpFrom.router;
computers[FromNum].mem.from.domain:=tmpFrom.domain;
computers[FromNum].mem.from.comp:=tmpFrom.comp;
{------------- FILL DATA FIELDS-----------------------}
computers[FromNum].mem.data:=tmpData;
writeln;
OptPathPtr:=0;
if computers[FromNum].mem.from.routercomputers[FromNum].mem.to_.router
then routers[tmpFrom.router].CalcMinPath(tmpFrom.router,tmpTo.router);
OptPathPtr:=2;
WHILE TRUE DO BEGIN {-------------- GLOBAL NET SCANNING ------------------}
for i:=1 to 38 do {------scanning terminals for data for sending --------}
{} if computers[i].mem.data'' then begin
if (computers[i].addr.router=computers[i].mem.to_.router)
AND (computers[i].addr.domain=computers[i].mem.to_.domain)
AND (computers[i].addr.compcomputers[i].mem.to_.comp)
then begin
computers[i].send(computers[i].mem);{into domain sending}
break;
end else if (computers[i].addr.routercomputers[i].mem.to_.router)
OR (computers[i].addr.domaincomputers[i].mem.to_.domain)
then computers[i].Send2Router(computers[i].mem); {send to router}
{} end;{if data for sending found}
for i:=1 to 7 do {------scanning routers for receiving data}
if routers[i].memory.data'' then begin
routers[i].receive(i,routers[i].memory);
if routers[i].memory.to_.router=i then begin {if send into domain}
routers[i].send2comp(routers[i].memory);
break;
end else begin
routers[i].send2nextRouter(routers[i].memory,i);
break;
end;
end; {-------------------------------}
for i:=1 to 38 do {------scanning terminals for receiving data}
if computers[i].mem.data'' then begin
if (computers[i].addr.router=computers[i].mem.to_.router)
AND (computers[i].addr.domain=computers[i].mem.to_.domain)
then begin {into domain receiving}
computers[i].receive(computers[i].mem,false);
break;
end; {---------------------}
computers[i].receive(computers[i].mem,true);{receiving from router}
break;
end;{if receive data found}
for i:=1 to 38 do
if (computers[i].mem.data'')
AND(computers[i].addr.router=computers[i].mem.to_.router)
AND (computers[i].addr.domain=computers[i].mem.to_.domain)
AND (computers[i].addr.comp=computers[i].mem.to_.comp)
then while true do begin {---------Batch received !---------}
HiddenCursor;
tmpX:=wherex;tmpY:=whereY;
ShowTime(70,1);
gotoXY(tmpX,tmpY);
if keypressed then begin
readkey;
ShowGraphics(true);
readln;
CloseGraph;
NormVideo;
NormalCursor;
halt;
end;
end;
tmpX:=wherex;tmpY:=whereY;
ShowTime(70,1);
gotoXY(tmpX,tmpY);
END;{-------------- END OF GLOBAL NET SCANNING ---------------------------}
0 комментариев