1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
| procedure TForm1.Button2Click(Sender: TObject);
var i,j,leng1,leng2 :integer;
spis1 : string;
spis2 : string;
begin
spis1 := ''; spis2 := '';
try
subject_numb:=strtoint(form1.Edit3.Text);//номер субъекта
object_numb :=strtoint(form1.Edit4.Text);//номер объекта
except
//ошибка на случай пустых значений
showmessage('Введите субъект и объект!');
exit;
end;
pravo := Edit7.Text;//записали искомое значение права
if (pravo = '') then showmessage('Укажите искомое право!');
if (subject_numb = object_numb) then showmessage('Вы проверяете обращение к самому себе!');
nc:=form1.StringGrid1.ColCount;//если есть субъект и объект - считываем значения
nr:=form1.StringGrid1.RowCount;//числа столбцов и строк в матрице прав
if (nc < 2)or (nr < 2) then showmessage('Матрица доступа слишком мала!');
//производим проверку
for i:=0 to nr-1 do
begin
for j:=0 to nc-1 do
begin
//если на диагонали таблицы есть значения - ошибка
if (j=i) and (form1.StringGrid1.Cells[j,i]<>'') then
begin
showmessage('Субъект не может обращаться к самому себе!');
exit;
end;
end;
end;
//проверка на наличие вершин, у которых есть искомое право к искомой вершине
if (pos(pravo,form1.StringGrid1.Cells[object_numb - 1,subject_numb - 1])>0) then showmessage('Субъект уже имеет данное право к объекту!');
for j:=0 to nr-1 do
begin
if (j <> object_numb - 1) and (pos(pravo,form1.StringGrid1.Cells[object_numb - 1,j])>0)then
begin
spis1 := spis1 + inttostr(j+1);
end;
end;
leng1 := Length(spis1);
if (spis1 = '') then
begin
showmessage('К данному объекту никто не может получить такого права.');
exit;
end;
//обратная проверка
for j:=0 to nr-1 do
begin
if //проверим есть ли от субъекта ребро take в любом направлении
(pos('t',form1.StringGrid1.Cells[j,subject_numb - 1])>0) or
//или ребро grant от любой другой вершины к данному субъекту
(pos('g',form1.StringGrid1.Cells[subject_numb - 1,j])>0) then
begin
spis2 := spis2 + inttostr(j+1);
end;
end;
if (spis2 = '') then
begin
showmessage('Данный субъект не сможет получить права ни у одного из объектов.');
exit;
end;
leng2 := Length(spis2);
//проверка на прямое соединение данных списков смежных списков вершин
for i:=1 to leng2 do
begin
if (pos(spis2[i],spis1)>0) then
begin
showmessage('Субъект '+ inttostr(subject_numb) +' может получить право к объекту '+ inttostr(object_numb) +'. Задействована вершина ' + spis2[i] + '.');
exit;
end;
end;
//если не было соединений - ищем для всех вершин, смежных субъекту ребра с правами t или g
//к другим вершинам. и проверяем те вершины на соединение с списком смежных объекту вершин
for i:=1 to leng2 do
begin
for j:=0 to nr-1 do
begin
if //проверим есть ли от субъекта ребро take в любом направлении
(pos('t',form1.StringGrid1.Cells[j,strtoint(spis2[i]) - 1])>0) or
//или ребро grant от любой другой вершины к данному субъекту
(pos('g',form1.StringGrid1.Cells[strtoint(spis2[i]) - 1,j])>0) then
begin
if (pos(inttostr(j+1),spis1)>0) then
begin
showmessage('Субъект '+ inttostr(subject_numb) +' может получить право к объекту '+ inttostr(object_numb) +'. Задействован путь: '
+ inttostr(subject_numb)+ '-' + spis2[i] + '-'
+ inttostr(j+1) + '-' + inttostr(object_numb) + '.'
);
exit;
end;
end;
end;
end;
showmessage('Не было обнаружено путей получения права от субъекта к объекту.');
end; |
(
