Stores data in a specified storage folder, all stored files are stored in a flat dir structure, no sub folders, filenames are hashed using md5. In the root folder, a hidden file "cache.ini" will be created to store cache time, and other data

udiskcache.pas

unit uDiskCache;

interface

uses System.SysUtils, System.Classes, System.IOUtils, System.DateUtils,
  FMX.Types, IniFiles, System.Generics.Collections;

type
  {
    Stores data in a specified storage folder, all stored files are
    stored in a flat dir structure, no sub folders, filenames are hashed using
    md5.

    In the root folder, a hidden file "cache.ini" will be created to store
    cache time, and other data
  }
  TCacheFilenames = TDictionary<String, String>;

  TDiskCache = class(TObject)
  private
    fCacheDatFilename: String;
    fCacheDat: TIniFile;
    fStorageRoot: String;

    function Hash(AName: String): String;
  public
    constructor Create(AStorageRoot: String);
    destructor Destroy; override;

    procedure DeleteExpired;
    procedure DeleteAll;

    function CacheTime(AName: String): TDateTime;
    function CacheExists(AName: String): Boolean;
    function GetFilename(AName: String): String;
    function IsExpired(AName: String): Boolean;
    procedure Delete(AName: String);

    procedure Store(AName, AValue: String; AExpireDelta: TDateTime = OneHour); overload;
    function Get(AName: String; out AValue: String; ACheckExpire: Boolean = True): Boolean; overload;

    procedure Store(AName: String; AValue: TBitmap; AExpireDelta: TDateTime = OneHour); overload;
    function Get(AName: String; out AValue: TBitmap; ACheckExpire: Boolean = True): Boolean; overload;

    procedure Store(AName: String; AValue: TStrings; AExpireDelta: TDateTime = OneHour); overload;
    function Get(AName: String; out AValue: TStrings; ACheckExpire: Boolean = True): Boolean; overload;

    procedure Store(AName: String; AValue: TStream; AExpireDelta: TDateTime = OneHour); overload;
    function Get(AName: String; out AValue: TStream; ACheckExpire: Boolean = True): Boolean; overload;

  end;


implementation

uses HashUtil, Types;
{ TDiskCache }

function TDiskCache.CacheExists(AName: String): Boolean;
begin
  Result := FileExists(GetFilename(AName));
end;

function TDiskCache.CacheTime(AName: String): TDateTime;
begin
  Result := fCacheDat.ReadDateTime(AName, 'updated', 0);
end;

constructor TDiskCache.Create(AStorageRoot: String);
begin
  inherited Create;
  fStorageRoot := AStorageRoot;
  fCacheDatFilename := fStorageRoot + PathDelim + 'cache.dat';
  ForceDirectories(ExtractFilePath(fCacheDatFilename));
  fCacheDat := TIniFile.Create(fCacheDatFilename);
end;

procedure TDiskCache.Delete(AName: String);
begin
  if FileExists(GetFilename(AName)) then
    DeleteFile(GetFilename(AName));
end;

procedure TDiskCache.DeleteAll;
var
  cachefiles: TStringDynArray;
  filename: String;
begin
  cachefiles := TDirectory.GetFiles(fStorageRoot, '*.cache');
  for filename in cachefiles do
  begin
    DeleteFile(filename);
  end;
  fCacheDat.Free;
  DeleteFile(fCacheDatFilename);
  ForceDirectories(ExtractFilePath(fCacheDatFilename));
  fCacheDat := TIniFile.Create(fCacheDatFilename);
end;

procedure TDiskCache.DeleteExpired;
begin

end;

destructor TDiskCache.Destroy;
begin
  fCacheDat.UpdateFile;
  fCacheDat.Free;
  inherited;
end;

function TDiskCache.Get(AName: String; out AValue: String; ACheckExpire: Boolean = True): Boolean;
begin
  Result := False;
  if CacheExists(AName) then
  begin
    if (not ACheckExpire) or (ACheckExpire and (not IsExpired(AName))) then
    begin
      with TFileStream.Create(GetFilename(AName), fmOpenRead) do
      begin
        try
          SetLength(AValue, Size);
          Read(AValue[1], Size);
          Result := True;
        finally
          Free;
        end;
      end;
    end;
  end;
end;

function TDiskCache.Get(AName: String; out AValue: TBitmap;
  ACheckExpire: Boolean): Boolean;
var
  fs: TFileStream;
begin
  Result := False;
  if CacheExists(AName) then
  begin
    if (not ACheckExpire) or (ACheckExpire and (not IsExpired(AName))) then
    begin
      fs := TFileStream.Create(GetFilename(AName), fmOpenRead);
      try
        AValue := TBitmap.CreateFromStream(fs);
        Result := True;
      finally
        fs.Free;
      end;
    end;
  end;
end;

function TDiskCache.Get(AName: String; out AValue: TStrings;
  ACheckExpire: Boolean): Boolean;
var
  fs: TFileStream;
begin
  Result := False;
  if CacheExists(AName) then
  begin
    if (not ACheckExpire) or (ACheckExpire and (not IsExpired(AName))) then
    begin
      fs := TFileStream.Create(GetFilename(AName), fmOpenRead);
      try
        AValue := TStringList.Create;
        AValue.LoadFromStream(fs);
        Result := True;
      finally
        fs.Free;
      end;
    end;
  end;
end;

function TDiskCache.Get(AName: String; out AValue: TStream;
  ACheckExpire: Boolean): Boolean;
var
  fs: TFileStream;
begin
  Result := False;
  if CacheExists(AName) then
  begin
    if (not ACheckExpire) or (ACheckExpire and (not IsExpired(AName))) then
    begin
      fs := TFileStream.Create(GetFilename(AName), fmOpenRead);
      try
        AValue.CopyFrom(fs, fs.Size);
        Result := True;
      finally
        fs.Free;
      end;
    end;
  end;
end;

function TDiskCache.GetFilename(AName: String): String;
begin
  Result := fStorageRoot + PathDelim + Hash(AName) + '.cache';
end;

function TDiskCache.Hash(AName: String): String;
begin
  Result := MD5(AName);
end;

function TDiskCache.IsExpired(AName: String): Boolean;
begin
  Result := (Now - fCacheDat.ReadDateTime(AName, 'updated', 0)) > fCacheDat.ReadDateTime(AName, 'ttl', 0);
end;

procedure TDiskCache.Store(AName: String; AValue: TStream;
  AExpireDelta: TDateTime);
var
  fs: TFileStream;
begin
  if AValue <> nil then
  begin
    fCacheDat.WriteDateTime(AName, 'updated', Now);
    fCacheDat.WriteDateTime(AName, 'ttl', AExpireDelta);
    fs := TFileStream.Create(GetFilename(AName), fmCreate);
    try
      AValue.Seek(0, 0);
      fs.CopyFrom(AValue, AValue.Size);
    finally
      fs.Free;
    end;
  end else
  begin
    Delete(AName);
  end;
end;

procedure TDiskCache.Store(AName: String; AValue: TStrings;
  AExpireDelta: TDateTime);
begin
  if AValue <> nil then
  begin
    fCacheDat.WriteDateTime(AName, 'updated', Now);
    fCacheDat.WriteDateTime(AName, 'ttl', AExpireDelta);
    AValue.SaveToFile(GetFilename(AName));
  end else
  begin
    Delete(AName);
  end;
end;

procedure TDiskCache.Store(AName: String; AValue: TBitmap;
  AExpireDelta: TDateTime);
begin
  if AValue <> nil then
  begin
    fCacheDat.WriteDateTime(AName, 'updated', Now);
    fCacheDat.WriteDateTime(AName, 'ttl', AExpireDelta);
    AValue.SaveToFile(GetFilename(AName));
  end else
  begin
    Delete(AName);
  end;
end;

procedure TDiskCache.Store(AName, AValue: String; AExpireDelta: TDateTime);
begin
  fCacheDat.WriteDateTime(AName, 'updated', Now);
  fCacheDat.WriteDateTime(AName, 'ttl', AExpireDelta);

  with TFileStream.Create(GetFilename(AName), fmCreate) do
  begin
    Write(AValue[1], ByteLength(AValue));
    Free;
  end;
end;

end.