EugeneX MiniWeb

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
====== Примитивное хранилище SQL запросов в VCL ======
<code delphi>
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.
</code>
EugeneX MiniWeb

User Tools

Site Tools

Page Tools
