works:programmer:delphi:tldrequestprovider

Примитивное хранилище SQL запросов в VCL

unit LatDEVRequestProvider;
interface
 
uses
    SysUtils, Windows, Classes;
 
type
    TldRequestItem = class(TCollectionItem)
    private
        FName: string;
        FSQL: TStrings;
    protected
        procedure SetName(Value: string);
        procedure SetSQL(const Value: TStrings);
    public
        constructor Create(Collection: TCollection); override;
        destructor Destroy; override;
        procedure Assign(Source: TPersistent); override;
    published
        property ID;
        property Index;
        property Name: string read FName write SetName;
        property SQL: TStrings read FSQL write SetSQL;
    end;
 
    TldRequestList = class(TOwnedCollection)
    private
        FOwner: TPersistent;
        function GetItem(Index: Integer): TldRequestItem;
        procedure SetItem(Index: Integer; Value: TldRequestItem);
    protected
        function GetOwner: TPersistent; override;
    public
        constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
        function Add: TldRequestItem;
        function Insert(Index: Integer): TldRequestItem;
        property Items[Index: Integer]: TldRequestItem read GetItem write SetItem;
    end;
 
    TldRequestProvider = class(TComponent)
    private
        FRequestList: TldRequestList;
    protected
        procedure SetRequestList(const Value: TldRequestList);
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        function Get(const Name: string): TldRequestItem;
        function GetSQL(const Name: string): string;
    published
        property Collection: TldRequestList read FRequestList write SetRequestList;
    end;
 
    procedure Register;
 
implementation
 
{ TldRequestProvider }
 
    constructor TldRequestProvider.Create(AOwner: TComponent);
    begin
        inherited;
        FRequestList := TldRequestList.Create(Self, TldRequestItem);
    end;
 
    destructor TldRequestProvider.Destroy;
    begin
        FreeAndNil(FRequestList);
        inherited;
    end;
 
    function TldRequestProvider.Get(const Name: string): TldRequestItem;
    var
        I: Integer;
        Item: TldRequestItem;
    begin
        Result := nil;
        for I := 0 to FRequestList.Count - 1 do begin
            Item := FRequestList.Items[I] as TldRequestItem;
            if Item.Name = Name then begin
                Result := Item;
                Break;
            end;
        end;
        if Result = nil then raise Exception.CreateFmt('RequestItem `%s` not found', [Name]);
    end;
 
    function TldRequestProvider.GetSQL(const Name: string): string;
    begin
        Result := Get(Name).SQL.Text;
    end;
 
    procedure TldRequestProvider.SetRequestList(const Value: TldRequestList);
    begin
        FRequestList.Assign(Value);
    end;
 
{ TldRequestList }
 
    function TldRequestList.Add: TldRequestItem;
    begin
        Result := TldRequestItem(inherited Add);
    end;
 
    constructor TldRequestList.Create(AOwner: TPersistent; ItemClass: TCollectionItemClass);
    begin
        inherited Create(AOwner, ItemClass);
        FOwner := AOwner;
    end;
 
    function TldRequestList.GetOwner: TPersistent;
    begin
        Result := FOwner;
    end;
 
    function TldRequestList.Insert(Index: Integer): TldRequestItem;
    begin
        Result := TldRequestItem(inherited Insert(Index));
    end;
 
    function TldRequestList.GetItem(Index: Integer): TldRequestItem;
    begin
        Result := TldRequestItem(inherited GetItem(Index));
    end;
 
    procedure TldRequestList.SetItem(Index: Integer; Value: TldRequestItem);
    begin
        inherited SetItem(Index, Value);
    end;
 
{ TldRequestItem }
 
    procedure TldRequestItem.Assign(Source: TPersistent);
    begin
        if Source is TldRequestItem then begin
            Self.SetName(TldRequestItem(Source).FName);
            Self.FSQL.Assign(TldRequestItem(Source).FSQL);
        end else
            inherited Assign(Source);
    end;
 
    constructor TldRequestItem.Create(Collection: TCollection);
    begin
        inherited;
        SetName('Query' + IntToStr(ID+1));
        FSQL := TStringList.Create;
    end;
 
    destructor TldRequestItem.Destroy;
    begin
        FreeAndNil(FSQL);
        inherited;
    end;
 
    procedure TldRequestItem.SetName(Value: string);
    var I: Integer;
    begin
        Value := Trim(Value);
        if Length(Value) < 1 then
            raise Exception.Create('Invalid value for Name empty is prohibited');
        for I := 0 to Collection.Count - 1 do
            if (Collection.Items[I] as TldRequestItem).Name = Value then
                raise Exception.Create('Ivalid value for Name must be unique');
        FName := Value;
    end;
 
    procedure TldRequestItem.SetSQL(const Value: TStrings);
    begin
        FSQL.Assign(Value);
    end;
 
{ RegisterComponents }
 
    procedure Register;
    begin
        RegisterComponents('LatDEV', [TldRequestProvider]);
    end;
 
end.
works/programmer/delphi/tldrequestprovider.txt · Last modified: 2022/10/30 00:52 by Chugreev Eugene