{ -------------------------------------------------------------------- }
{ Dieser Quelltext ist urheberrechtlich geschuetzt.                    }
{ (c) 2006-2024 FreeXP, http://www.freexp.de                           }
{ CrossPoint ist eine eingetragene Marke von Peter Mandrella.          }
{                                                                      } 
{ Die Nutzungsbedingungen fuer diesen Quelltext finden Sie in der      }
{ Datei SLIZENZ.TXT oder auf http://www.crosspoint.de/oldlicense.html. }
{ -------------------------------------------------------------------- }

{$I XPDEFINE.INC }

unit timemark;

interface

procedure setmark(fl:string);
function getmark(fl:string):longint;

implementation

uses compdate,fileio,dos;

type tmark = record
       sig1,sig2,sig3,sig4: byte;
       mark: longint;
     end;

var rmark : tmark;
    res:integer;

function complong:longint;
var dt:datetime;
    code:integer;
    ft:longint;
begin
  if comp_YY='0000' then complong:=0
  else begin
    Val(comp_YY,dt.year,code);
    Val(comp_MO,dt.Month,code);
    Val(comp_DD,dt.Day,code);
    Val(comp_HH,dt.Hour,code);
    Val(comp_MI,dt.Min,code);
    Val(comp_SS,dt.Sec,code);
    Packtime(dt,ft);
    complong:=ft;
  end;
end;

procedure setmark(fl:string);
var f:file;
    size:longint;
begin
  rmark.sig1:=$46;
  rmark.sig2:=$58;
  rmark.sig3:=$50;
  rmark.sig4:=$0;
  rmark.mark:=complong;
  if rmark.mark=0 then exit;
  {$I-}
  assign(f,fl);
  reset(f,1);
  {$I+}
  if ioresult <>0 then exit;
  size:=filesize(f);
  seek(f,size);
  blockwrite(f,rmark,sizeof(rmark),res);
  close(f);
end;

function getmark(fl:string):longint;
var f:file;
    size:longint;
begin
  fm_ro;
  {$I-}
  assign(f,fl);
  reset(f,1);
  {$I+}
  fm_rw;
  if ioresult <>0 then exit;
  size:=filesize(f);
  seek(f,size-sizeof(tmark));
  blockread(f,rmark,sizeof(rmark),res);
  if res<>sizeof(tmark) then exit;
  if ioresult<>0 then exit;
  if (rmark.sig1=$46) and (rmark.sig2=$58) and (rmark.sig3=$50) and (rmark.sig4=$0) then
    getmark:=rmark.mark else getmark:=0;
end;

begin
end.
