lazarus-ccr/components/flashfiler/sourcelaz/ffsrixhl.pas

{*********************************************************}
{* FlashFiler: Index helper objects for composite indices*}
{*********************************************************}

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower FlashFiler
 *
 * The Initial Developer of the Original Code is
 * Thorsten Engler.
 *
 * Portions created by the Initial Developer are Copyright (C) 2000-2002
 * the Initial Developer. All Rights Reserved.
 * Used with permisson.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{$I ffdefine.inc}

unit ffsrixhl;

interface

uses
  Windows,
  SysUtils,
  Classes,
  ffconst,
  ffllbase,
  ffsrmgr,
  ffllexcp,
  ffsrintf,
  ffsrbase;

type
  TffSrIndexHelper = class(TffUCStrListItem)
  protected {private}
    ihFieldTypes: TffFieldTypes;
  public
    class procedure Register(const aName      : TffShStr;
                                   aFieldTypes: TffFieldTypes;
                             const aParams    : array of const);
      {-creates an instance of this object and adds it to the internal list}
    class procedure Unregister;
      {-removes all IndexHelpers of this ClassType from the internal list}
    class function FindHelper(const aName     : TffShStr;
                                    aFieldType: TffFieldType)
                                              : TffSrIndexHelper;
      {-searches the internal list for a helper with the specified name
        and checks if the fieldtype is supported by that helper}

    procedure Initialize(const aParams: array of const); virtual;
      {-called after the object is created by Register}
    procedure BuildKey(const aFieldBuffer;
                         var aKeyBuffer;
                             aFieldDesc: PffFieldDescriptor;
                             aLenToUse: Integer); virtual;
      {-builds the key for a specific field
        aLenToUse > 0 means a partial string field is required}
    function CompareKey(const Key1,
                              Key2;
                              aFieldDesc: PffFieldDescriptor;
                              aLenToUse : Integer;
                              aNoCase   : Boolean)
                                        : Integer; virtual;
      {-compares the keys for a specific field
        aLenToUse > 0 means a partial string field is required}

    property FieldTypes : TffFieldTypes
      {-field types supported by this index helper}
       read ihFieldTypes;
  end;

  TffSrNumbersOnlyIH = class(TffSrIndexHelper)
  public
    procedure BuildKey(const aFieldBuffer;
                         var aKeyBuffer;
                             aFieldDesc: PffFieldDescriptor;
                             aLenToUse: Integer); override;
  end;

  { Use the following to pass around arrays of index helpers. }
  PffIndexHelperArray = ^TffIndexHelperArray;
  TffIndexHelperArray = array[0..ffcl_MaxIndexFlds] of TffSrIndexHelper;

{ Pre-defined helper names }
const
  ffc_ihlpNumbersOnly = 'NumbersOnly';

implementation

uses
  TypInfo,
  fftbbase;

var
  _HelperList : TffThreadList;

{===TffSrIndexHelper=================================================}
class procedure TffSrIndexHelper.Register(const aName      : TffShStr;
                                                aFieldTypes: TffFieldTypes;
                                          const aParams    : array of const);
var
  Helper: TffSrIndexHelper;
begin
  _HelperList.BeginWrite;
  try
    Helper := Create(aName);
    if not _HelperList.Insert(Helper) then begin
      Helper.Free;
      FFRaiseException(EffServerException, ffStrResGeneral,
                       fferrIxHlprRegistered, [aName]);
    end else try
      Helper.ihFieldTypes := aFieldTypes;
      Helper.Initialize(aParams);
    except
      Helper.Free;
      raise;
    end;
  finally
    _HelperList.EndWrite;
  end;
end;
{--------}
class procedure TffSrIndexHelper.Unregister;
var
  i                           : Integer;
begin
  if not Assigned(_HelperList) then
    Exit;
  _HelperList.BeginWrite;
  try
    for i := Pred(_HelperList.Count) downto 0 do
      with _HelperList.Items[i] do
        if (ClassType = Self) or ClassType.InheritsFrom(Self) then
          Free;
  finally
    _HelperList.EndWrite;
  end;
end;
{--------}
class function TffSrIndexHelper.FindHelper(const aName     : TffShStr;
                                                 aFieldType: TffFieldType)
                                                           : TffSrIndexHelper;
var
  i: Integer;
begin
  _HelperList.BeginRead;
  try
    i := _HelperList.Index(aName);
    if i < 0 then
      FFRaiseException(EffServerException, ffStrResGeneral,
                       fferrIxHlprNotReg, [aName]);
    Result := TffSrIndexHelper(_HelperList.Items[i]);
    if not (aFieldType in Result.ihFieldTypes) then
      FFRaiseException(EffServerException, ffStrResGeneral,
                       fferrIxHlprNotSupp,
                       [aName, GetEnumName(TypeInfo(TffFieldType), ord(aFieldType))]);
  finally
    _HelperList.EndRead;
  end;
end;
{--------}
procedure TffSrIndexHelper.Initialize(const aParams: array of const);
begin
  { May be overriden by descendant classes for custom initialization. }
end;
{--------}
procedure TffSrIndexHelper.BuildKey(const aFieldBuffer;
                                      var aKeyBuffer;
                                          aFieldDesc: PffFieldDescriptor;
                                          aLenToUse: Integer);
begin
  if aLenToUse<0 then
    Move(aFieldBuffer, aKeyBuffer, aFieldDesc^.fdLength)
  else with aFieldDesc^ do begin
    if (fdType = fftShortString) or
       (fdType = fftShortAnsiStr) then begin
      Move(aFieldBuffer, aKeyBuffer, aLenToUse+1);
      Byte(aKeyBuffer) := aLenToUse;
    end
    else
      Move(aFieldBuffer, aKeyBuffer, aLenToUse);
  end;
end;
{--------}
function TffSrIndexHelper.CompareKey(const Key1,
                                           Key2;
                                           aFieldDesc: PffFieldDescriptor;
                                           aLenToUse : Integer;
                                           aNoCase   : Boolean)
                                                     : Integer;
begin
  with aFieldDesc^ do
    if aLenToUse < 0 then
      Result := FFKeyCompareField(Key1, Key2, fdType, fdLength, aNoCase)
    else
      Result := FFKeyCompareField(Key1, Key2, fdType, aLenToUse, aNoCase);
end;
{====================================================================}

{===TffSrNumbersOnlyIH================================================}
procedure TffSrNumbersOnlyIH.BuildKey(const aFieldBuffer;
                                        var aKeyBuffer;
                                            aFieldDesc: PffFieldDescriptor;
                                            aLenToUse: Integer);
var
  Source : TffShStr absolute aFieldBuffer;
  Target : TffShStr absolute aKeyBuffer;
  i      : Integer;
begin
  if aLenToUse < 0 then
    aLenToUse := aFieldDesc^.fdUnits;
  Target := '';
  for i:= 1 to Length(Source) do
    //#254 is allowed for setting "123*" type of ranges...
    if Source[i] in ['0'..'9', #254] then begin
      Target := Target + Source[i];
      if Length(Target) >= aLenToUse then
        Exit;
    end;
end;
{====================================================================}

initialization
  _HelperList := TffThreadList.Create;
  TffSrIndexHelper.Register
                     ('',
                      [fftBoolean..fftDateTime, fftByteArray..fftWideString],
                      {$IFDEF DCC4OrLater}
                      []);
                      {$ELSE}
                      ['']);
                      {$ENDIF}


  TffSrNumbersOnlyIH.Register(ffc_ihlpNumbersOnly,
                              [fftShortString, fftShortAnsiStr],
                              {$IFDEF DCC4OrLater}
                              []);
                              {$ELSE}
                              ['']);
                              {$ENDIF}

finalization
  TffSrNumbersOnlyIH.Unregister;
  TffSrIndexHelper.Unregister;
  _HelperList.Free;
  _HelperList:=nil;
end.