 {
 Универсальная программа для сохранения данных в формате CRW по требованию.
 Для сохранения даных внешняя программа взводит тег запроса, программа по
 тегу запроса сохраняет данные и затем сбрасывает тег. Получается как бы
 "фотоснимок" интересующих данных.
 Через теги можно задавать текст имени окна, заголовка и метки при
 сохранении окна.
 Данные сохраняются в файл типа PPYYMMDD.DAT
 в окне под именем типа YYYY.MM.DD\hh:mm:ss-xxx
 где  PP            - префикс
      YY,YYYY,MM,DD - год, месяц, число
      hh,mm,ss      - часы, минуты, секунды
      xxx           - комментарий в заголовке окна
 }
program _savecrw;
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;
 tagWinCaption : integer;
 tagWinTitle   : integer;
 tagWinLabel   : integer;
 fpath         : string;
 fprefix       : string;
 fname         : string;
 wname         : string;
 clist         : string;
 {
 Процедура фиксирует ошибку
 }
 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+'.crw';
 end;
 {
 Найти текущую дату
 }
 procedure getdate(var f:string);
 var yy,mm,dd,hh,mn,ss:string; t:real;
 begin
  t:=msecnow;
  yy:=str(ms2year(t));
  while length(yy)<4 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;
  hh:=str(ms2hour(t) mod 100);
  while length(hh)<2 do hh:='0'+hh;
  mn:=str(ms2min(t) mod 100);
  while length(mn)<2 do mn:='0'+mn;
  ss:=str(ms2sec(t) mod 100);
  while length(ss)<2 do ss:='0'+ss;
  f:=extractword(1,sgettag(tagWinCaption));
  if length(f)>0 then f:='-'+f;
  f:=' '+yy+'.'+mm+'.'+dd+'\'+hh+':'+mn+':'+ss+f;
 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('Ошибка _savecrw.pas');
  if reset('')<>0 then errorfound;
  if rewrite('')<>0 then errorfound;
  fpath:='';
  fprefix:='';
  fname:='';
  wname:='';
  clist:='';
  {
  read & check tags
  }
  InitTag( tagSAVER,      readini('WriteEnableTag'), 1);
  InitTag( tagSAVERERR,   readini('WriteErrorsTag'), 2);
  InitTag( tagWinCaption, readini('WinCaptionTag'),  3);
  InitTag( tagWinTitle,   readini('WinTitleTag'),    3);
  InitTag( tagWinLabel,   readini('WinLabelTag'),    3);
  {
  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;
  clist:='';
  if ndat=0 then errorfound else begin
   for i:=1 to ndat do begin
    clist:=clist+cname[i];
    if i<ndat then clist:=clist+',';
   end;
  end;
  {
  }
  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);
  fpath:='';
  fprefix:='';
  fname:='';
  wname:='';
  clist:='';
 end else 
 {
 Действия в цикле опроса
 }
 if Ok then begin
  if igettag(tagSAVER)>0 then begin
    getfname(fname);
    getdate(wname);
    if not savecrw(fname+
                   ' '+wname+
                   ' '+extractword(1,sgettag(tagWinTitle))+
                   ' '+extractword(1,sgettag(tagWinLabel))+
                   ' '+clist)
    then b:=fixerror(errorcode);
    b:=isettag(tagSAVER,0);
  end;
 end;
end.
