(* PERS_FMS использует: FILE_FMS *)
(* TYPE_FMS *)
{$A+,B-,D-,E+,F+,G-,I+,L+,N-,O+,R+,S+,V+,X-}
{$M 16384,0,65536}
Unit PERS_FMS; INTERFACE { Обслуживание файла персональных }
{ настроек PERSONAL.SFM }
Uses DOS, CRT,TYPE_FMS, FILE_FMS;
procedure INIT_PERS; { Требует Termi и DIRS[OWN] }
procedure OPEN_PERS;
procedure CLOS_PERS;
procedure REWR_PERS(F : integer; var P);
procedure ORWC_PERS(F : integer; var P);
function COME_PERS(pMG : boolean) : integer; { Доп.требует ADM }
procedure EXIT_PERS;
procedure CALL_PERS(H,K : integer; var A);
Const PERS_INIT : boolean = false;
PERS_Popn : boolean = false; { if PERS_INIT then PERS_Ponp = True|False }
IMPLEMENTATION
Type LeDe = record LE : byte; { Длина настройки }
DE : word; { Значение по умолчанию - первые байты }
end;
Const KoHa = 29; { Количество слоев в файле Personal.sfm }
PASP : array [1..KoHa] of LeDe = (
{ 1 } (LE: 2; DE: 1), { 0-общеДОСТУП|1-ДОСТУП|2-ЗАПРЕЩЕН|3-БЛОКИРОВАН}
{ 2 } (LE: 2; DE:$06), { F06L MG.EXE }
{ 3 } (LE: 2; DE:$06), { F05_ MG.EXE }
{ 4 } (LE: 2; DE:$6E), { MGE_ MGE.EXE }
{ 5 } (LE: 1; DE: 0), { Звук/Свет MGU.EXE } { 000 000 ЗС }
{ 6 } (LE:21; DE: 0), { Sequal MGU.EXE }
{ 7 1 } (LE:18; DE: 0), { Знач.НАК MGU.EXE }
{ 8 2 } (LE:18; DE: 0), { Знач.НАК MGU.EXE }
{ 9 3 } (LE:18; DE: 0), { Знач.НАК MGU.EXE }
{ 10 4 } (LE:18; DE: 0), { Знач.НАК MGU.EXE }
{ 11 5 } (LE:18; DE: 0), { Знач.НАК MGU.EXE }
{ 12 6 } (LE:18; DE: 0), { Знач.НАК MGU.EXE }
{ 13 7 } (LE:18; DE: 0), { Знач.НАК MGU.EXE }
{ 14 8 } (LE:18; DE: 0), { Знач.НАК MGU.EXE }
{ 15 9 } (LE:18; DE: 0), { Знач.НАК MGU.EXE }
{ 16 10 } (LE:18; DE: 0), { Знач.НАК MGU.EXE }
{ 17 1 } (LE:23; DE: 0), { Ткст НАК MGU.EXE }
{ 18 2 } (LE:23; DE: 0), { Ткст НАК MGU.EXE }
{ 19 3 } (LE:23; DE: 0), { Ткст НАК MGU.EXE }
{ 20 4 } (LE:23; DE: 0), { Ткст НАК MGU.EXE }
{ 21 5 } (LE:23; DE: 0), { Ткст НАК MGU.EXE }
{ 22 6 } (LE:23; DE: 0), { Ткст НАК MGU.EXE }
{ 23 7 } (LE:23; DE: 0), { Ткст НАК MGU.EXE }
{ 24 8 } (LE:23; DE: 0), { Ткст НАК MGU.EXE }
{ 25 9 } (LE:23; DE: 0), { Ткст НАК MGU.EXE }
{ 26 10 } (LE:23; DE: 0), { Ткст НАК MGU.EXE }
{ 27 2 } (LE: 8; DE: 0), { Имя и семантика поля No.2; MGU.EXE }
{ 28 3 } (LE: 8; DE: 0), { Имя и семантика поля No.3; MGU.EXE }
{ 29 4 } (LE: 8; DE: 0) { Имя и семантика поля No.4; MGU.EXE }
);
var OTCT : array [0..KoHa+1] of LongInt;
P_file : file;
STnum : word; { Исходное состояние терминала }
IDnum : word; { Сформированный Идентификатор входа }
{ OpenPers - Открыть файл DIRS[OWN]+'PERSONAL.SFM' для чтения/записи }
function RPE(FN : String) : integer;
begin assign(P_file,FN);
{$I-} reset(P_file,1);
{$I+} RPE:=IOresult end;
function OpenPers : boolean;
begin OpenPers:=Open_Uni(DIRS[OWN]+'PERSONAL.SFM',RPE) end;
function DLX(F : LongInt) : integer;
var I : integer;
begin for I:=KoHa+1 downto 1 do
if OTCT[I] = F then begin
DLX:=I;
Exit
end;
DLX:=0 end;
{ DeVa : P:=Значение по умолчанию слоя F }
procedure DeVa(F : integer; var P);
begin with PASP[F] do begin
FillChar(P,LE,0);
if LE = 1 then Move(DE,P,1)
else Move(DE,P,2)
end end;
{ DEFA : Заполнить значениями по умолчанию слои начиная с H }
function DEFA(H : integer) : boolean;
var I,K,L,M,R : integer;
C,S : String;
begin DEFA:=false;
if not SeekFile(P_file,OTCT[H]) then Exit;
for I:=H to KoHa do begin
DeVa(I,S[1]);
L:=PASP[I].LE;
S[0]:=chr(L);
R:=255 div L; { Целое число повторов }
C:='';
for K:=1 to R do C:=C+S;
K:=28;
while 0 < K do begin
if R < K then M:=R
else M:=K;
if I = 1 then
if M = 1 then FillChar(C,256,0) { ПАРОЛЬ НЕ УСТАНОВЛЕН }
else M:=M-1;
if not WritFile(P_file,C[1],L*M) then Exit;
K:=K-M
end
end;
DEFA:=true end;
{ BKA : Внести значение P для кода F, слой O }
{ TRUE - O'k }
function BKA(var P; F,O : integer) : boolean;
var L : integer;
begin L:=PASP[F].LE;
BKA:=false;
if SeekFile(P_file,OTCT[F]+O*L) then
if WritFile(P_file, P , L) then BKA:=true end;
function C_AppEnd(L : LongInt) : boolean;
var K : integer;
begin C_AppEnd:=false;
K:=DLX(L);
if K = 0 then Exit; { Не опознана структура файла }
if K <= KoHa then { Требуется AppEnd }
if not DEFA(K) then Exit;
C_AppEnd:=true end;
{ Структуры файлов COUNTERS.SFM и USER_MGU.SFM }
TYPE Tec_User = record _Por : String[20];
_ZS_ : array [1.. 2] of byte;
_NR_ : array [1..10] of String[17];
_NS_ : array [2..11] of String[22];
_NSV : integer
end;
UseRec = record FLAG : boolean;
OTCT : byte;
DATE_ : String[6];
COUN_ : LongInt;
F06L : word;
F05_ : word;
MGE_ : word;
end;
procedure INIT_PERS;
var I,J,K : integer;
US : UseRec;
TU : Tec_User;
Pn : String[80];
L : LongInt;
W : boolean;
begin if PERS_INIT then Exit;
L:=0;
for I:=1 to KoHa do begin
OTCT[I]:=L;
L:=L+LongInt(28)*PASP[I].LE
end;
OTCT[KoHa+1]:=L;
{ OTCT[0]:=0|1|2...|25|26-$ for all - 27 }
if Termi = '$' then OTCT[0]:=26
else if Termi < 'A' then Exit
else if Termi > 'Z' then Exit
else OTCT[0]:=ord(Termi)-ord('A');
Pn:=DIRS[OWN]+'PERSONAL.SFM';
L:=SizeFile(Pn);
if L = OTCT[KoHa+1] then begin { PERSONAL.SFM не требует доработки }
PERS_INIT:=true; { OK }
Exit
end;
if 0 <= L then begin { PERSONAL.SFM - существует }
if OpenPERS then begin
PERS_INIT:=C_AppEnd(L);
Cls_File(P_file)
end;
Exit
end;
assign(P_file,Pn); { PERSONAL.SFM - отсутствует }
{$I-} Rewrite(P_file,1);
{$I+} if IOresult <> 0 then Exit;
if not DEFA(1) then begin
Cls_File(P_file);
KillFile(Pn);
Exit
end;
W:=true; { Н.В.Казеннова }
if OpenFile(DIRS[OWN]+'COUNTERS.SFM') then begin
for I:=0 to 26 do
if W then begin
W:=ReadFile(F_file,US,SizeOf(US));
if W then with US do begin
if F06L = $04 then F06L:=PASP[2].DE; { старые умолчания }
if F05_ = $0E then F05_:=PASP[3].DE; { заменить на новые }
W:=BKA(F06L,2,I) and
BKA(F05_,3,I) and
BKA(MGE_,4,I)
end
end;
Cls_File(F_file)
end;
if W then
if OpenFile(DIRS[OWN]+'USER_MGU.SFM') then begin
for I:=0 to 26 do
if W then begin
J:=(I+26) mod 27;
W:=ReadFile(F_file,TU,SizeOf(TU));
if W then with TU do begin
if _ZS_[1] = 1 then K:=1
else K:=0;
if _ZS_[2] = 1 then K:=K+2;
W:=BKA(K,5,J) and BKA(_POR,6,J);
for K:=1 to 10 do W:=W and BKA(_NR_[K ],K+ 6,J);
for K:=1 to 10 do W:=W and BKA(_NS_[K+1],K+16,J)
end
end;
Cls_File(F_file)
end;
PERS_INIT:=W;
Cls_File(P_file) end;
procedure OPEN_PERS;
begin if PERS_INIT then
if not PERS_Popn then PERS_Popn:=OpenPERS end;
procedure CLOS_PERS;
begin if PERS_Popn then Cls_File(P_file);
PERS_Popn:=false end;
{ REWR_PERSO : Объединенная операция чтения(+)/записи параметра настройки }
procedure REWR_PERS(F : integer; var P);
begin if 0 < F then DeVa(F,P); { Чтение. Значение по умолчанию }
if PERS_Popn then
with PASP[abs(F)] do
if SeekFile(P_file,OTCT[abs(F)]+OTCT[0]*LE) then begin
if 0 < F then begin
if ReadFile(P_file,P,LE) then
else DeVa(F,P)
end else begin
if WritFile(P_file,P,LE) then
end
end end;
{ REWR_PERS : Чтение(+)|Запись(-) одной настройки номер abs(F) }
procedure ORWC_PERS(F : integer; var P);
begin OPEN_PERS;
REWR_PERS(F,P);
CLOS_PERS end;
{ COME_PERS = 0 - O'K + P - пароль }
{ 1 - Не могу открыть файл PERSONAL.SFM }
{ 2 - Терминал запрещен }
{ 3 - Терминал блокирован }
function COME_PERS(pMG : boolean) : integer;
begin INIT_PERS;
OPEN_PERS;
if not PERS_Popn then begin
COME_PERS:=1;
Exit
end;
REWR_PERS(+1,IDnum);
STnum:=IDnum and 3;
if STnum = 2 then COME_PERS:=2 else begin { Терминал запрещен }
COME_PERS:=0;
if ADM <> '9' then case STnum of
0 : if pMG then begin { Только для вызова из MG }
IDnum:=(IDnum+4) or 3; { Блокировать открытый }
REWR_PERS(-1,IDnum)
end;
{ 1 : COME_PERS:=0; Вып.автоматически }
{ 2 : COME_PERS:=3; Вып.автоматически } { Терминал запрещен }
3 : COME_PERS:=3 { Терминал блокирован }
end
end;
CLOS_PERS end;
{ EXIT_PERS - Корректное исправление настроек терминалов }
{ при выходе из mg.exe }
procedure EXIT_PERS;
var X : word;
begin if ADM = '9' then Exit;
if STnum <> 0 then Exit; { Терминал был открыт|запрещен|блокирован }
OPEN_PERS; { Терминал был свободен: }
REWR_PERS(+1,X);
if X = IDnum then begin { блокировал я сам? }
IDnum:=IDnum and $FFFC; { Снять блокировку }
REWR_PERS(-1,IDnum)
end;
CLOS_PERS end;
{ CALL_PERS : Чтение/Запись группы параметров }
{ адеса параметров находятся в массиве A[H..K] }
procedure CALL_PERS(H,K : integer; var A);
type TX = array [1..1000] of pointer;
var I,J : integer;
begin if H < 0 then J:=-1
else J:=+1;
OPEN_PERS;
for I:=abs(H) to abs(K) do REWR_PERS(J*I,TX(A)[I]^);
CLOS_PERS end;
end.
|