unit whJPGDel;  {manages a background thread; deletes sessions after inactivity}
////////////////////////////////////////////////////////////////////////////////
//  Copyright (c) 1995-2003 HREF Tools Corp.  All Rights Reserved Worldwide.  //
//                                                                            //
//  This source code file is part of WebHub v2.018.  Please obtain a WebHub   //
//  development license from HREF Tools Corp. before using this file, and     //
//  refer friends and colleagues to href.com/webhub for downloading. Thanks!  //
////////////////////////////////////////////////////////////////////////////////

// Author of original version of this file: Michael Ax

{$I hrefdefines.inc}

{

save the component with the Active flag set true and the numeric parameters set:
TimeoutMin- how long (in minutes) before a session times-out and is deleted.
SweepDelayMS- how long to sleep before scanning the next file.

it's been implemented in a very un-oop manner, relying soley on globals
defined in the implementation to create and control a single thread from
even multiple instances of the component (which also does not shut down the
thread if is destroyed.) ..unorthodox, but compact and easy to distribute.

the reason that this code is going to be available in this for, and not be
built into the hub is largely this event:

OnFileDelete(const FileName:String;Session:Longint);

by having this event, you're enabled to load the session one last time
(by setting the app's session#) and updating whatever user-accounting
info you might want to change. (you must make a calls that use WebApp etc by
way of calling BackgroundDelete.Synchronize(YourProc) from the FileDelete event.}

interface

uses Windows, Classes, SysUtils;

//------------------------------------------------------------------------------

type
  TScanExecProc=function(const FileName:String):boolean of object;

  tBackgroundDelete= class(TThread)
  public
    function Proc(const FileName:String):boolean;
    function ScanAllFiles(const aPath,aSpec:String; Proc:TScanExecProc): integer;
    function ScanDirectory(const aPath,aSpec:String; Proc:TScanExecProc;SubDirs:Boolean): integer;
    //
    procedure Execute; override;
    procedure Synchronized;
    end;

var
  BackgroundDelete: tBackgroundDelete=nil;

//------------------------------------------------------------------------------

type
  TWebJPGsDeleteFile= procedure(const FileName:String;Session:Longint;var Continue:Boolean) of object;

  TWebJPGsDelete= class(TComponent)
  private
    procedure SetOnFileDelete(Value:TWebJPGsDeleteFile);
    function GetOnFileDelete:TWebJPGsDeleteFile;
    procedure SetActive(Value:Boolean);
    function GetActive:Boolean;
    procedure SetTimeoutMin(Value:Integer);
    function GetTimeoutMin:Integer;
    procedure SetSweepDelayMS(Value:Integer);
    function GetSweepDelayMS:Integer;
  public
    constructor Create(aOwner:TComponent); override;
    destructor Destroy; override;
  published
    property Active: Boolean read GetActive write SetActive;
    property TimeoutMin: integer read GetTimeoutMin write SetTimeoutMin;
    property SweepDelayMS: integer read GetSweepDelayMS write SetSweepDelayMS;
    property OnFileDelete: TWebJPGsDeleteFile read GetOnFileDelete write SetOnFileDelete;
    end;

procedure register;

implementation

uses
  WhConst, webInfou, ucString;

//------------------------------------------------------------------------------

var
  fOnFileDelete: TWebJPGsDeleteFile;
  TimeoutM: integer;   //min
  SweepDelay: integer; //ms
  fSessionsDir: String;
var
  NextDelay: integer;  //ms

//------------------------------------------------------------------------------

procedure Register;
begin
  RegisterComponents('eSolutions.nl',[TWebJPGsDelete]);
end;

function TBackgroundDelete.Proc(const FileName:String):boolean;
var
  i: integer;
  t: TDateTime;
  b: boolean;
begin
  Result:=True;
  try
    i:=FileAge(FileName);
    if i<>-1 then begin
      t:=FileDateToDateTime(i);
      b:=(now-t)*(86400 div 60)>TimeoutM;  //ucfile
      if b and assigned(fOnFileDelete) then
        fOnFileDelete(FileName
          ,StrToIntDef(leftof('.',ExtractFileName(FileName)),0)
          ,b);
      if b then
        DeleteFile(FileName);
      end;
  except
    Result:=False;
    end;
end;

//------------------------------------------------------------------------------
function TBackgroundDelete.ScanAllFiles(const aPath,aSpec:String; Proc:TScanExecProc): integer;
var
  SearchRec: TSearchRec;
begin
  try
{$IFDEF DELPHI6UP}
{$WARN SYMBOL_PLATFORM OFF}   // file attributes
{$ENDIF}
    Result:=FindFirst(TrailingBackSlash(aPath)+aSpec,faReadOnly+faArchive,SearchRec);
{$IFDEF DELPHI6UP}
{$WARN SYMBOL_PLATFORM ON}
{$ENDIF}
    if result=0 then
      repeat until
        not Proc(TrailingBackSlash(aPath)+searchRec.name)
        or Terminated
        or (FindNext(searchRec)<>0);
  finally
    FindClose(SearchRec);
    end;
end;

function TBackgroundDelete.ScanDirectory(const aPath,aSpec:String; Proc:TScanExecProc;SubDirs:Boolean): integer;
var
  SearchRec: TSearchRec;
begin
  Result:=ScanAllFiles(aPath,aSpec,Proc);
  {}
  if SubDirs then try {and recurse}
    if FindFirst(TrailingBackSlash(aPath)+'*.*',faDirectory,searchRec)=0 then
      repeat
        if (copy(searchRec.Name,1,1)<>'.')
        and ((SearchRec.Attr and faDirectory)= faDirectory) then //recurse
          ScanDirectory(TrailingBackSlash(aPath)+searchRec.name,aSpec,Proc,SubDirs)
        else
          if not terminated then
            sleep(NextDelay);
      until Terminated or (FindNext(searchRec)<>0);
  finally
    FindClose(SearchRec);
    end;
end;

procedure TBackgroundDelete.Execute;
begin
  Sleep(SweepDelay);
  while not ((assigned(WebInfou.WebInfo) and (WebInfou.WebInfo.isUpdated))
              or terminated) do
    Sleep(SweepDelay);
  if not terminated then
    Synchronize(Synchronized);
  while not terminated do begin
    NextDelay:=20;              //ucscndir
    ScanDirectory(fSessionsDir,'*.jpg',proc,True);
    NextDelay:=SweepDelay;
    while not terminated do begin
      sleep(SweepDelay);
      ScanDirectory(fSessionsDir,'*.jpg',proc,True);
      end;
    end;
end;

procedure TBackgroundDelete.Synchronized;
begin
  if assigned(WebInfou.WebInfo) then begin
    //TimeoutM:=WebInfou.WebInfo.WebDefault[cTimeoutM];
    //SweepDelay:=WebInfou.WebInfo.WebDefault[cSweepDelay];
    fSessionsDir:=WebInfou.WebInfo.WebDefault[cSessionsDir]
    end
  else
    Terminate;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

constructor TWebJPGsDelete.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
  TimeoutMin:=24*60;//1440, one day in minutes. //*60;
  SweepDelayMS:=100;
end;

destructor TWebJPGsDelete.Destroy;
begin
  Active:=False;
  inherited Destroy;
end;

//------------------------------------------------------------------------------
// set globals.

procedure TWebJPGsDelete.SetOnFileDelete(Value:TWebJPGsDeleteFile);
begin
  fOnFileDelete:=Value;
end;

function TWebJPGsDelete.GetOnFileDelete:TWebJPGsDeleteFile;
begin
  Result:=fOnFileDelete;
end;

procedure TWebJPGsDelete.SetTimeoutMin(Value:Integer);
begin
  if Value<>0 then
    TimeoutM:=value;
end;

function TWebJPGsDelete.getTimeoutMin:Integer;
begin
  Result:=TimeoutM;
end;

procedure TWebJPGsDelete.SetSweepDelayMS(Value:Integer);
begin
  if Value<>0 then
    SweepDelay:=value;
end;

function TWebJPGsDelete.GetSweepDelayMS:Integer;
begin
  Result:=SweepDelay;
end;

//------------------------------------------------------------------------------

procedure TWebJPGsDelete.SetActive(Value:Boolean);
begin
  if Value=GetActive then
    exit;
  if not GetActive then begin
    BackgroundDelete:=tBackgroundDelete.Create(True);
    BackgroundDelete.FreeOnTerminate:=True;
    BackgroundDelete.Resume;
  end else begin
    if assigned(BackgroundDelete) then
      BackgroundDelete.Terminate;
{      if WaitForSingleObject(BackgroundDelete.Handle,1500)=WAIT_OBJECT_0 then //Give the thread maximum 1500 ms to terminate on
        BackgroundDelete.Free;}
//      TerminateThread(BackgroundDelete.Handle,0);
    BackgroundDelete:=nil;
    end;
end;

function TWebJPGsDelete.GetActive:Boolean;
begin
  Result:=assigned(BackgroundDelete);
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

end.