Delphi Data Snap Methods Class - Override Create Constructor - delphi

Important I am using Delphi XE 7
I am new to data snap, and I have setup a data snap server and client with the wizard in the menu along side a short tutorial from youtube
The server and client application works and communicates with each other. But in my server methods unit (The unit that contains all the functions that the client can call) I am trying to initialize the variables that I have created in the class (Setting some integers to 0 etc).
I have attempted to override the constructor create, but it would appear as though it is never being called.
I have marked it with virtual, override and overload but none of them seems to be executing this code:
constructor TServerMethods1.create(AOwner: TComponent);
begin
messagedlg('worked', mtError, [mbOk], 0);
inherited;
end;
I originally had the variables in there but it occurred to me that it wasn't executing.
Am I missing something or does it never execute, and if it never executes how does the client call the methods.
Edit - This is the class declaration:
type
tPlayer = record
PlayerName: String;
Spot: Integer;
end;
{$METHODINFO ON}
TServerMethods1 = class(TComponent)
TmrGameStarted: TTimer;
private
{ Private declarations }
fSpot1Taken: Boolean;
fSpot2Taken: Boolean;
fSpot3Taken: Boolean;
fSpot4Taken: Boolean;
fSpot5Taken: Boolean;
Player: Array [1 .. 5] of tPlayer;
fGameStarted: Boolean;
public
{ Public declarations }
fPlayerCount: Integer;
constructor create(AOwner: TComponent); overload;
function getPlayerCount: Integer;
procedure setPlayerCount(i: Integer);
function EchoString(Value: string): string;
function ReverseString(Value: string): string;
function Attempt_Join(sPlayerName: String; sPassword: String): String;
function UpdateLog: String;
function GameStarted: String;
end;
{$METHODINFO OFF}
I have also included the following in my constructor:
constructor TServerMethods1.create(AOwner: TComponent);
begin
messagedlg('worked', mtError, [mbOk], 0);
inherited create(AOwner);
end;
This is the constructor method from System.Classes which is a public declaration constructor Create(AOwner: TComponent); virtual;
{ TComponent }
constructor TComponent.Create(AOwner: TComponent);
begin
FComponentStyle := [csInheritable];
if AOwner <> nil then AOwner.InsertComponent(Self);
end;
This is also added in the type declaration but I have no idea what it does
private class var
FComparer: IComparer<TComponent>;
class constructor Create;
Constructor method:
class constructor TComponent.Create;
begin
FComparer := TDelegatedComparer<TComponent>.Create(
function(const Item1, Item2: TComponent): Integer
begin
Result := CompareText(Item1.Name, Item2.Name);
end);
end;

Okay. I have found the answer to my question. The on create even fires but it fires each time the client calls the function.
After doing some more research it would appear as there isn't an actual way to manipulate the server methods from a form or an application.
Datasnap could be useful depending on what you need it for, In my case I used it in the incorrect way. To use the create constructor just add the override directive. This will override the default parent constructor and execute yours.

Related

Interfaced object being dumped from memory

We have a funny one.
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
ITestInterface = interface(IInvokable)
['{4059D1CD-A342-48EE-B796-84B8B5589AED}']
function GetPort: string;
function GetRoot: string;
end;
TTestInterface = class(TInterfacedObject, ITestInterface)
private
FPort: string;
FRoot: string;
public
constructor Create(FileName: TFileName);
destructor Destroy; override;
function GetPort: string;
function GetRoot: string;
end;
{ TTestInterface }
constructor TTestInterface.Create(FileName: TFileName);
begin
FPort := '8080';
FRoot := 'top';
end;
destructor TTestInterface.Destroy;
begin
// ^ Place Breakpoint here
inherited;
end;
function TTestInterface.GetPort: string;
begin
Result := FPort;
end;
function TTestInterface.GetRoot: string;
begin
Result := FRoot;
end;
type
TTestService = class
protected
FTest : TTestInterface;
public
constructor Create;
destructor Destroy; override;
procedure Process;
end;
{ TTestService }
constructor TTestService.Create;
begin
FTest := TTestInterface.Create('');
(FTest as IInterface)._AddRef;
end;
destructor TTestService.Destroy;
begin
FTest.Free;
inherited;
end;
procedure TTestService.Process;
begin
writeln( 'Config Root: ', FTest.GetRoot );
writeln( 'Config Port: ', FTest.GetPort );
end;
var
TS : TTestService;
begin
TS := TTestService.Create;
try
TS.Process;
finally
TS.Free;
end;
end.
When this application finishes it generates an Invalid Pointer Operation.
The really strange part is that setting a break point on the destructor, you can see that it generates the error the first time it gets called, which rules out it being freed twice. It is almost as if the object is dumped from memory without calling the destructor at all.
By removing the _AddRef everything works as expected.
We managed to produce this on Delphi 6. Can anyone confirm this behavior on any other version?
Use two variables: one for the class, and one for the interface.
Use the interface variable to manage the instance lifetime. Don't call free, but set the interface variable to nil (or out of scope) to let the instance running.
Use the class variable to have direct raw access to the instance, if needed - but it shouldn't be the case, or at least let the class be accessible only from protected/private members of the owner class.
So your code becomes:
type
TTestService = class
protected
FTest: ITestInterface;
FTestInstance : TTestInterface;
public
constructor Create;
procedure Process;
end;
{ TTestService }
constructor TTestService.Create;
begin
FTestInstance := TTestInterface.Create('');
FTest := FTestInstance;
end;
procedure TTestService.Process;
begin
writeln( 'Config Root: ', FTest.GetRoot );
writeln( 'Config Port: ', FTest.GetPort );
end;
var
TS : TTestService;
begin
TS := TTestService.Create;
try
TS.Process;
finally
TS.Free;
end;
end.
The problem is that you are manually freeing an interfaced object that has a reference count greater than zero. The exception is raised here :
procedure TInterfacedObject.BeforeDestruction;
begin
if RefCount <> 0 then {!! RefCount is still 1 - you made it that way!}
Error(reInvalidPtr);
end;
So... you could just call (FTest as IInterface)._Release; in the destructor in place of FTest.Free, but this feels like fixing one mistake by making another. Either you want reference counting or you don't - if you do, then you should work with the object in that way (using interface variables and letting scope and variable lifetime manage the object lifetime). If you don't want reference counting then disable it. Either way you should pick a lifetime management model and work with it in the normal way.
Case 1 : Disable Reference Counting
If you want to disable automatic reference counting and you're using Delphi 2009 or higher you can simply do this by inheriting from TSingletonImplementation instead of TInterfacedObject :
TTestInterface = class(TSingletonImplementation, ITestInterface)
private
FPort: string;
FRoot: string;
public
constructor Create(FileName: TFileName);
destructor Destroy; override;
function GetPort: string;
function GetRoot: string;
end;
Otherwise, you can implement this yourself by adding the required methods :
TTestInterface = class(TObject, ITestInterface)
private
FPort: string;
FRoot: string;
{ ** Add interface handling methods ** }
protected
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
{ ** ---------------------- ** }
public
constructor Create(FileName: TFileName);
destructor Destroy; override;
function GetPort: string;
function GetRoot: string;
end;
which you implement as :
function TTestInterface.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TTestInterface._AddRef: Integer;
begin
Result := -1;
end;
function TTestInterface._Release: Integer;
begin
Result := -1;
end;
Case 2 : Use Interface References Normally
If you absolutely need reference counting and you still need to access the concrete class members then the simplest solution is to strictly use interface variables, let your container class pin the object lifetime, and cast to the concrete type when needed. Lets introduce some state to the class :
TTestInterface = class(TInterfacedObject, ITestInterface)
private
FPort: string;
FRoot: string;
public
Foo : integer; { not an interface member...}
constructor Create(FileName: TFileName);
destructor Destroy; override;
function GetPort: string;
function GetRoot: string;
end;
Your container class then becomes :
type
TTestService = class
protected
FTest : ITestInterface;
public
constructor Create;
procedure Process;
end;
{ TTestService }
constructor TTestService.Create;
begin
FTest := TTestInterface.Create('');
end;
procedure TTestService.Process;
begin
writeln( 'Config Root: ', FTest.GetRoot );
writeln( 'Config Port: ', FTest.GetPort );
WriteLn( 'Foo : ', TTestInterface(FTest).Foo); {Cast to access class members}
end;
Note that the above cast of TTestInterface(FTest) only works in Delphi 2010 and higher. For versions older than this you must keep a separate object reference as in #ArnaudBouchez's answer. In either case, the point is to use interface references in the normal way to manage the object lifetime and to not rely on hacking the reference count manually.

Can constructors be private? [duplicate]

Take a look at this class:
TTest = class(TObject)
public
constructor Create(A:Integer);overload;
constructor Create(A,B:Integer);overload;
end;
Now when we want to use the class:
var
test: TTest;
begin
test:= TTest.Create; //this constructor is still visible and usable!
end;
Can anyone help me with hiding this constructor?
So long as you have overloaded constructors named Create, you cannot hide the parameterless TObject constructor when deriving from TObject.
This is discussed here: http://www.yanniel.info/2011/08/hide-tobject-create-constructor-delphi.html
If you are prepared to put another class between your class and TObject you can use Andy Hausladen's trick:
TNoParameterlessContructorObject = class(TObject)
strict private
constructor Create;
end;
TTest = class(TNoParameterlessContructorObject)
public
constructor Create(A:Integer);overload;
constructor Create(A,B:Integer);overload;
end;
You can hide the inherited Create by just introducing a non overloaded Create. As you need two overloaded Create, you can either merge those into one Create with an optional second parameter:
TTest = class(TObject)
public
constructor Create(A:Integer; B: Integer = 0);
end;
This will give a compiler warning, signalling that you're hiding the default parameterless constructor. To get rid of the warning you can declare the hiding constructor like so:
TTest = class(TObject)
public
constructor Create(A:Integer; B: Integer = 0); reintroduce;
end;
or, if this is not feasible, you can introduce an intermediate class introducing the first create and then the final class with the overloaded second one:
preTest = class(TObject)
public
constructor Create(A:Integer); reintroduce;
end;
TTest = class(preTest)
public
constructor Create(A,B:Integer);overload;
end;
Another option is to use the deprecated keyword and raise an exception at runtime.
TTest = class(TObject)
public
constructor Create; overload; deprecated 'Parameterless constructor is not Supported for a TTest class';
constructor Create(const A: Integer); overload;
constructor Create(const A, B: Integer); overload;
end;
implementation
constructor TTest.Create;
begin
raise Exception.Create('Parameterless constructor is not Supported for a TTest class.');
end;
Through the two inheritance, user creation of TMySingleton class can be prevented from design time rather than runtime.
unit MySingleton;
interface
uses System.Classes, System.SysUtils;
type
// Constructor Block external access
THideConstructor = class abstract
strict protected
constructor Create; virtual; abstract;
end;
// Switching the access to the Create function THideConstructor in TObject through the constructor Overloading
// Declaring Create Method as a procedure to prevent class call-TMySingle.Create('string') call impossible
TOverloadConstructor = class(THideConstructor)
public
procedure Create(s: string); reintroduce; overload; deprecated 'null method';
end;
TMySingleton = class sealed(TOverloadConstructor)
private
class var MyObj: TMySingleton;
strict protected
// Hiding TOverloadConstructor.Create(s: string);
// Implement THideConstructor.Create
constructor Create; override;
public
class function Obj: TMySingleton;
function Echo(const value: string): String;
destructor Destroy; override;
end;
implementation
{ TMySingleton }
constructor TMySingleton.Create;
begin
// TODO
end;
destructor TMySingleton.Destroy;
begin
Self.MyObj := nil;
inherited;
end;
function TMySingleton.Echo(const value: string): String;
begin
result := value;
end;
class function TMySingleton.Obj: TMySingleton;
begin
if MyObj = nil then
MyObj := Self.Create;
result := MyObj;
end;
{ TOverloadContructor }
procedure TOverloadConstructor.Create(s: string);
begin
// null method
end;
initialization
TMySingleton.MyObj := nil;
finalization
if Assigned(TMySingleton.MyObj) then
FreeAndNil(TMySingleton.MyObj);
end.
If the user
var
Singleton: TMySingleton;
begin
Singleton := TMySingleton.Create;
Design-time error occurs.
[dcc32 Error] Unit1.pas(33): E2625 Private member 'THideConstructor.Create' is inaccessible here MySingleton.pas(11): Related method: constructor Create;
enter image description here
Also, you can't see any autocomplete hints named Create.

Delphi customised constructor in TComponent never runs

i am new to delphi and i am creating a component in delphi 6. but i can't get the constructor to run:
unit MyComms1;
...
type
TMyComms = class(TComponent)
public
constructor MyConstructor;
end;
implementation
constructor TMyComms.MyConstructor;
begin
inherited;
ShowMessage('got here');
end;
it doesn't matter what the constructor is called, but this code doesn't run the constructor at all.
edit
by request, here is how the TMyComms class is initialized (this code is in a different file called TestComms.pas):
unit TestComms;
interface
uses MyComms1, ...
type
TForm1 = class(TForm)
MyCommsHandle = TMyComms;
...
procedure BtnClick(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
procedure TForm1.BtnClick(Sender: TObject);
begin
MyCommsHandle.AnotherMyCommsProcedure;
end;
edit 2
reading some of the answers it looks like constructors must be manually called in delphi. is this correct? if so then this is certainly my main error - i am used to php where the __construct function is automatically called whenever a class is assigned to a handle.
Most likely you are not calling TMyComms.MyConstructor to test your unusual called and used constructor. The way marked with // ** would be th most usual.
type
TMyComms = class(TComponent)
public
constructor MyConstructor;
// the usual override;
// constructor Create(Owner:TComponent);override; // **
constructor Create(AOwner:TComponent);overload; override;
constructor Create(AOwner:TComponent;AnOtherParameter:Integer);overload;
end;
constructor TMyComms.Create(AOwner: TComponent);
begin
inherited ;
ShowMessage('got here Create');
end;
constructor TMyComms.Create(AOwner: TComponent; AnOtherParameter: Integer);
begin
inherited Create(AOwner);
ShowMessage(Format('got here Create with new parametere %d',[AnOtherParameter]));
end;
constructor TMyComms.MyConstructor;
begin
inherited Create(nil);
ShowMessage('got here MyConstructor');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TMyComms.MyConstructor.Free;
TMyComms.Create(self).Free;
TMyComms.Create(self,1234).Free;
end;
Your code does not follow the Delphi naming guidelines - the constructor should be named Create.
Since you didn't posted the code actually calling the ctor, I guess, that you may not have called it at all. Try to add a button to your form, doubleclick it and add the following code:
procedure TForm1.Button1Click(Sender : TObject)
var comms : TMyComms;
begin
comms := TMyComms.MyConstructor;
comms.Free;
end;
By the way, if you derive from TComponent, you should override constructor with a parameter - otherwise inherited methods may not work properly.
interface
type TMyComms = class(TComponent)
private
protected
public
constructor Create(AOwner : TComponent); override;
end;
implementation
constructor TMyComms.Create(AOwner : TComponent)
begin
inherited Create(AOwner);
// Your stuff
end;
// Somewhere in code
var comms : TMyComms;
begin
comms := TMyComms.Create(nil);
end;
Your custom constructor is not called because you did not call it.
MyComm := TMyComms.MyConstructor;
But you also have an error in your code. Because there is no derived constructor you can inherite with simple inherited.
type
TMyComms = class(TComponent)
public
constructor MyConstructor;
end;
implementation
constructor TMyComms.MyConstructor;
begin
inherited Create( nil ); // !
ShowMessage('got here');
end;
You can use the simple inherited if your custom constructor use the same name and parameters from an existing constructor.
type
TMyComms = class(TComponent)
public
constructor Create( AOwner : TComponent ); override;
end;
implementation
constructor TMyComms.Create( AOwner : TComponent );
begin
inherited; // <- everything is fine
ShowMessage('got here');
end;

How do I overload a virtual function introduced in a parent class?

I have a parent class with one important abstract procedure which I am overloading in many child classes as the example code shown below:
TCParent = Class
private
public
procedure SaveConfig; virtual; abstract;
end;
TCChild = Class(TCParent)
private
public
procedure SaveConfig; override;
end;
Now there I need to (overload) this procedure with another SaveConfig procedure that will accept parameters, yet I don't want to make big changes in the parent class that might require that I go and make changes in all other child classes.
Is there a way I can overload SaveConfig in this specific child class without making big changes to the parent class and other child classes that inherit from it?
You can use reintroduce to add a new overloaded method. Note that the order of reintroduce; overload; in the child class is required; if you reverse them, the code won't compile.
TCParent = Class
private
public
procedure SaveConfig; virtual; abstract;
end;
TCChild = Class(TCParent)
private
public
procedure SaveConfig; overload; override;
procedure SaveConfig(const FileName: string); reintroduce; overload;
end;
(Tested in Delphi 7, so should work in it and all later versions.)
Since you do not want to make changes to other descendants, I would suggest adding an optional field to the parent class to hold the parameters, then any descendant that wants to use parameters can use them. That way, you don't have to change the signature of the overridden SaveConfig(). For example:
type
TCParent = class
protected
SaveConfigParams: TStrings; // or whatever...
public
procedure SaveConfig; overload; virtual; abstract;
procedure SaveConfig(Params: TStrings); overload;
end;
procedure TCParent.SaveConfig(Params: TStrings);
begin
SaveConfigParams := Params;
try
SaveConfig;
finally
SaveConfigParams := nil;
end;
end;
.
type
TCChild = class(TCParent)
public
procedure SaveConfig; override;
end;
procedure TCChild.SaveConfig;
begin
if SaveConfigParams <> nil then
begin
// do something that uses the parameters...
end else begin
// do something else...
end;
end;
.
type
TCChild2 = class(TCParent)
public
procedure SaveConfig; override;
end;
procedure TCChild2.SaveConfig;
begin
// do something, ignoring the SaveConfigParams...
end;

How to properly make an interface support iteration?

How can I expose this TList from an interface, as either IEnumerator or IEnumerator<IFungibleTroll>? I am using Delphi XE.
Here's how far I got:
unit FungibleTrollUnit;
interface
uses
Windows, Messages, SysUtils,
Variants, Classes, Graphics,
Controls, Forms,
Generics.Collections;
type
IFungibleTroll = interface
['{03536137-E3F7-4F9B-B1F5-2C8010A4D019}']
function GetTrollName:String;
function GetTrollRetailPrice:Double;
end;
TFungibleTrolls = class (TInterfacedObject,IEnumerable<IFungibleTroll>)
protected
FTrolls:TList<IFungibleTroll>;
public
// IEnumerable
function GetEnumerator:IEnumerator<IFungibleTroll>;//
// function GetEnumerator:IEnumerator; overload;
// find/search app feature requires searching.
// this
function FindSingleItemByName(aName:String;patternMatch:Boolean):IFungibleTroll;
function FindMultipleItemsByName(aName:String;patternMatch:Boolean):IEnumerable<IFungibleTroll>;
function FindSingleItemByIdentifier(anIdentifer:String):IFungibleTroll;// use internal non-visible identifier to find an app.
constructor Create;
property Trolls:TList<IFungibleTroll> read FTrolls; // implements IEnumerable<IFungibleTroll>;??
private
end;
implementation
{ TFungibleTrolls }
constructor TFungibleTrolls.Create;
begin
FTrolls := TList<IFungibleTroll>.Create;
end;
function TFungibleTrolls.FindMultipleItemsByName(aName: String;
patternMatch: Boolean): IEnumerable<IFungibleTroll>;
begin
end;
function TFungibleTrolls.FindSingleItemByIdentifier(
anIdentifer: String): IFungibleTroll;
begin
end;
function TFungibleTrolls.FindSingleItemByName(aName: String;
patternMatch: Boolean): IFungibleTroll;
begin
end;
function TFungibleTrolls.GetEnumerator: IEnumerator<IFungibleTroll>;
begin
result := FTrolls.GetEnumerator;
end;
//function TFungibleTrolls.GetEnumerator: IEnumerator;
//begin
// result := FTrolls.GetEnumerator; // type IEnumerator<IFungibleTroll> or IEnumerator?
//end;
end.
I get stuck in one of three errors that I can't figure out how to solve:
[DCC Error] FungibleTrollUnit.pas(26): E2252 Method 'GetEnumerator' with identical parameters already exists
-or-
[DCC Error] FungibleTrollUnit.pas(19): E2291 Missing implementation of interface method IEnumerable.GetEnumerator
-or-
[DCC Error] FungibleTrollUnit.pas(19): E2291 Missing implementation of interface method IEnumerable.GetEnumerator
It seems I must declare two forms of GetEnumerator, if I declare TFungibleTrolls to implement IEnumerable, but I can't seem to figure out how to do it, either with overloads, or without overloads, or using a "method resolution clause", like this:
function IEnumerable.GetEnumerator = GetPlainEnumerator; // method resolution clause needed?
function GetEnumerator:IEnumerator<IFungibleTroll>;
function GetPlainEnumerator:IEnumerator;
This probably seems like a pretty basic use of IEnumerable, and making an Interface support iteration, and yet, I'm stuck.
Update: It seems when I try to do this without first declaring a List<T>, I am falling into a crack caused by the fact that IEnumerable<T> inherits from IEnumerable, and yet, instead of a single get enumerator method, my class must provide multiple ones, and because my class is not a generic, it can't "map itself" to IEnumerable's requirements directly unless I use a generic List<T> declaration. Marjan's sample works, when compiled into a project (.dproj+.dpr) but not when built into a package (.dproj+.dpk) and compiled in the IDE. It works fine from the command line, in a package, but not in the IDE, in a package.
Not an answer to your question directly (still working on that), but this is what I did to get an "interfaced enumerator", ie and interfaced class that supports iteration:
IList<T> = interface(IInterface)
[...]
function GetEnumerator: TList<T>.TEnumerator;
function Add(const Value: T): Integer;
end;
type
TBjmInterfacedList<T> = class(TBjmInterfacedObject, IList<T>)
strict private
FList: TList<T>;
function GetEnumerator: TList<T>.TEnumerator;
strict protected
function Add(const Value: T): Integer;
public
constructor Create; override;
destructor Destroy; override;
end;
implementation
constructor TBjmInterfacedList<T>.Create;
begin
inherited;
FList := TList<T>.Create;
end;
destructor TBjmInterfacedList<T>.Destroy;
begin
FreeAndNil(FList);
inherited;
end;
function TBjmInterfacedList<T>.GetEnumerator: TList<T>.TEnumerator;
begin
Result := FList.GetEnumerator;
end;
function TBjmInterfacedList<T>.Add(const Value: T): Integer;
begin
Result := FList.Add(Value);
end;
And then you can do stuff like:
ISite = interface(IInterface)
...
end;
ISites = interface(IList<ISite>);
...
end;
var
for Site in Sites do begin
...
end;
with implementing classes like:
TSite = class(TBjmInterfacedObject, ISite)
...
end;
TSites = class(TBjmInterfacedList<ISite>, ISites)
...
end;
Update
Example project source uploaded to
http://www.bjmsoftware.com/delphistuff/stackoverflow/interfacedlist.zip
If you really want to make a class that implements IEnumerable<T>, you can do it like this:
unit uGenericEnumerable;
interface
uses SysUtils, Classes, Generics.Collections;
type TGenericEnumerator<T> = class(TInterfacedObject, IEnumerator, IEnumerator<T>)
private
FList: TList<T>;
FIndex: Integer;
protected
function GenericGetCurrent: T;
public
constructor Create(AList: TList<T>);
procedure Reset;
function MoveNext: Boolean;
function GetCurrent: TObject;
function IEnumerator<T>.GetCurrent = GenericGetCurrent;
property Current: T read GenericGetCurrent;
end;
type TNonGenericEnumerable = class(TInterfacedObject, IEnumerable)
protected
function GetNonGenericEnumerator: IEnumerator; virtual; abstract;
public
function IEnumerable.GetEnumerator = GetNonGenericEnumerator;
end;
type TGenericEnumerable<T> = class(TNonGenericEnumerable, IEnumerable<T>)
private
FList: TList<T>;
public
constructor Create;
destructor Destroy; override;
function GetNonGenericEnumerator: IEnumerator; override;
function GetEnumerator: IEnumerator<T>;
property List: TList<T> read FList;
end;
implementation
{ TGenericEnumerator<T> }
constructor TGenericEnumerator<T>.Create(AList: TList<T>);
begin
inherited Create;
FList := AList;
FIndex := -1;
end;
procedure TGenericEnumerator<T>.Reset;
begin
FIndex := -1;
end;
function TGenericEnumerator<T>.MoveNext: Boolean;
begin
if FIndex < FList.Count then
begin
Inc(FIndex);
Result := FIndex < FList.Count;
end
else
begin
Result := False;
end;
end;
function TGenericEnumerator<T>.GenericGetCurrent: T;
begin
Result := FList[FIndex];
end;
function TGenericEnumerator<T>.GetCurrent: TObject;
begin
// If T has not been constrained to being a class, raise an exception instead of trying to return an object.
raise Exception.Create('Cannot use this as a non-generic enumerator');
// If T has been constrained to being a class, return GenericGetCurrent.
// Result := GenericGetCurrent;
end;
{ TGenericEnumerable<T> }
constructor TGenericEnumerable<T>.Create;
begin
inherited Create;
FList := TList<T>.Create;
end;
destructor TGenericEnumerable<T>.Destroy;
begin
FList.Free;
end;
function TGenericEnumerable<T>.GetEnumerator: IEnumerator<T>;
begin
Result := TGenericEnumerator<T>.Create(FList);
end;
function TGenericEnumerable<T>.GetNonGenericEnumerator: IEnumerator;
begin
Result := GetEnumerator;
end;
end.
Now, your FungibleTrollUnit will look something like this:
unit FungibleTrollUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Generics.Collections,
uGenericEnumerable;
type
IFungibleTroll = interface
['{03536137-E3F7-4F9B-B1F5-2C8010A4D019}']
function GetTrollName:String;
function GetTrollRetailPrice:Double;
end;
IFungibleTrolls = interface(IEnumerable<IFungibleTroll>)
['{090B45FB-2925-4BFC-AE97-5D3F54E1C575}']
function GetTrolls: TList<IFungibleTroll>;
function FindSingleItemByName(aName:String):IFungibleTroll;
function FindMultipleItemsByName(aName:String):IEnumerable<IFungibleTroll>;
property Trolls:TList<IFungibleTroll> read GetTrolls;
end;
TFungibleTrolls = class (TGenericEnumerable<IFungibleTroll>, IFungibleTrolls, IEnumerable<IFungibleTroll>)
public
function GetTrolls: TList<IFungibleTroll>;
function FindSingleItemByName(aName: String): IFungibleTroll;
function FindMultipleItemsByName(aName: String): IEnumerable<IFungibleTroll>;
property Trolls:TList<IFungibleTroll> read GetTrolls;
private
end;
implementation
uses StrUtils;
{ TFungibleTrolls }
function TFungibleTrolls.GetTrolls: TList<IFungibleTroll>;
begin
Result := List;
end;
function TFungibleTrolls.FindMultipleItemsByName(aName: String): IEnumerable<IFungibleTroll>;
var FilteredTrolls: TGenericEnumerable<IFungibleTroll>;
var Troll: IFungibleTroll;
begin
FilteredTrolls := TGenericEnumerable<IFungibleTroll>.Create;
for Troll in List do
begin
if Troll.GetTrollName = aName then
FilteredTrolls.List.Add(Troll);
end;
Result := IEnumerable<IFungibleTroll>(FilteredTrolls);
end;
function TFungibleTrolls.FindSingleItemByName(aName: String): IFungibleTroll;
var Troll: IFungibleTroll;
begin
Result := nil;
for Troll in List do
begin
if Troll.GetTrollName = aName then
Result := Troll;
break;
end;
end;
end.
Note that the implementation of IEnumerable does not work, but IEnumerable<T> does work.
This is because, unless T is constrained, you cannot convert a T to a TObject.
If T is a string or an integer, for example, then the IEnumerator does not have a TObject to return.
If T is constrained to be a class, you can get the implementation of IEnumerable to work.
If you constrain T to be an IInterface, you could get IEnumerable to work (Delphi 2010 and after (cast GenericGetCurrent to an IInterface, then to a TObject)), but I doubt if that is an advantage.
I would rather use it without the constraints, and do without being able to iterate everything as TObjects.
TGenericEnumerable<T>.GetEnumerator can't use FList.GetEnumerator because TList<T>.GetEnumerator does not return an IEnumerator<T>
Even though you can implement TGenericEnumerable<T> without defining TNonGenericEnumerable, like this:
type TGenericEnumerable<T> = class(TInterfacedObject, IEnumerable, IEnumerable<T>)
private
FList: TList<T>;
protected
function GenericGetEnumerator: IEnumerator<T>;
public
constructor Create;
destructor Destroy; override;
function GetEnumerator: IEnumerator;
function IEnumerable<T>.GetEnumerator = GenericGetEnumerator;
property List: TList<T> read FList;
end;
the disadvantage of doing this is that if you try to iterate using the TGenericEnumerable<T> object, rather than the interface, GetEnumerator will be non-generic and you can only iterate TObjects.
Usual caveats about mixing references to an interface and its underlying object. If you refer to an object both as an object type and as an IEnumerable<....>, then when the interface reference count goes back to zero, the object will be freed even if you still have a reference to it as an object. (That's why I defined IFungibleTrolls; so that I could refer to the collection as an interface).
You can make alternative implementations of TGenericEnumerator<T>; for example, it could contain a reference to a list, an index and a selection predicate, which are all supplied in the constructor.

Resources