 {
 Универсальная программа сохранения данных в файл *.dat
 Сохраняет данные в суточный файл типа ppyymmdd
  pp - префикс
  yy - год
  mm - месяц
  dd - день
 Чтение файлов при помощи утилиты readdat.dll
 }
program _SAVEDAT;
const
 maxndat     = 32;
var
 Ok          : boolean;
 errors      : integer;
 errorcode   : integer;
 b           : boolean;
 i           : integer;
 ndat        : integer;
 cname       : array[1..maxndat] of string;
 cref        : array[1..maxndat] of real;
 tref        : array[1..maxndat] of integer;
 tagSAVER    : integer;
 tagSAVERERR : integer;
 fpath       : string;
 fprefix     : string;
 fname       : string;
 ms          : real;
 sec         : real;
 lastsec     : real;
 saveper     : real;
 {
 Процедура фиксирует ошибку
 }
 procedure errorfound;
 begin
  errors:=errors+1;
 end;
 {
 Процедура фиксирует ошибку файла
 }
 procedure savererror(code:integer);
 begin
  b:=rsettag(tagSAVERERR,rgettag(tagSAVERERR)+1.0);
 end;
 {
 Найти имя файла по текущей дате
 }
 procedure getfname(var f:string);
 var yy,mm,dd:string; t:real;
 begin
  t:=msecnow;
  yy:=str(ms2year(t) mod 100);
  while length(yy)<2 do yy:='0'+yy;
  mm:=str(ms2month(t) mod 100);
  while length(mm)<2 do mm:='0'+mm;
  dd:=str(ms2day(t) mod 100);
  while length(dd)<2 do dd:='0'+dd;
  f:=fpath+'\'+fprefix+yy+mm+dd+'.dat';
 end;
 {
 Функция извлечения данных
 }
 function getdata(i:integer):real;
 var crv,len,y:real; tag:integer;
 begin
  if (i<1) or (i>ndat) then y:=_nan else begin
   crv:=cref[i];
   if crv<>_nil then begin
    len:=crvlen(crv);
    if len=0 then y:=0 else y:=crvy(crv,len);    
   end else begin
    tag:=tref[i];
    if typetag(tag)=1 then y:=igettag(tag) else
    if typetag(tag)=2 then y:=rgettag(tag) else y:=_nan;
   end;
  end;
  if isnan(y) then savererror(1);
  getdata:=y;
 end;
 {
 Процедура инициализации и проверки тега
 }      
 procedure InitTag(var tag:integer; name:string; typ:integer);
 begin
  tag:=findtag(name);
  if (typ>0) and (typetag(tag)<>typ) then errors:=errors+1;
 end;
begin
 {
 Действия при старте
 }
 if runcount=1 then begin
  errors:=0;
  errorcode:=registererr('Ошибка _SAVEDAT.PAS');
  if reset('')<>0 then errorfound;
  if rewrite('')<>0 then errorfound;
  {
  read & check tags
  }
  InitTag( tagSAVER,    readini('WriteEnableTag'), 1);
  InitTag( tagSAVERERR, readini('WriteErrorsTag'), 2);
  {
  read & check file path
  }
  fpath:=readini('DataPath');
  fpath:=paramstr('DefaultPath '+fpath+' '+
                  paramstr('ExtractFilePath '+paramstr('DaqConfigFile')));
  fpath:=paramstr('FExpand '+fpath);
  if length(fpath)=0 then errorfound else
  if iand(getfattr(fpath),16)<>16 then errorfound;
  {
  read & check file prefix 
  }
  fprefix:=readini('FilePrefix');
  if length(fprefix)=0 then errorfound else fprefix:=copy(fprefix,1,2);
  if length(fprefix)<>2 then errorfound;
  {
  read & check data list
  }
  ndat:=0;
  Ok:=true;
  for i:=1 to maxndat do begin
   if Ok then begin
    cname[i]:=readini('DataCurve#'+str(i));
    cref[i]:=crvfind(cname[i]);
    tref[i]:=findtag(readini('DataTag#'+str(i)));
    if cref[i]<>_nil then begin
     ndat:=i;
     if tref[i]>0 then errorfound;
    end else
    if tref[i]>0 then begin
     cname[i]:=nametag(tref[i]);
     ndat:=i;
    end else Ok:=false;
   end;
   if not Ok then begin
    cname[i]:='';
    cref[i]:=_nil;
    tref[i]:=0;
   end;
  end;
  if ndat=0 then errorfound;
  {
  }
  lastsec:=secnow;
  saveper:=rval(readini('SavePeriod'));
  if isnan(saveper) then saveper:=1.0;
  {
  }
  if errors<>0 then b:=fixerror(errorcode);
  Ok:=(errors=0);
 end else
 {
 Действия при остановке
 }
 if isinf(runcount) then begin
  errors:=0;
  if reset('')<>0 then errorfound;
  if rewrite('')<>0 then errorfound;
  if errors<>0 then b:=fixerror(errorcode);
 end else 
 {
 Действия в цикле опроса
 }
 if Ok then begin
  if igettag(tagSAVER)>0 then begin
   sec:=secnow;
   if abs(sec-lastsec)>saveper then begin
    lastsec:=sec;
    {
    Найти имя файла по дате и префиксу
    }
    getfname(fname);
    {
    В начале файла - заголовок
    }
    if not fileexists(fname) then
    if rewrite(fname)=0 then begin
     write('Time_mS');
     for i:=1 to ndat do write(' ',cname[i]);
     writeln;
     if (rewrite('')<>0) or (ioresult<>0) then SaverError(2);
    end else SaverError(3);
    {
    Запись данных в файл
    }
    if append(fname)=0 then begin
     ms:=msecnow;
     write(ms:14:0);
     for i:=1 to ndat do write(' ',str(getdata(i)));
     writeln;
     if (rewrite('')<>0) or (ioresult<>0) then SaverError(4);
    end else SaverError(5);
   end;
  end;
 end;
end.
