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 · Последнее изменение: 2022/10/30 00:52 — 127.0.0.1