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.