Add files via upload

Author: silvercoder70

filepurger.dpr

@@ -0,0 +1,30 @@
+program filepurger;
+
+uses
+  Vcl.SvcMgr,
+  uMain in 'uMain.pas' {FilePurgerService: TService},
+  uDeleteFiles in 'uDeleteFiles.pas',
+  uDebugTool in 'uDebugTool.pas';
+
+{$R *.RES}
+
+begin
+  // Windows 2003 Server requires StartServiceCtrlDispatcher to be
+  // called before CoRegisterClassObject, which can be called indirectly
+  // by Application.Initialize. TServiceApplication.DelayInitialize allows
+  // Application.Initialize to be called from TService.Main (after
+  // StartServiceCtrlDispatcher has been called).
+  //
+  // Delayed initialization of the Application object may affect
+  // events which then occur prior to initialization, such as
+  // TService.OnCreate. It is only recommended if the ServiceApplication
+  // registers a class object with OLE and is intended for use with
+  // Windows 2003 Server.
+  //
+  // Application.DelayInitialize := True;
+  //
+  if not Application.DelayInitialize or Application.Installing then
+    Application.Initialize;
+  Application.CreateForm(TFilePurgerService, FilePurgerService);
+  Application.Run;
+end.

filepurger.dproj

@@ -0,0 +1,13 @@
+<?xml version="1.0" encoding="utf-8"?>
+<BorlandProject>
+	<Transactions>
+    <Transaction>2024/08/07 15:59:38.000.770,=C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\Unit1.pas</Transaction>
+    <Transaction>2024/08/07 16:47:17.000.731,=C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\Unit1.pas</Transaction>
+    <Transaction>2024/08/07 16:48:11.000.489,C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\Unit1.pas=C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\PurgeFiles\uMain.pas</Transaction>
+    <Transaction>2024/08/07 16:48:11.000.489,C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\Unit1.dfm=C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\PurgeFiles\uMain.dfm</Transaction>
+    <Transaction>2024/08/07 16:48:34.000.370,C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\Project1.dproj=C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\PurgeFiles\filepurger.dproj</Transaction>
+    <Transaction>2024/08/07 16:49:21.000.013,=C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\PurgeFiles\uDeleteFiles.pas</Transaction>
+    <Transaction>2024/08/07 17:10:32.000.776,=C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\PurgeFiles\Unit1.pas</Transaction>
+    <Transaction>2024/08/07 17:10:51.000.854,C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\PurgeFiles\Unit1.pas=C:\Users\tcoat\OneDrive\Documents\Embarcadero\Studio\Projects\PurgeFiles\uDebugTool.pas</Transaction>
+  </Transactions>
+</BorlandProject>

filepurger.dproj.local

@@ -0,0 +1,17 @@
+unit uDebugTool;
+
+interface
+
+procedure DebugMessage(AMessage: string);
+
+implementation
+
+uses Windows;
+
+procedure DebugMessage(AMessage: string);
+begin
+  OutputDebugString(PChar(AMessage));
+end;
+
+
+end.

filepurger.identcache

@@ -0,0 +1,56 @@
+unit uDeleteFiles;
+
+interface
+
+uses Classes, SysUtils;
+
+procedure DeleteFilesOlderThan(ADirectory: string; ATime: TDateTime);
+
+implementation
+
+uses
+  System.IOUtils,
+  System.Types,
+  WinApi.Windows,
+  uDebugTool;
+
+function FileTimeToDateTime(const AFileTime: TFileTime): TDateTime;
+var
+  LocalFileTime: TFileTime;
+  SystemTime: TSystemTime;
+begin
+  // Convert the file time to local file time
+  if not FileTimeToLocalFileTime(AFileTime, LocalFileTime) then
+    RaiseLastOSError;
+  // Convert the local file time to system time
+  if not FileTimeToSystemTime(LocalFileTime, SystemTime) then
+    RaiseLastOSError;
+  // Convert the system time to Delphi's TDateTime
+  Result := SystemTimeToDateTime(SystemTime);
+end;
+
+procedure DeleteFilesOlderThan(ADirectory: string; ATime: TDateTime);
+var
+  LFiles: TStringDynArray;
+begin
+  DebugMessage('begin DeleteFilesOlderThan');
+  DebugMessage('  Params: ADirectory=' + ADirectory + ',ATime=' + DateTimeToStr(ATime));
+
+  LFiles := TDirectory.GetFiles(ADirectory, '*',
+              TSearchOption.soTopDirectoryOnly,
+              function (const Path: string;
+                        const SR: TSearchRec): Boolean
+              begin
+                var dt := FileTimeToDateTime(SR.FindData.ftLastAccessTime);
+                Result := dt < ATime;
+              end);
+
+  for var LFileName in LFiles do
+  begin
+    DebugMessage('  deleting file ' + LFileName);
+  end;
+  DebugMessage('end DeleteFilesOlderThan');
+end;
+
+
+end.

filepurger.res

@@ -0,0 +1,13 @@
+object FilePurgerService: TFilePurgerService
+  DisplayName = 'FilePurgerService'
+  OnStart = ServiceStart
+  OnStop = ServiceStop
+  Height = 600
+  Width = 800
+  PixelsPerInch = 120
+  object Timer1: TTimer
+    OnTimer = Timer1Timer
+    Left = 230
+    Top = 130
+  end
+end

uDebugTool.pas

@@ -0,0 +1,141 @@
+unit uMain;
+
+interface
+
+uses
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
+  Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.ExtCtrls,
+  System.Types;
+
+type
+  TFilePurgerService = class(TService)
+    Timer1: TTimer;
+    procedure Timer1Timer(Sender: TObject);
+    procedure ServiceStart(Sender: TService; var Started: Boolean);
+    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
+  private
+    type TDeleteSettings = record
+      OlderThanDays: integer;
+      Directories: TStringDynArray;
+    end;
+
+    procedure LoadSettings(var AConfig: TDeleteSettings);
+    procedure LogSettings(const AConfig: TDeleteSettings);
+  public
+    function GetServiceController: TServiceController; override;
+    { Public declarations }
+  end;
+
+var
+  FilePurgerService: TFilePurgerService;
+
+implementation
+
+{$R *.dfm}
+
+uses
+  System.IOUtils,
+  System.IniFiles,
+  uDebugTool,
+  uDeleteFiles;
+
+procedure AddStringToArray(var Arr: TStringDynArray; const NewStr: string);
+begin
+  SetLength(Arr, Length(Arr) + 1);
+  Arr[High(Arr)] := NewStr;
+end;
+
+function IsArrayEmpty(const Arr: TStringDynArray): Boolean;
+begin
+  Result := Length(Arr) = 0;
+end;
+
+procedure ServiceController(CtrlCode: DWord); stdcall;
+begin
+  FilePurgerService.Controller(CtrlCode);
+end;
+
+function TFilePurgerService.GetServiceController: TServiceController;
+begin
+  Result := ServiceController;
+end;
+
+procedure TFilePurgerService.LoadSettings(var AConfig: TDeleteSettings);
+const
+  DefaultDays = 14;
+var
+  Settings: TIniFile;
+begin
+  var ConfigFile := TPath.ChangeExtension(ParamStr(0), '.ini');
+  Settings := TIniFile.Create(ConfigFile);
+  AConfig.OlderThanDays := Settings.ReadInteger('System', 'Days', DefaultDays);
+  SetLength(AConfig.Directories, 0);
+
+  var LCounter := 1;
+  var LDone := False;
+  while not LDone do
+  begin
+    var DirKey := 'Dir' + LCounter.ToString;
+    var LDir := Settings.ReadString('System', DirKey, EmptyStr);
+    if LDir = EmptyStr then
+      LDone := True
+    else
+    begin
+      AddStringToArray(AConfig.Directories, LDir);
+      Inc(LCounter);
+    end;
+  end;
+  Settings.Free;
+end;
+
+procedure TFilePurgerService.LogSettings(const AConfig: TDeleteSettings);
+begin
+  DebugMessage('begin Configuration');
+  DebugMessage('  .OlderThanDays=' + AConfig.OlderThanDays.ToString);
+  for var LI := Low(AConfig.Directories) to High(AConfig.Directories) do
+    DebugMessage('  .Directory' + LI.ToString + '=' + AConfig.Directories[LI]);
+  DebugMessage('end Configuration');
+end;
+
+procedure TFilePurgerService.ServiceStart(Sender: TService; var Started: Boolean);
+begin
+  Timer1.Enabled := true;
+  Started := True;
+  LogMessage('File Purger service started', EVENTLOG_INFORMATION_TYPE);
+end;
+
+procedure TFilePurgerService.ServiceStop(Sender: TService; var Stopped: Boolean);
+begin
+  Stopped := True;
+  LogMessage('File Purger service stopped', EVENTLOG_INFORMATION_TYPE);
+end;
+
+procedure TFilePurgerService.Timer1Timer(Sender: TObject);
+var
+  Config: TDeleteSettings;
+begin
+  Timer1.Enabled := false;
+
+  DebugMessage('begin TFilePurgerService.Timer1Timer');
+  try
+    LoadSettings(Config);
+    LogSettings(Config);
+    if (Config.OlderThanDays > 0) and
+      (not IsArrayEmpty(Config.Directories)) then
+    begin
+      var LDelOlderThan := Now - Config.OlderThanDays;
+      for var LDir in Config.Directories do
+        DeleteFilesOlderThan(LDir, LDelOlderThan);
+
+    end;
+    Timer1.Interval := 60 * 1000 * 15; {15 minutes}
+  except
+    on e: exception do
+      LogMessage('ManageDownloads::Exception=' + e.message);
+  end;
+  DebugMessage('end TFilePurgerService.Timer1Timer');
+
+  //Timer1.Enabled := True;
+end;
+
+end.