{$I KEYS}
unit ExtrD;
interface
procedure get_de(Ind :string; var S :string; var N :double);
procedure set_de(Ind :string; S :string; N :double);
procedure Init_ExtrD_Unit(WorkDir :string);
implementation
uses Indextrd, WinOut;
type Ft = record case boolean of
true: (S :string;);
false: (B :array [0..255] of byte);
end;
var F :file of Ft;
iii :longint;
const _SUPERVALUE_ = 3.14159265358e27;
_SUPMIN_ = 3.14e27;
_SUPMAX_ = 3.15e27;
function IsSuperValue(x :double) :boolean;
begin
IsSuperValue:= (x > _SUPMIN_) and (x < _SUPMAX_)
end;
procedure IoChk;
begin
if ioresult <> 0 then begin Smsg(0, 'I/O error: EXTRD.DAT'); halt; end;
end;
procedure NormInd(var s :string);
var i :integer;
begin for i:=1 to length(s) do if s[i]=' ' then s[i]:='_'; end;
procedure get_de(Ind :string; var S :string; var N :double);
var i,k,L :longint;
c :integer;
t :Ft;
q :string;
begin
NormInd(Ind); i:=longint(IndFindName(Ind));
if i = 0
then begin S:=''; N:=0.0; iii:=-1; end
else begin
dec(i);
reset(F); IoChk;
iii:=i;
seek(F, i); IoChk;
read(F, t);
k:=pos(' ', t.S);
if k <> 0
then begin
q:=copy(t.S, 1, k-1);
if q = Ind
then begin
q:=copy(t.S, k+1, 2);
if q = 'N='
then begin Val(copy(t.S, k+3, 255), N, c); S:=''; end
else begin N:=_SUPERVALUE_; S:=copy(t.S, k+3, 255); end;
iii:=i;
end;
end;
close(F); IoChk;
end;
end;
procedure set_de(Ind :string; S :string; N :double);
var SS :string; NN :double; L :longint; t :Ft;
begin
get_de(Ind, SS, NN);
NormInd(Ind);
FillChar(t, sizeof(Ft), 0);
if IsSuperValue(N)
then t.S:=Ind + ' S=' + S
else begin
Str(N, t.S);
t.S:=Ind + ' N=' + t.S;
end;
reset(F); IoChk;
if iii <> -1
then begin
seek(F, iii); IoChk; write(F, t);
end
else begin
L:=filesize(F);
seek (F, L); IoChk; write(F, t);
IndAddName(Ind, pointer(L+1));
end;
close(F); IoChk;
end;
procedure Init_ExtrD_Unit(WorkDir :string);
var i,k,L :longint;
t :Ft;
q :string;
begin
assign(F, WorkDir + 'extrd.dat');
reset(F);
if ioresult <> 0 then rewrite(F);
IoChk;
L:=filesize(F);
for i:=1 to L
do begin
read(F, t);
k:=pos(' ', t.S);
if k <> 0
then begin
q:=copy(t.S, 1, k-1);
IndAddName(q, pointer(i))
end;
end;
close(F);
if ioresult <> 0 then (* *);
end;
begin
end.