Create a TDataModule only once - delphi

I'm trying to build a procedure that creates a TDataModule in Application as its parent.
The problem is, the second time I call the procedure, the dm parameter still nil. I expect something diferent of nil considering that it was created before.
Here is the code I'm trying:
procedure UseDataModule(dm : TDataModule; cClass:TcomponentClass);
begin
if dm = nil then
cClass.Create(Application);
end;
There are some requirements I want for this procedure:
The given TDataModule should be created once
It must to be created by procedure because I want to use It sometimes, that's why I don't put it in auto-create forms
Its parent will be always Application

Try changing your code to this:
procedure UseDataModule(var dm : TDataModule; cClass:TcomponentClass);
// the `var` qualifier is to allow the value of `dm` to be retained
// after `UseDataModule` exits, otherwise the Created instance will be discarded
// and you will have a memory leak
begin
if dm = nil then
dm := cClass.Create(Application);
end;
Imo, it would be better to code UseDataModule as a function, but that is largely a matter of taste. Note also that you could write if notAssigned(dm) instead of if dm = Nil.
I gather from your comment that you have decided to use the following code instead of my initial suggestion:
procedure UseDataModule(var dm : TDataModule; cClass:TcomponentClass);
begin
if dm = nil then begin
dm := cClass.Create(Application) as TDataModule;
end;
end;
which seems fine to me.

Another option is to use the same code used to autocreate forms with a check to see if it is already created.
// Create data module if it doesn't already exist
if DM = nil then Application.CreateForm(TDM, DM);

Related

How to set a record field as 'Procedure of object' before an object exists so that it can run

Very un-snappy title I know.
I have a series of text lines that I need to perform certain operations on in a certain order. I have come up with a means of doing this by defining the following record structure:
TProcessOrderRecord = record
RecordTypes: TByteSet;
InitialiseProcedure: TPreScanProc;
ProcessProcedure: TProcessRecord;
FinaliseProcedure: TEndScanProc;
end;
AProcessOrderArray = array of TProcessOrderRecord;
Initialise tends to call a constructor which will fill a field in the host object.
Process will be a procedure on the object which will be called for each text line that matches one of the record types in RecordTypes.
Finalise will tend to call the destructor and possibly do any checks when it knows that the full set of records has been processed.
The means of processing this array is quite straightforward:
procedure TImport.ScanTransferFile;
var
i: integer;
lArrayToProcess: AProcessOrderArray;
begin
lArrayToProcess := SetUpProcessingOrder(NLPGApp.ImportType);
for i := low(lArrayToProcess) to high(lArrayToProcess) do
begin
ProcessRecordType(lArrayToProcess[i].RecordTypes, lArrayToProcess[i].InitialiseProcedure, lArrayToProcess[i].ProcessProcedure, lArrayToProcess[i].FinaliseProcedure);
end;
end;
procedure TImport.ProcessRecordType(const RecordTypesToFind: TByteSet; PreScanProcedure: TPreScanProc; OnFindRecord: TProcessRecord; OnCompleteScan: TEndScanProc);
var
lLineOfText: string;
lIntegerRecordID: byte;
begin
if Assigned(PreScanProcedure) then PreScanProcedure;
try
if assigned(OnFindRecord) then
begin
Reader.GoToStartOfFile;
while not Reader.EndOfFile do
begin
lLineOfText := Reader.ReadLine;
lIntegerRecordID := StrToIntDef(GetRecordID(lLineOfText), 0);
if lIntegerRecordID in RecordTypesToFind then
begin
try
OnFindRecord(lLineOfText);
except
on E: MyAppException do
begin
// either raise to exit or log and carry on
end;
end;
end;
end;
end;
finally
// OnCompleteScan usually contains calls to destructors, so ensure it's called
if Assigned(OnCompleteScan) then OnCompleteScan;
end;
end;
My problem is that I want to define a record as such:
RecordTypes = [10]
InitialiseProcedure = ProcToCreateFMyObj
ProcessProcedure = FMyObj.do
FinaliseProcedure = ProcToFreeFMyObj
This compiles fine, however when ProcessProcedure is called, as FMyObj was nil when the ProcessProcedure is set, the instance of TMyObj is nil even though FMyObj is now set. Is there any clean way to get the record to point to the instance of FMyObj at the time of calling rather than at the time of first assignment?
At present I have resorted to having 'caller' methods on the host object which can then call the FMyObj instance when needed, but this is creating quite a bloated object with lots of single-line methods.
Edit to clarify/complicate the problem
Sometimes one instance of FObj can handle more than one types of record (usually if they have a master-detail relationship). In this case, InitialiseProcedure of the first record type will create FObj, FinaliseProcedure of the second record will free FObj and each record's ProcessProcedure can reference different procedures of FObj (do1 and do2).
At present I have resorted to having 'caller' methods on the host object which can then call the FMyObj instance when needed, but this is creating quite a bloated object with lots of single-line methods.
That is the right solution. Since the instance is not available at the point of initialisation you have no alternative.
When you use of object you are defining something called a method pointer. When you assign to a variable of method pointer type, the instance is captured at the point of assignment. There is no mechanism for the instance associated with a method pointer to be dynamically resolved. The only way to achieve that is to use runtime delegation, which is what you are currently doing. As is so often the case, another layer of indirection is used to solve a problem!
Your record that contains a number of methods looks awfully like an interface. I suspect that the most elegant solution will involve an interface. Perhaps at the point of calling you can call a function that returns an interface. And that function will using the value of FMyObj at the time of calling to locate the appropriate interface.
Yes it is possible to make additional runtime initialization of your record:
var
A: TProcessOrderRecord;
begin
..
TMethod(A.ProcessProcedure).Data:= FMyObj;
..
end;
though I would prefer a different solution, like the one you already use.

How can i know if the user define component is created?

I create a memo inside a procedure, using this code:
Global_MemoIni := TMemo.Create(Conf);
Global_MemoIni.Parent := Conf;
Global_MemoIni.Visible := False;
Global_MemoIni.Align := alClient;
Global_MemoIni.WordWrap := False;
When I call the procedure again it creates the global_memoini again.
How can I know if the component is created so I don't need to call it again?
Update : Can I use the Global_MemoIni.Free above the creation code so the next time create
the Global_memoini once... But i want to know if this is created...
Thank you
You can check if Global_MemoIni is Nil and create the TMemo if it is. Otherwise it already exists, you can then free it using Free or FreeAndNil. If you use free be careful that you assign Nil to Global_MemoIni. If you don't, you can't use the Global_MemoIni <> Nil check.
I honestly don't understand the point of using a memo in stead of a TStringList which is more lightweight. just do
unit UnitName;
interface
uses SysUtils, Windows, Classes, ...;
var Global_INI: TStringList; // <-- it's defined in the interface section, therefore
// it can be accessed by any unit which uses this unit
implementation
initialization
Global_INI := TStringList.Create;
Global_INI.LoadFromFile( 'C:\config.ini' ); // <-- replace the file name with the
// one you want
finalization
FreeAndNil( Global_INI );
end;
Don't do this is an arbitrary function. Either create the component in the FormCreate or even the constructor of the form, or make it a read-only property of the form, and use lazy instantiation, i.e.
if not Assigned(Global_MemoIni) then
begin
Global_MemoIni := TMemo.Create(Self);
// rest of your code
end;
Result := Global_MemoIni;
But why is it global? If you make it a field and corresponding read-only property of the form, it is easily accessible and you can protect it in the way shown above.
FWIW, instead of Free-ing the component, let the Owner (the form) do that. That way, it is available as long as the form exists, and no nasty invalid pointer issues can take place.
If you do not know the creation state of object use:
if not Assigned(Global_MemoIni) then
begin
Global_MemoIni := TMemo.Create(Conf);
...
end
And don't forget to use FreeAndNil(Global_MemoIni) when destroying the object.

Delphi: Correct way to store objects fetched from TObjectList

This example is of course simplified, but basically I have a main form that triggers another form (frmSettings) with
function Execute(var aSettings: TSettings):Boolean
TSettings is my own object created in main form for keeping track of the settings.
In this newly opened form (frmSettings) I fetch a TMyObjectList that is a descendant from TObjectList.
It's filled with TMyObj.
I then fill a TListBox with values from that TMyObjectList.
the code:
...
FMyObjectList : TMyObjectList;
property MyObjectList: TMyObjectList read getMyObjectList;
...
function TfrmSettings.getMyObjectList: TMyObjectList ;
begin
If not Assigned(FMyObjectList) then FMyObjectList := TMyObjectList.Create(True)
Result := FMyObjectList;
end;
function TfrmSettings.Execute(var aSettings: TSettings): Boolean;
begin
//Fill myObjectList
FetchObjs(myObjectList);
//Show list to user
FillList(ListBox1, myObjectList);
//Show form
ShowModal;
Result := self.ModalResult = mrOk;
if Result then
begin
// Save the selected object, but how??
// Store only pointer? Lost if list is destroyed.. no good
//Settings.selectedObj := myObjectList.Items[ListBox1.ItemIndex];
// Or store a new object? Have to check if exist already?
If not Assigned(Settings.selectedObj) then Settings.selectedObj := TMyObj.Create;
Settings.selectedObj.Assign(myObjectList.Items[ListBox1.ItemIndex];);
end;
end;
procedure TfrmSettings.FillList(listBox: TListBox; myObjectList: TMyObjectList);
var
i: Integer;
begin
listBox.Clear;
With myObjectList do
begin
for i := 0 to Count - 1 do
begin
//list names to user
listBox.Items.Add(Items[i].Name);
end;
end;
end;
procedure TfrmSettings.FormDestroy(Sender: TObject);
begin
FreeAndNil(FMyObjectList);
end;
Storing just the pointer doesn't seem as a good idea, as triggering the settings form again, recreates the list, and the original object would be lost even if user hits "cancel"
So storing a copy seems better, using assign to get all the properties correct. And first checking if I already have an object.
If not Assigned(Settings.selectedObj) then Settings.selectedObj := TMyObj.Create;
Settings.selectedObj.Assign(myObjectList.Items[ListBox1.ItemIndex];);
Should I move those two lines to a method instead like Settings.AssignSelectedObj(aMyObj:TMyObj)
Does this look correct or am I implementing this the wrong way?
Something more/less needed?
I need some guidelines so I feel more secure that I don't open up for memory leaks and other trouble.
Other than that reviewing the code a bit, the real question is: Is this the correct way to store my SelectedObject in the settings class?
Is this the correct way to store the selected object in the settings?
Probably not. Your settings class should not depend on the form in any way. What if you decide to create and destroy your form dynamically each time the user opens the settings? In this case your settings would hold an invalid object reference.
IMHO it is better to store the object list in the settings together with the index of the selected object. The form should just access the settings, fill the list box and modify the selected object index after the user confirmed with OK.
You are producing a memory leak in your code. You create a TObjectList as a local variable but you never free it. And if you free the local variable, the object references in the listbox will be invalid. You have two options:
Store the object list as a member variable of your form, create in the FromCreate event handler and destroy it in the FormDestroy event handler. You can then safely use object references in your list box.
Store the object list somewhere outside and pass it into the form as a parameter of the Execute method. In this scenario, you can also safely use object references.
I would rename myObjectList to GlobalObjectList, and move it out of the class. It can be declared in the form, but create/free in the initialization/finalization sections. During initialization, after you create the list, populate it from the ini file (or wherever you store it). Now you can access it from anywhere that has your unit in the Uses.
What about the serialization of TSettings? Put your settings in some published properties, then let the RTTI save its content:
type
TSettings = class(TPersistent)
public
function SaveAsText: UTF8String;
end;
function TSettings.SaveAsText: UTF8String;
begin
var
Stream1, Stream2: TMemoryStream;
begin
Stream1 := TMemoryStream.Create;
Stream2 := TMemoryStream.Create;
try
Stream1.WriteComponent(MyComponent);
ObjectBinaryToText(Stream1, Stream2);
SetString(result,PAnsiChar(Stream2.Memory),Stream2.Size);
finally
Stream1.Free;
Stream2.Free;
end;
end;
Then your settings can be stored in a text file or text string.
It's just one solution. But storing settings as text is very handy. We use such an approach in our framework, to store settings via a code-generated user interface. A settings tree is created, from a tree of TPersistent instances.

Maintain UpDown-Associate connection while recreating the associate

I have an TUpDown control whose Associate is set to an instance of a TEdit subclass. The edit class calls RecreateWnd in its overriden DoEnter method. Unfortunately this kills the buddy connection at the API level which leads to strange behavior e.g. when clicking on the updown arrows.
My problem is that the edit instance doesn't know that it is the buddy of some updown to which it should reconnect and the updown isn't notified of the loss of its buddy. Any ideas how I could reconnect the two?
I noticed how TCustomUpDown.SetAssociate checks that updown and buddy have the same parent and uses this to avoid duplicate associations. So I tried calling my own RecreateWnd method:
procedure TAlignedEdit.RecreateWnd;
var
i: Integer;
c: TControl;
ud: TCustomUpDown;
begin
ud := nil;
for i := 0 to Pred(Parent.ControlCount) do
begin
c := Parent.Controls[i];
if c is TCustomUpDown then
if THACK_CustomUpDown(c).Associate = Self then
begin
ud := TCustomUpDown(c);
Break;
end;
end;
inherited RecreateWnd;
if Assigned(ud) then
begin
THACK_CustomUpDown(ud).Associate := nil;
THACK_CustomUpDown(ud).Associate := Self;
end;
end;
et voila - it works!
You've discovered something rather unfortunate. You set up an association between two controls at the application level, so you should be able to continue to manage that association in application-level code, but the VCL doesn't provide the framework necessary for maintaining that. Ideally, there would be a generic association framework, so associated controls could notify each other that they should update themselves.
The VCL has the beginnings of that, with the Notification method, but that only notifies of components being destroyed.
I think your proposed solution is a little too specific to the task. An edit control shouldn't necessarily know that it's attached to an up-down control, and even if it does, they shouldn't be required to share a parent. On the other hand, writing an entire generic observer framework for this problem would be overkill. I propose a compromise.
Start with a new event property on the edit control:
property OnRecreateWnd: TNotifyEvent read FOnRecreateWnd write FOnRecreateWnd;
Then override RecreateWnd as you did above, but instead of all the up-down-control-specific code, simply trigger the event:
procedure TAlignedEdit.RecreateWnd;
begin
inherited;
if Assigned(OnRecreateWnd) then
OnRecreateWnd(Self);
end;
Now, handle that event in your application code, where you know exactly which controls are associated with each other, so you don't have to search for anything, and you don't need to require any parent-child relationships:
procedure TUlrichForm.AlignedEdit1RecreateWnd(Sender: TObject);
begin
Assert(Sender = AlignedEdit1);
UpDown1.Associate := nil;
UpDown1.Associate := AlignedEdit1;
end;
Try storing the value of the Associate property in a local variable before you call RecreateWnd, then setting it back afterwards.

How can I check whether an object reference is still valid?

I have an issues where I am trying to determine if a reference to an object is valid. But it seems to be returning strange results.
procedure TForm1.Button1Click(Sender: TObject);
var form1 : TForm;
ref2 : TControl;
begin
form1 := TForm.Create(nil);
form1.Name := 'CustomForm';
form1.Parent := self; //Main Form
form1.Show;
ref2 := form1;
showmessage(ref2.ClassName+' - '+ref2.Name+' - '+BoolToStr(ref2.visible,true));
freeandnil(form1);
showmessage(ref2.ClassName+' - '+ref2.Name+' - '+BoolToStr(ref2.visible,true));
end;
The first showmessage returns - "TForm - CustomForm - True" (Just like I would expect it to).
The second showmessage return - "TForm - - False". I was actually hoping for some kind of access violation that I could then trap and know that the reference isn't valid.
In my application I need to compile a list of random TForm descendants as they are created and then check later if they have gone away (or are not visible). Unfortunately it is a plugin based system so I can go change all of these Forms to post a "I'm done Message."
Would code like this be safe to use (assuming I actually am checking for access violations)? Does anybody have any ideas what is happening.
Thanks
The problem is that with a certain likelyhood the memory accessed is still reserved by the Delphi memory manager. In that case Windows does not generate any kind of access violation, because that memory belongs to you!
One possibility is to switch to a different Delphi memory manager which can detect the use of freed objects. FastMM4, for example, has several "memory hygiene" checks, which are very useful for debugging, but even then you won't catch all of these errors immediately.
You can download FastMM4 from SourceForge.
Any TComponent (e.g. a TForm descendant) can register for notifications when other components are destroyed.
In your form, call FreeNotification(form) for each form that you wish to be notified of the destruction of. Then on the same form override the Notification() method. When any form (or other component) for which you have called FreeNotification() is destroyed, your Notification() method will be called with a Component parameter referencing the form and an Operation of opRemove.
If I've understood what it is you are trying to achieve, I think this should be enough information to devise an approach to do what you need.
After
freeandnil(form1);
the Delphi memory manager just marks the memory allocated by form1 as free, but all form1 data is still there, and can be accessed via ref2 until the memory manager reuse the freed memory for some other object(s).
You can't check that way if ref2 references a valid object or not. Code like this can't be safe, it is actually a bug.
If you want to obtain a 100% access violation modify the code as follows (here ref2^ = nil if form1 is freed):
procedure TForm1.Button1Click(Sender: TObject);
var form1 : TForm;
ref2 : ^TControl;
begin
form1 := TForm.Create(nil);
form1.Name := 'CustomForm';
form1.Parent := self; //Main Form
form1.Show;
ref2 := #form1;
showmessage(ref2^.ClassName+' - '+ref2^.Name+' - '+BoolToStr(ref2^.visible,true));
freeandnil(form1);
showmessage(ref2^.ClassName+' - '+ref2^.Name+' - '+BoolToStr(ref2^.visible,true));
end;
There is no reliable way to do what you are trying to do using the technique you're attempting. Forms that have "gone away" may have their memory reused, possibly even for a new form.
At best, you could work some mechanism whereby you cache the results of iterating Screen.Forms, but you can still fall foul of accidental duplicates, where a form gets destroyed and another gets reallocated and gets the same object address. That scenario is less likely than the memory being reused for some other object, however.
In a similar case I am using a singleton object that keeps a list of all the created forms.
Each form has a field with a reference to this Object.
TMyForm = class(TForm)
private
//*** This is the reference to the singleton...
FFormHandler: TFormHandler;
public
...
//*** you might want to publish it as a property:
property FormHandler: TFormHandler read FFormHandler write FFormHandler;
end;
You can set this reference e.g. when calling the constructor:
TMyForm.Create(aFormHandler: TFormHandler; aOwner: TComponent)
begin
FFormHandler := aFormHandler;
inherited Create(aOwner);
end;
(Or you could set the field from outside directly after creating the form if you don't want to change the parameters of the constructor).
When the form ist destroyed it notifies the handler and tells him to remove the form from the list - something like that:
TMyForm.Destroy(Sender: TObject);
begin
FFormHandler.RemoveFromFormList(Self);
inherited;
end;
(The details of the track-keeping are not included in the expample - e.g. a method "AddToFomList" or something alike would be needed)
There is one very interesting memory manager. It is called SafeMM: http://blogs.embarcadero.com/medington/2009/10/16/24839 But still it is for debugging only.
Given that you cannot modify the code that is out there in the plugins, all the good solutions about how to write safer code are not applicable to your case.
You have 1 way of doing it by
checking if an Object reference is
still what it's supposed to be by
looking up the VMT. This idea was
first published by Ray Lischner (who advocated for FreeAndNil for that very reason) and
later by Hallvard Vassbotn: see
this SO answer.
Another, better but introducing major slowdown, is to use FastMM4 in FullDebugmode to have it to replace all the freed objects by a TFreeObject instance instead of simply releasing the memory to the available pool.
Note that both methods do not prevent a false positive if another instance of the same class happens to be created at the same memory address. You get a valid object of the right type, just not the original one. (Unlikely in your case, but possible)
it is as simple as comparing against NIL:
// object declaration
Type object;
object = new Type();
...
// here you want to be sure of the existance of the object:
if (object <> nil )
object.free;
If you cannot test in another manner, you can use this as a last resort±
function IsValidClass( Cls: TClass ): Boolean;
var
i: Integer;
begin
for i := 0 to 99 do begin
Result := ( Cls = TObject ); // note that other modules may have a different root TObject!
if Result then Exit;
if IsBadReadPtr( Cls, sizeof( Pointer ) ) then Break;
if IsBadReadPtr( Pointer( Integer( Cls ) + vmtParent ), sizeof( Pointer ) ) then Break;
Cls := Cls.ClassParent;
end;
Result := False;
end;
function IsValidObject( Obj: TObject ): Boolean;
begin
Result := not IsBadReadPtr( Obj, sizeof( Pointer ) ) and IsValidClass( Obj.ClassType ) and not IsBadReadPtr( Obj, Obj.InstanceSize );
end;
IsBadReadPtr comes from Windows.

Resources