//*********************************************************************
//*                 Check_Last_PurgeDate 2021-10-24                   *
//*                         >> OnStartup <<                           *
//*                                                                   *
//* Dieses Script raeumt taeglich alle abonnierten Guppen auf.        *
//*                                                                   *
//* Funktionalitaet: [x] neutral                                      *
//*                  [ ] nur Basis_Modul                              *
//*                  [ ] nur Pathfinder                               *
//*                                                                   *
//* Datum  : 25.04.2008                                               *
//* Autoren: Kai Jürges                                               *
//* Stand  : 24.10.2021                                               *
//*                                                                   *
//* DateiName : _i_OSt_Check_Last_PurgeDate.ds                        *
//* Einbindung: {$I _i_OSt_Check_Last_PurgeDate.ds}                   *
//* Aufruf    : Check_Last_PurgeDate;                                 *
//*                                                                   * 
//*********************************************************************
procedure Init_Check_Last_PurgeDate ( var FileName : String;
                                      var Wait     : LongInt
);

begin
//{-------------------------------------------------------------------}
//{                 Anwenderspezifische Einstellungen                 }
//{-------------------------------------------------------------------}

    // Dateiname zum Speichern, Pfad selbst anpassen!
    // !!Diese Datei wird automatisch angelegt!!
    FileName := GetCurrentDir + '\' + 'lastpurge.tmp';
     
    // Zeit, welche das Aufräumen ungefähr benötigt
    // Zeit in Sekunden
    Wait := 8; 

//{-------------------------------------------------------------------}
//{                       Ende der Einstellungen                      }
//{-------------------------------------------------------------------}

//{===================================================================}
//{           !!!  Ab hier bitte nichts mehr ändern  !!!              }
//{===================================================================}
end;

procedure SaveLastPurgeDate (FileName : string);

// Aktuelles Datum in Datei speichern
var
   f : Textfile;

begin
   AssignFile(f, FileName);
   Rewrite(f);
   TextWriteln(f, DateToStr(Date));
   CloseFile(f);
end; // procedure SaveLastPurgeDate

function CheckLastPurgeDate (FileName : String) : Boolean;

// Pruefe, ob heute schon ein Purge durchgefuehrt wurde
// Wenn ja: true
// Wenn nein: false
// Wenn Datei nicht existiert: false
var
   f   : TextFile;
   tmp : String;

begin
   if fileexists(fileName) then begin
      AssignFile(f, fileName);
      Reset(f);
      TextReadln(f, tmp)
      CloseFile(f);
      if DateToStr(Date) = tmp then begin
         result := true;
      end   
      Else begin
         result := false;
      end;   
   end
   Else 
      result := false;
end; // function CheckLastPurgeDate

function GetTickCount : cardinal; external 'GetTickCount@kernel32.dll stdcall';
  
procedure Delay(const Milliseconds: Word);

var DelayTill: LongWord;

begin
   DelayTill := GetTickCount + Milliseconds;
   while ((GetTickCount) < DelayTill) do begin
      Application.ProcessMessages;
      Sleep(0);
   end;
end;

procedure Check_Last_PurgeDate;

var 
   FileName : String;
   Wait     : LongInt;
begin
   Init_Check_Last_PurgeDate (FileName, Wait);
   // Heute schon Purge durchgefuehrt?
   if Not CheckLastPurgeDate (FileName) then begin
      // PURGE durchfuehren
      ADo('PurgeSubscribedGroups');
      Wait := Wait * 1000;
      Delay (Wait);
      // Datum speichern
      SaveLastPurgeDate (FileName);
   end;   
end;