(* OPEN_FMS использует: COVR_FMS *)
(* CRUF_FMS *)
(* DESK_FMS *)
(* D_UNIT *)
(* EXEC_FMS *)
(* FILE_FMS *)
(* HELP_FMS *)
(* IMPL_FMS *)
(* KEYS_FMS *)
(* LAYS_FMS *)
(* LOAD_FMS *)
(* MENU_FMS *)
(* OKHO_FMS *)
(* PERS_FMS *)
(* SELE_FMS *)
(* STAK_FMS *)
(* TEST_FMS *)
(* TYPE_FMS *)
(* UNIF_FMS *)
{$A+,B-,D-,E+,F-,G-,I+,L+,N-,O+,R+,S+,V+,X-}
{$M 16384,0,65536}
Unit OPEN_FMS;
INTERFACE
Uses D_unit, TYPE_FMS, LOAD_FMS, LAYS_FMS, FILE_FMS,
TEST_FMS, MENU_FMS, KEYS_FMS, STAK_FMS,
DOS, OKHO_FMS, DESK_FMS, SELE_FMS, HELP_FMS,
CRT, EXEC_FMS, UNIF_FMS, CRUF_FMS, PERS_FMS, COVR_FMS;
Var Name_Of_File : String[12]; { Имя.расширение редактируемого файла }
procedure Mode_F02;
function MembEmpGr : boolean;
procedure KillEmpGr;
procedure ReLinker(F : integer);
procedure GENERATION;
procedure WellCome;
procedure Come_Again;
procedure Good_HALT(IOR : integer);
procedure GetAdmMode;
{ Процедуры генерации и удаления групп полей }
{ Используют дополнительную память - EXEC_FMS }
function Init_SEQ(var SQ : pCKT ) : integer;
function Gene_SEQ( SQ : pCKT; F,A : integer) : integer;
function Make_SEQ( SQ : pCKT; Fn : PathStr) : integer;
IMPLEMENTATION
{$I IMPL_FMS.PAS } { SiCoMe }
VAR TEDI : ^TMGE_type; { NIL - автономный вызов редактора }
W_name,M_name : String[80];
W_file,M_file : file;
procedure GetAdmMode;
function CC(X,Y : integer; A : char) : boolean;
begin with AltSCR[Y,X] do
CC:=(att = 0) and (txt = A)
end;
procedure BB(X,Y : integer);
begin AltSCR[Y,X].txt:=' '
end;
begin ADM:='0';
if CC(1,1,'a') and CC(1,2,'D') and CC(2,1,'m') then begin
BB(1,1); BB(1,2); BB(2,1);
ADM:='9'
end end;
{ CAPTURE - Захват редактируемого файла }
{ if W_name <> '' then Рабочий файл создан }
{ if M_name <> '' then Основной файл открыт }
function CAPTURE : integer; { 0|411|412|413 }
var S : String;
I : integer;
T : LongInt;
begin CAPTURE:=412; { Не могу создать временный файл }
if Create_Unic_File(S) <> 0 then Exit else begin
assign(M_file,S);
assign(W_file,S);
{$I-} rewrite(M_file,1);
{$I+} if IOresult <> 0 then Exit;
{$I-} reset(W_file,1);
{$I+} I:=IOresult;
Cls_File(M_file);
if I <> 0 then begin
KillFile(S);
Exit
end
end;
W_name:=S;
S:=DIRS[WRK]+Name_Of_File;
{ 414 } CAPTURE:=414; { Не могу открыть файл }
if not FindFile(S) then begin
KEYS_FMS.SKY:=true;
Exit
end;
{ 411 } CAPTURE:=411; { Не могу открыть файл }
assign(M_file,S);
T:=TimeSec;
repeat
{$I-} reset(M_file,1);
{$I+} I:=IOresult;
until (I = 0) or TimeOvr(T,3);
if I <> 0 then Exit;
M_name:=S;
{ 413 } CAPTURE:=413; { Ошибка чтения/записи на HD }
if MoveFile(M_file,W_file,FileSize(M_file))
{ 0 } then begin CAPTURE:=0; reset(W_file,1) end { ReOpen W_file }
else Cls_File(M_file) end;
procedure Good_HALT(IOR : integer);
var I : integer;
begin case IOR of
401 : Bye_Serv('Файл отсутствует или блокирован');
402 : Bye_Serv('Ошибка чтения из файла');
403 : Bye_Serv('Некорректная структура файла');
404 : Bye_Serv('Недостаточно оперативной памяти');
405 : Bye_Serv('Ошибка последовательности полей');
410 : Bye_Serv('Ошибка Config.sfm');
411 : Bye_Serv('Не могу открыть файл');
412 : Bye_Serv('Не могу создать временный файл');
413 : Bye_Serv('Ошибка чтения/записи на HD');
414 : Bye_Serv('Файл отсутствует');
415 : Bye_Serv('Запещенный код терминала.');
end;
if TEDI = NIL then SetOldChars else with TEDI^ do begin
RES_:=IOR;
SKY_:=KEYS_FMS.SKY;
MDS_:=0;
for I:=1 to 6 do
if Modes[I] then MDS_:=MDS_ + (1 shl I)
end;
if W_Name <> '' then begin
Cls_File(W_file);
KillFile(W_name)
end;
if M_Name <> '' then Cls_file(M_file);
Return_SP(SP_screen); { Восстановить экран }
POP(SCR);
DoneCTEK; { Закрыть Стек на диске }
Init_Gey;
DoneTabl; { Закрыть настройку на Help Ucomp.tpu }
Halt end;
procedure OPEN_MESSAGE(Mn : String; Md : boolean);
begin if OpnMed(Mn) then Exit;
if Md then BornServ('Повторная загрузка',Name_Of_File);
Good_Halt(Err_D_Init) end;
{ LoopField : L - счетчик всех строк сообщения }
{ K - счетчик строк, представленных на экане }
procedure LoopField(H : pHead; var L,K : integer);
var I : integer;
procedure MAM(B : boolean);
begin L:=L+1;
if B then begin ONEMAP(L); K:=K+1 end
else ZERMAP(L)
end;
procedure Loop4(H : pHead; O : boolean);
var I : integer;
begin with H^.BDS[1] do begin
Sset(BOS,OBS,O);
MAM(true)
end;
for I:=2 to H^.HSF do
with H^.BDS[I] do begin
Sset(BOS,OBS,false);
MAM(not Sask(BOS,EMP))
end
end;
begin if H = NIL then begin
MAM(true);
Exit
end;
for I:=1 to H^.HSF do
with H^.BDS[I] do
if DTL = NIL then MAM(true) { ??????? }
else if DTL^.KND = 8 then MAM(true)
else Loop4(DTL,Sask(BOS,OBS))
end;
function Ko_CTPOK(H : pHead) : integer;
var I,N,L : integer;
begin L:=0;
N:=0;
if H = NIL then N:=1
else L:=H^.HSF;
for I:=1 to L do
with H^.BDS[I] do
if DTL^.KND = 8 then N:=N+1
else N:=N+DTL^.HSF;
Ko_CTPOK:=N end;
function Tail_Linker : integer;
var I,J,L,K : integer;
prevDTL : pHead;
procedure Loop2(H : pHead);
begin if (H <> NIL) and (FirstWork = 0) then FirstWork:=K+1;
LoopField(H,L,K);
mLastWork:=K
end;
begin for I:=1 to MEAD^.HSF do MEAD^.BDS[I].CR_TOX:=0;
FITEK:=0;
PrepServ(' ',$07,'±',SVpam,MEAD^.HSF);
FirstWork:=0;
mLastWork:=0;
prevDTL:=NIL; { Для поиска первой позиции Curs }
L:=0;
K:=0;
for I:=1 to MEAD^.HSF do
with MEAD^.BDS[I] do begin
LoadField(I);
LinkField; { LEYS_FMS Первая загрузка поля }
TestField;
MarkServ(I);
if DTL <> NIL then
if prevDTL = NIL then with Glob_Menu.Mafi do
if K <= YK-YH then Glob_Menu.Curs:=K+1;
prevDTL:=DTL;
Loop2(DTL);
FITEK:=-abs(FITEK);
CR_FRX:=Ko_CTPOK(DTL)
end;
DoneServ;
mLastWork:=K-mLastWork;
Tail_Linker:=K end;
function Linker : integer;
var I : integer;
begin BornServ('Загрузка',Name_Of_File);
I:=CAPTURE;
if I <> 0 then Good_Halt(I);
OPEN_MESSAGE(W_name,false);
if TEDI = NIL then begin
with MESSAGE^ do
if INF[1] = 0 then begin
INF[1]:= 1; { Установить режимы редактора }
Modes[Soun]:=false;
Modes[Colo]:=true;
Modes[UpCa]:=true;
Modes[Defi]:=true;
Modes[Drus]:=true;
Modes[Pinf]:=true
end else
for I:=1 to 6 do Modes[I]:=(INF[I+1] <> 0)
end;
Linker:=Tail_Linker end;
procedure GENERATION;
var H,K,I,L,P,Q,Ha,Ko : integer;
Ab : String[8];
SQ : pCKT;
begin GrandCorr:=true;
Wite_Gey;
H:=abs(FITEK); { [H..K] - группа }
with MEAD^.BDS[H] do begin
Ha:=Grupa_VRF(VRF).H;
Ko:=Grupa_VRF(VRF).K;
K:=H+Ko-Ha-1
end;
Ab:=MESSAGE^.ABB;
P:=0;
Q:=0;
for I:=1 to MEAD^.HSF do begin
L:=MEAD^.BDS[I].CR_FRX;
P:=P+L;
if I < H then Q:=Q+L
end;
I:=Init_SEQ(SQ );
if I = 0 then I:=Gene_SEQ(SQ,H,1);
if I = 0 then I:=Make_SEQ(SQ,'' );
if I <> 0 then begin
BornServ('Генерация','группы полей');
Bye_Serv('Ошибка '+NNN(I));
Exit
end;
OPEN_MESSAGE(D_Init_Name,true);
L:=0; { Параметр сдвига карты }
for I:=H to K do
with MEAD^.BDS[I] do begin
CR_TOX:=0; { !! Перед LoadField !! }
LoadField(I);
CR_FRX:=Ko_CTPOK(DTL);
L:=L+CR_FRX
end;
for I:=P downto Q+1 do { Сдвиг карты }
if TSTMAP(I) then ONEMAP(I+L)
else ZERMAP(I+L);
L:=0;
for I:=H to K do { Включить дополнительные поля }
with MEAD^.BDS[I] do begin
LoadField(I);
LoopField(DTL,Q,L);
FITEK:=-abs(FITEK);
TestField
end;
with Glob_Menu do begin { Исправить меню }
Kall:=Kall+L;
for I:=Curs to Kscr do Codul[I]:=0
end end;
{ FullBody+FullHead - проверка на наличие символов введенных с клавиатуры }
{ Бит EMP не работает в случае структуры, содержащей только контексты }
function FullBody(H : pHead; N : integer) : boolean;
var I,L,M : integer;
begin FullBody:=true;
TEHT(H,N,L,M);
with H^.BDS[N] do
if Sask(BOS,RP_BGN)
then Exit
else for I:=L+1 to L+M do
if (CTP^[I] <> UNC) and (CTP^[I] <> ' ') then Exit; { Only Spaces }
FullBody:=false end;
function FullHead(H : pHead; N : integer) : boolean;
var I : integer;
begin with H^.BDS[N] do begin
IF DTL = NIL THEN begin { Выход из рекурсии }
FullHead:=FullBody(H,N);
Exit
end;
FullHead:=true;
for I:=1 to DTL^.HSF do
if FullHead(DTL,I) then Exit;
FullHead:=false
end end;
function FullField(F : integer) : boolean;
begin if Lask(MEAD,F,EMP) then FullField:=false else begin
LoadField(F);
FullField:=FullHead(MEAD,F)
end end;
{ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
{ :::::::::::::::::::::: COCTABHOE ::::::::::::::::::::::::::::: }
{ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
{ HLP : $FFFF - исключен из рассмотрения }
{ $0000 - пассивный генератор или 0-поле }
{ $0001 - активный генератор }
function Compl_Gr : boolean; { True, если сообщение содержит }
var I,C,L : integer; { активные генераторы }
begin Compl_Gr:=false;
for I:=1 to MEAD^.HSF do
with MEAD^.BDS[I] do begin
HLP:=$0000;
if AGENT(I,C,L) then begin
HLP:=$0001;
Compl_Gr:=true
end;
end end;
function L_gen(V : pointer) : integer; { Количество задействованных полей }
var R : integer;
begin with Grupa_VRF(V) do begin
R:=K-H;
L_gen:=R*KG
end end;
function HavEmpGr : boolean; { Наличие незаполненных групп }
var I,N,C,L : integer;
function E_Gen(N,C,L : integer) : boolean;
var I,J : integer;
W : boolean;
begin E_Gen:=true;
for I:=1 to C do begin
W:=true;
for J:=1 to L do begin
N:=N-1; { Параметр процедуры E_Gen }
if W then
if Type_Field(N) <> 1 then W:=(not FullField(N))
end;
if W then Exit;
end;
E_Gen:=false
end;
begin HavEmpGr:=true;
N:=0;
for I:=1 to MEAD^.HSF do
if AGENT(I,C,L) then begin
if C*L <= N then
if E_gen(I,C,L) then Exit;
N:=0
end else N:=N+1;
HavEmpGr:=false end;
function Kill_Back(F : integer) : integer;
var I,J,K,L,M,N,R,G,D : integer;
W : boolean;
procedure MarkForKill(H,K : integer);
var I : integer;
begin for I:=H to K do MEAD^.BDS[I].HLP:=$FFFF;
end;
begin Kill_Back:=0;
if not AGENT(F,G,L) then Exit;
W:=true;
D:=0; { Количество групп, отмеченных на удаление }
for M:=1 to G do begin
J:=F-1;
W:=true;
R:=L;
while 0 < R do begin
F:=F-1;
if MEAD^.BDS[F].HLP <> $FFFF then begin
R:=R-1;
if AGENT(F,K,N) then begin
R:=R+(K-1)*N;
W:=false
end;
if W then
with MEAD^.BDS[F] do
if DTL <> NIL then
if VRF = NIL then W:=(not FullField(F))
end
end;
D:=D+1;
if W and (D < G) then MarkForKill(F,J)
else D:=D-1;
end;
Kill_Back:=D end;
procedure MarkEmpGr;
var I,R : integer;
begin for I:=1 to MEAD^.HSF do
with MEAD^.BDS[I] do
if HLP = $0001 then
with Grupa_VRF(VRF) do begin
KG:=KG-Kill_Back(I);
if KG = 1 then HLP:=$0000
end end;
procedure ReLinker(F : integer);
var I,K,L : integer;
begin Serv.WOS:=true; { Блокировать окно процесса }
with Glob_Menu do begin
Kall:=Tail_Linker;
for K:=1 to Kscr do Codul[K]:=0
end;
L:=1;
with MEAD^ do
if F <= HSF then
for I:=1 to F-1 do L:=L+BDS[I].CR_FRX;
K:=0;
for I:=1 to L do
if TSTMAP(I) then K:=K+1;
AddrCurs(aGlob,K);
SearCurs(aGlob);
GrandCorr:=true end;
{ KILL_SEQ : Удаление предварительно отмеченных полей }
{ Res : 0 - O'K Message Close }
{ 1 - Не хватает оперативной памяти Message Open }
{ 2 - Ошибка при записи на диск Message Open }
function KILL_SEQ : integer;
var I,K : integer;
SQ : pCKT;
begin K:=INIT_SEQ(SQ);
if K = 0 then begin
for I:=1 to MEAD^.HSF do
with MEAD^.BDS[I] do
if HLP <> $FFFF then begin
Inc(K);
SQ^[K]:=SQ^[I];
if VRF <> NIL then
SQ^[K].GEN:=Grupa_VRF(VRF).KG
end;
SQ^[0].FLD:=K;
K:=MAKE_SEQ(SQ,'')
end;
KILL_SEQ:=K end;
{ MembEmpGr = Есть активные генераторы+Есть пустые группы }
function MembEmpGr : boolean;
begin if Compl_Gr then MembEmpGr:=HavEmpGr { Нет активных генераторов }
else MembEmpGr:=false end;
{ KillEmpGr = Удалить пустые группы полей }
procedure KillEmpGr;
var K : integer;
begin Wite_Gey;
MarkEmpGr;
WritField;
if KILL_SEQ <> 0 then Exit;
OPEN_MESSAGE(D_Init_Name,true);
Serv.WOS:=true;
with Glob_Menu do begin
Kall:=Tail_Linker;
if Kall < Base+KScr then begin
Base:=Kall-Kscr;
if Base < 0 then begin
Base:=0;
Curs:=Kall
end
end;
for K:=1 to Kscr do Codul[K]:=0
end;
SearCurs(aGlob);
GrandCorr:=true end;
procedure PARAMOUNT;
var K : integer;
S : String[12];
procedure Get_Name_Of_File(S : String);
begin S:=NameFile(Fexpand(S));
DIRS[WRK]:=NumbStr(1,S);
Name_Of_File:=NumbStr(2,S)+NumbStr(3,S);
S:=NameFile(Fexpand(ParamStr(0)));
DIRS[OWN]:=NumbStr(1,S)
end;
begin TEDI:=Bgn_Exe;
if TEDI <> NIL then
with TEDI^ do begin
Move(DRS_^,DIRS,SizeOf(DIRS)); { Сформировать DIRS }
ADM:=ADM_;
Get_Name_Of_File(NAF_);
for K:=1 to 6 do Modes[K]:=odd(MDS_ shr K);
EVENTS:=EVT_; { Настройка контроля каталогов }
Exit
end;
{ Dell DESA_CONT; FOTO_FMS Проверка полномочий }
K:=ParamCount;
if K = 0 then begin
writeln('The MT Editor CopyRight (C) 1997 EDI-Press Ltd.':79);
writeln;
writeln('MS-DOS>mge [Directiry\]FileName.Ext [MODE]');
Halt
end;
if DiskFree(0) <= 16396 then Halt;
GetAdmMode;
(**** ADM:='0';
if 1 < K then begin
S:=ParamStr(2);
UpCaseStr(S);
if S = 'ADM' then ADM:='9';
end; ****)
SetNewChars; { STAK_FMS } { Исправить таблицу кодов }
Get_Name_Of_File(ParamStr(1));
DIRS[TMR]:=DIRS[WRK] end;
{ Load_Conf_Dir : DIRS[XXX]:=Directory(S) | '' }
procedure Load_Conf_Dir(XXX : integer; S : String);
begin DIRS[XXX]:='';
if SiCoMe(S) then
if Exis_Dir(S) then DIRS[XXX]:=S end;
procedure Make_Line_25;
var S5,S6,S7,S8 : String[7];
begin if DIRS[RDY] = '' then S5:=''
else S5:='5Экспрт';
if DIRS[SHB] = '' then begin S6:='' ; S8:='' end
else begin S6:='6Импорт'; S8:='8Карман' end;
S7:='MGE_'+MESSAGE^.ABB;
if FindFile(DIRS[OWN]+S7+'.EXE')
then S7:='7Сброс '
else S7:='';
LaLa:='1Помощь2Сохран3ПереХд4Формы '+S5+S6+S7+S8+'9Режимы'end;
procedure WellCome;
var I,L : integer;
S : String;
begin {*1* Подготовка ***}
W_name:='';
M_Name:='';
FillChar(DOMAP,2*COMAP+2,0);
FillChar(FIMAP,2*COMAP+2,0);
PARAMOUNT;
Termi:=UpCase(Name_Of_File[1]);
SVpam:=$30; { OVER_FMS - Цвета меню }
SVpen:=$31;
SVbar:=$0F;
Fini_Gey; { Включить клавиатуру }
InitCTEK(DIRS[TMR]); { Открыть стек на диске }
PUSH(SCR,SizeOf(SCR)); { Спасти экран }
SP_screen:=Get_sp;
Test_Diag:=false; { Отк.диагностику проверок }
GrandCorr:=false; { Сообщение не редактир. }
{ Разрисовать экран }
EmpWin( 1, 1,80, 1,CFsys);
EmpWin( 1, 2,80,21,CPsys);
EmpWin( 1,22,80,24,CDsys);
Line_25('');
for I:=3 to 20 do ISC(78, I,'|',CPsys);
for I:=2 to 79 do ISC( I, 2,'-',CPsys);
for I:=2 to 79 do ISC( I,21,'-',CPsys);
OnScrXYA(2,1,CFsys,'Редактор сообщений: '+Name_Of_File);
if TEDI = NIL
then OnScrXYA(39,1,$36,'CopyRight (C) 1997 EDI-Press Ltd.');
with Glob_Menu do begin
CoMa:=CMfon;
RescFul(Mafi,2 ,3,80,20)
end;
SimpMenu(Glob_Menu);
I:=COME_PERS(false);
if I = 2 then begin { Запрещенный терминал }
BornServ('Загрузка',Name_Of_File);
Good_Halt(415)
end;
S:=ConTake(Termi);
if S <> '' then begin
Bye_Serv(S);
Good_Halt(0)
end;
ConSave;
Load_Conf_Dir(RDY,'EXPORT'); { Каталог экспортеров. F5 }
Load_Conf_Dir(SHB,'IMPORT'); { Каталог импортеров. F6 }
if DIRS[SHB] = ''
then Load_Conf_Dir(SHB,'LOADIR'); { LOADIR = old IMPORT }
InitTabl(DIRS[OWN]+'MESSAGES.CMP');
L:=Linker;
Make_Line_25; { Сделать последнюю строку }
with MESSAGE^ do begin
I:=Length(ABB)+Length(FUN)+3;
I:=(77-I) div 2;
OnScrXYA(I,2,CMpam,' '+ABB+' '+FUN+' ')
end;
Help_Ini;
{*2* Редактирование ***}
MenuInit(aGlob,L);
SearCurs(aGlob) end;
procedure Padre(H : pHead);
var L,K : integer;
begin if H^.KND <> 4 then Exit;
L:=0;
for K:=1 to H^.HSF do
if not Lask(H,K,EMP) then begin
L:=L+1;
if L < K then begin
CopyFore(H,K,L); { SELE_FMS }
KillBody(H,K );
FITEK:=-abs(FITEK)
end
end end;
procedure Mode_F02;
var I,J : integer;
begin CuSh(false);
BornServ('Запись',Name_Of_File);
PrepServ('±',SVpam,' ',$07,MEAD^.HSF);
with MESSAGE^ do
for I:=1 to 6 do
if Modes[I] then INF[I+1]:=1
else INF[I+1]:=0;
WritField; { Load_FMS }
MarkServ(1);
if SeekFile(M_file,0) then begin
if D_Back(M_file) then begin
I:=0;
if FilePos(M_file) < FileSize(M_file) then begin
{$I-} Truncate(M_file);
{$I+} I:=IOresult
end;
reset(M_file,1); { ReOpen M_file }
GrandCorr:=(I <> 0) { FALSE - O'K }
end
end;
if GrandCorr then Bye_Serv('Ошибка записи на HD') else begin
D_Close;
OPEN_MESSAGE(M_name,false);
for I:=1 to MEAD^.HSF do begin { Compress }
LoadField(I);
MarkServ(I);
with MEAD^.BDS[I] do
if DTL <> NIL then
for J:=1 to DTL^.HSF do Padre(DTL^.BDS[J].DTL)
end;
WritField;
D_Close;
OPEN_MESSAGE(W_name,false);
DoneServ
end;
if TEDI <> NIL then TEDI^.DRS_:=NIL; { SAVE-отметка }
CuSh(true) end;
{ Come_Again : Выход из MGE.EXE }
procedure Come_Again; { + Ответ вызывающей программе }
begin D_Close1;
Good_HALT(0) end;
{ Init_SEQ : Построить текущую последовательность полей сообщения }
{ Res = 0 - O'K }
{ Res = 1610 - не хватает оперативной памяти }
{ +SQ = указатель на последовательность полей }
function Init_SEQ(var SQ : pCKT) : integer;
var I : integer;
begin Init_SEQ:=1610;
if OpnNewInd(true) then begin { Обновить присоединенную память }
GetAddMem(SQ,SizeOf(CKT));
if SQ <> NIL then begin
Init_SEQ:=0;
SQ^[0].FLD:=MEAD^.HSF;
for I:=1 to MEAD^.HSF do begin
SQ^[I].FLD:=I;
SQ^[I].GEN:=0;
with MEAD^.BDS[I] do
if VRF <> NIL then
with Grupa_VRF(VRF) do SQ^[I].GEN:=Kg
end
end
end end;
{ Gene_SEQ : В последовательности SQ генератор F выполнить A раз }
{ Res = 0 - O'K }
{ 1611 - Ошибка алгоритма. Нет указанного поля. }
{ 1612 - Ошибка алгоритма. Указанное поле - не генератор }
{ 1613 - Ошибка алгоритма. Недопустимое к-во генераций }
{ 1614 - Ошибка алгоритма. Мала константа CCK }
{ 1615 - Ошибка алгоритма. Не найдено поле }
function Gene_SEQ(SQ : pCKT; F,A : integer) : integer;
var I,J,C,D,E,M,FH,FK : integer;
begin C:=SQ^[0].FLD;
if (F < 1) or (C < F) then begin
Gene_SEQ:=1611;
Exit
end;
with SQ^[F] do begin
E:=abs(FLD);
D:=GEN
end;
with MEAD^.BDS[E] do begin
if VRF = NIL then begin
Gene_SEQ:=1612;
Exit
end;
with Grupa_VRF(VRF) do begin
if KP < D+A then begin
Gene_SEQ:=1613;
Exit
end;
FH:=H;
FK:=K
end
end;
M:=FK-FH;
E:=A*M; { Количество добавляемых полей }
if CCK < C+E then begin
Gene_SEQ:=1614;
Exit
end;
Inc(SQ^[0].FLD,E); { + К-во полей }
Inc(SQ^[F].GEN,A); { + К-во генераций }
for I:=0 to C-F do SQ^[C+E-I]:=SQ^[C-I];
D:=0;
for I:=FH to FK-1 do begin
C:=F-M;
with MEAD^ do begin
repeat
Inc(D);
if HSF < D then begin
Gene_SEQ:=1615;
Exit
end;
until BDS[D].LFT = I;
if BDS[D].VRF = NIL then E:=0
else E:=1
end;
for J:=1 to A do begin
C:=C+M;
SQ^[C].FLD:=-D;
SQ^[C].GEN:= E
end;
F:=F+1
end;
Gene_SEQ:=0 end;
{ FILE_SEQ : Открыть файл для записи нового W-формата }
{ if Fn = '' then - построить временный }
{ else - открыть указанный }
{ RES = TRUE - файл открыт }
{ FALSE = файл не существует }
function FILE_SEQ(var Fo : file; var Fn : PathStr) : boolean;
var CistMed : String;
NoErr : boolean;
begin NoErr:=true;
CistMed:=D_Init_Name;
if Fn = '' then NoErr:=Crunf(CistMed) { CRUF_FMS }
else CistMed:=Fn;
if NoErr then begin
NoErr:=false;
Assign(Fo,CistMed);
{$I-} Rewrite(Fo,1); {$I+}
if IOresult = 0 then
if WritFile(Fo,medMEDmed,10) then NoErr:=true
else ClerFile(Fo)
end;
FILE_SEQ:=NoErr end;
{ Make_SEQ : SQ - новая последовательность полей в сообщении }
{ Перестроить сообщение }
{ Res : 0 - O'K Message Close }
{ 1610 - Не хватает оперативной памяти Message Open }
{ 1616 - Ошибка при записи на диск Message Open }
function Make_SEQ(SQ : pCKT; Fn : PathStr) : integer;
var LL,MM : LongInt;
CEL01 : pointer;
CEL0 : pMessage;
CDL0 : word;
Fo : file;
RC : record O,S : word end absolute CEL0;
begin LL:=MEAD^.HSF;
MM:=SQ^[0].FLD;
LL:=LongInt(SizeOfMessa)+(MM-LL)*LongInt(SizeOf(Body));
CDL0:=LL;
if CDL0 < SizeOfMessa then CDL0:=SizeOfMessa; { !!! }
GetAddMem(CEL01,CDL0+16); { Новый 0-й элемент }
if CEL01 = NIL then begin
Make_SEQ:=1610; { Не хватает оперативной памяти }
Exit
end;
CEL0:=CEL01; { Выравнять адрес памяти }
if RC.O <> 0 then begin Inc(RC.S); RC.O:=0 end;
if not FILE_SEQ(Fo,Fn) then begin
MAKE_SEQ:=1616; { Ошибка записи на диск }
Exit
end;
if D_MAKE(SQ,CEL0,CDL0,Fo) then begin { D_Unit }
Cls_File(Fo);
MAKE_SEQ:=0;
D_Close1;
if Fn = '' then begin
KillFile(D_Init_Name);
Rename(Fo,D_Init_Name)
end
end else begin
ClerFile(Fo);
MAKE_SEQ:=1616
end end;
end.
{ Распределение каталогов DIRS в mge.exe }
{ 0 OWN - каталог для mge.exe, config.sfm, messages.cmp }
{ 1 WRK - каталог с текущим сообщением }
{ 2 RDY - каталог экспортеров F5 }
{ 3 SHB - каталог импортеров F6 + F8 }
{ 4 PFM - ///////////////////////////////////////////// }
{ 5 MTF - ///////////////////////////////////////////// }
{ 6 TMR - каталог временных файлов: из mg.exe | = WRK }
|