Using Delphi 2006; My aim is to check wether a TSQLConnection instance is idle or not. Therefore, i am setting a Datetime "m_dLastActivity" to "now" each time activity is seen.
As TSQLMonitor is buggy in its trace handling and causes memory problems (see http://qc.embarcadero.com/wc/qcmain.aspx?d=89216), i try to register a trace callback of my own using SetTraceCallbackEvent:
procedure TConnectionGuard.SetSQLConnection(const Value: TSQLConnection);
begin
...
if Assigned ( Value )
and not ( csDesigning in ComponentState ) then begin
...
m_SQLConnection.SetTraceCallbackEvent(U_ConnectionGuard.OnTraceCallBack, integer(self));
...
end;
end;
The callback is just returning the data to the TConnectionGuard object that registered it:
function OnTraceCallBack( CallType: TRACECat; CBInfo: Pointer): CBRType; stdcall;
var Desc: pSQLTraceDesc;
begin
Desc := pSQLTraceDesc(CBInfo);
Result := TConnectionGuard(Desc.ClientData).OnTraceCallBack(CallType, CBInfo);
end;
The event itself:
function TConnectionGuard.OnTraceCallBack(CallType: TRACECat; Desc: pSQLTraceDesc): CBRType;
begin
m_dLastActivity := now;
Result := cbrUSEDEF;
end;
So far, so good, it works. But i am quite uncomfortable with the fact that i have no idea what i have to pass back as CBRType result (defined in DBCommonTypes.pas) to have a minimum performance impact. In fact, i have no idea what i am answering, as the given parameter CallCAT provides no hint how to read / handle it.
Does anyone know if cbrUSEDEF is the right thing to have tracing at a minimum?
EDIT: I realized through the source code of TSQLMonitor that the CBInfo pointer given is not the client info i registered, but a psQLTraceDesc that contains the client info (in this case, the pointer to my Guard). I have adapted the methods to that fact...
Related
In addition to this question I have made some tests and researches on the docwiki. My conclusion is that this kind of code should work without memory leaks:
function testResultObject: TClassA;
begin
Result := TClassA.Create;
Result.DoSomething;
end;
And then somewhere I can call the above code in this manner:
var k: TClassA;
begin
k := testResultObject;
try
//code code code
finally
k.Free;
end;
end;
As Remy suggested in the answer it's better to avoid this way of doing things and instead use something like testResultObject(x: TClassA): boolean. In this case the return true/false can tell me if everything went fine and I am passing an object already created.
Look at this code:
function testResultObject: TClassA;
begin
Result := TClassA.Create;
try
Result.DoSomething;
except
Result.Free;
end;
end;
The problem with the first version above of the function is that DoSomething could raise an exception and if so I'll leak memory. Can the second implementation with try-except be a solution? For sure later I'll have to check if the result is assigned or nil.
I agree that (as already said above) the testResultObject(x: TClassA): boolean would be better. I was just wondering if the return-a-class function way could be fixed as I've written.
Your code has serious problems. In case of an error, it swallows the exception, and returns an invalid object reference.
This is easy to fix. The canonical way is as follows:
function testResultObject: TClassA;
begin
Result := TClassA.Create;
try
Result.DoSomething;
except
Result.Free;
raise;
end;
end;
Either the function succeeds and returns a new object. Or it fails, cleans up after itself, and raises an exception.
In other words, this function looks and behaves just like a constructor. You consume it in the same way:
obj := testResultObject;
try
// do things with obj
finally
obj.Free;
end;
Your second approach works, but has 2 serious problems.
By swallowing all exceptions, (as J pointed out) you'll hide the fact that something went wrong.
There's no indication to the caller that you've created an object that the caller is responsible for destroying. This makes using the function more error prone; and easier to cause memory leaks.
I would recommend the following improvement on your second approach:
{Name has a clue that caller should take ownership of a new object returned}
function CreateObjectA: TClassA;
begin
{Once object is successfully created, internal resource protection is required:
- if no error, it is callers responsibility to destroy the returned object
- if error, caller must assume creation *failed* so must destroy object here
Also, by assigning Result of successful Create before *try*:
The object (reference) is returned
**if-and-only-if**
This function returns 'normally' (i.e. no exception state)}
Result := TClassA.Create;
try
Result.DoSomething; {that could fail}
except
{Cleanup only if something goes wrong:
caller should not be responsible for errors *within* this method}
Result.Free;
{Re-raise the exception to notify caller:
exception state means caller does not "receive" Result...
code jumps to next finally or except block}
raise;
end;
end;
The most important benefit of the above create function is that: as far as any caller/client code is concerned, it behaves exactly like a normal TObject.Create.
And so the correct usage pattern is exactly the same.
Note that I'm not keen on J's FreeAndNil suggestion because if calling code doesn't check if the result was assigned: it is likely to AV. And code that does check the result correctly will be a little messy:
var k: TClassA;
begin
k := testResultObject; {assuming nil result on failed create, next/similar is *required*}
if Assigned(k) then {Note how this differs from normal try finally pattern}
try
//code using k
finally
k.Free;
end;
end;
NB: It's important to note that you cannot ever have your caller simply ignore memory management; which brings me to the next section.
All the above aside, there is much less chance of making careless mistakes if your testResultObject takes an input object that you require the caller to create and manage its lifetime as needed. I'm not sure why you're resisting that approach so much? You cannot get simpler than the following without resorting to a different memory model.
var k: TClassA;
begin
k := TClassA.Create;
try
testResultObject(k); {Where this is simply implemented as k.DoSomething;}
//more code using k
finally
k.Free;
end;
end;
The only problem with this :
function testResultObject: TClassA;
begin
Result := TClassA.Create;
try
Result.DoSomething;
except
Result.Free;
end;
end;
Is that you have no way of knowing whether the function was successful. Freeing an object does not alter the reference; the variable will still point to the (now) invalid memory location where the object used to exist. You must explicitly set the reference to nil if you want the consumer to be able to test if the reference is valid. If you want to use this pattern (having the consumer test for nil) then you would need to do :
try
Result.DoSomething;
except
FreeAndNil(Result);
end;
This way the caller can test the result for nil (using Assigned or otherwise) as you intended. This still isn't a very clean approach, however, since you're still swallowing exceptions. Another solution might be to simply introduce a new constructor or alter the existing one. For example
TFoo = class
public
constructor Create(ADoSomething : boolean = false);
procedure DoSomething;
end;
constructor TClassA.Create(ADoSomething: Boolean = False);
begin
inherited Create;
if ADoSomething then DoSomething;
end;
procedure TClassA.DoSomething;
begin
//
end;
This way you can get rid of all of the exception handling and just call this as :
function testResultObject: TClassA;
begin
Result := TClassA.Create(true);
end;
Since you've now pushed the DoSomething execution into the constructor any exceptions will naturally automatically call the destructor and your memory management problems go away. The other answers also have good solutions.
Prompted by a q here yesterday, I'm trying to re-familiarise myself with TGeckoBrowser
from here: http://sourceforge.net/p/d-gecko/wiki/Home.
(Nb: requires the Mozilla XulRunner package to be installed)
Things seem to have moved backwards a bit since I last tried in the WinXP era, in that
with a minimal D7 project to navigate to a URL, I'm getting errors that I don't recall
seeing before. I've included my code below. These are the errors which I've run into
navigating to sites like www.google.com, news.bbc.co.uk, and here, of course.
The first exception - "Exception in Safecall method" - occurs as my form first displays, before naviagting anywhere at all. I have a work-around in the form of a TApplication.OnException handler.
My q is: a) Does anyone know how to avoid it in the first place or b) is there a tidier way of catching it than setting up a TApplication.Exception handler, which always feels to me like a bit of
an admission of defeat (I mean having one to avoid the user seeing an exception, not having an application-wide handler at all).
This exception occurs in this code:
procedure TCustomGeckoBrowser.Paint;
var
rc: TRect;
baseWin: nsIBaseWindow;
begin
if csDesigning in ComponentState then
begin
rc := ClientRect;
Canvas.FillRect(rc);
end else
begin
baseWin := FWebBrowser as nsIBaseWindow;
baseWin.Repaint(True);
end;
inherited;
end;
in the call to baseWin.Repaint, so presumably it's
presumably coming from the other side of the interface. I only get it the first
time .Paint is called. I noticed that at that point, the baseWin returns False for GetVisibility,
hence the experimental code in my TForm1.Loaded, to see if that would avoid it.
It does not.
2.a After calling GeckoBrowser1.LoadURI, I get "Invalid floating point operation"
once or more depending on the URL being loaded.
2.b Again, depending on the URL, I get: "Access violation at address 556318B3 in module js3250.dll. Read of address 00000008." or similar. On some pages it occurs every few seconds (thanks I imagine to some JS timer code in the page).
2a & 2b are avoided by the call to Set8087CW in TForm1.OnCreate below but I'm
mentioning them mainly in case anyone recognises them and 1 together as symptomatic
of a systemic problem of some sort, but also so google will find this q
for others who run into those symptoms.
Reverting to my q 1b), the "Exception in Safecall method" occurs from StdWndProc->
TWinControl.MainWndProc->[...]->TCustomGeckoBrowser.Paint. Instead of using an
TApplication.OnException handler, is there a way of catching the exception further
up the call-chain, so as to avoid modifying the code of TCustomGeckoBrowser.Paint by
putting a handler in there?
Update: A comment drew my attention to this documentation relating to SafeCall:
ESafecallException is raised when the safecall error handler has not been set up and a safecall routine returns a non-0 HResult, or if the safecall error handler does not raise an exception. If this exception occurs, the Comobj unit is probably missing from the application's uses list (Delphi) or not included in the project source file (C++). You may want to consider removing the safecall calling convention from the routine that gave rise to the exception.
The GeckoBrowser source comes with a unit, BrowserSupports, which looks like a type library import unit, except that it seems to have been manually prepared. It contains an interface which includes the Repaint method which is producing the SafeCall exception.
nsIBaseWindow = interface(nsISupports)
['{046bc8a0-8015-11d3-af70-00a024ffc08c}']
procedure InitWindow(parentNativeWindow: nativeWindow; parentWidget: nsIWidget; x: PRInt32; y: PRInt32; cx: PRInt32; cy: PRInt32); safecall;
procedure Create(); safecall;
procedure Destroy(); safecall;
[...]
procedure Repaint(force: PRBool); safecall;
[...]
end;
Following the suggestion in the quoyed documentation, I changed th "safecall" to StdCall on the Repaint member (but only that member) and, presto!, the exception stopped occurring. If it doesn't reappear in the next couple of days, I'll post that as an answer, unless anyone comes up with a better one.
My project code:
uses
BrowserSupports;
procedure TForm1.FormCreate(Sender: TObject);
begin
Set8087CW($133F);
Application.OnException := HandleException;
end;
procedure TForm1.HandleException(Sender: TObject; E: Exception);
begin
Inc(Errors);
Caption := Format('Errors %d, msg: %s', [Errors, E.Message]);
Screen.Cursor := crDefault;
end;
type
TMyGeckoBrowser = class(TGeckoBrowser);
procedure TForm1.Loaded;
begin
inherited;
GeckoBrowser1.HandleNeeded;
(TMyGeckoBrowser(GeckoBrowser1).WebBrowser as nsIBaseWindow).SetVisibility(True);
end;
procedure TForm1.btnLoadUrlClick(Sender: TObject);
begin
try
GeckoBrowser1.LoadURI(edUrl.Text);
except
end;
end;
Looking at the headers, the prototype for Repaint is effectively as follows:
HRESULT __stdcall Repaint(PRBool force);
and that means that
procedure Repaint(force: PRBool); safecall;
is a reasonable declaration. Remember that safecall performs parameter re-writing to convert COM error codes into exceptions.
This does mean that if the call to Repaint returns a value that indicates failure, then the safecall mechanism will surface that as an exception. If you wish to ignore this particular exception then it is cleaner to do so at source:
try
baseWin.Repaint(True);
except
on EOleException do
; // ignore
end;
If you wish to avoid dealing with exceptions then you could switch to stdcall, but you must remember to undo the parameter re-writing.
function Repaint(force: PRBool): HRESULT; stdcall;
Now you can write it like this:
if Failed(baseWin.Repaint(True)) then
; // handle the error if you really wish to, or just ignore it
Note that Failed is defined in the ActiveX unit.
If you want to troubleshoot the error further then you can look at the error code:
var
hres: HRESULT;
....
hres := baseWin.Repaint(True);
// examine hres
Or if you are going to leave the function as safecall then you can retrieve the error code from the EOleException instance's ErrorCode property.
please tell me: how to know if TEvent is Signaled or not?
Click on STOP-button = SetEvent(Events[1]);
I am trying to unzip an archive and if STOP-button is pressed then a tread must be terminated and Unzippping must be aborted.
My code:
procedure TForm2.ZipForge1OverallProgress(Sender: TObject; Progress: Double;
Operation: TZFProcessOperation; ProgressPhase: TZFProgressPhase;
var Cancel: Boolean);
begin
if Events[1]<>null then
begin
ThreadUpdating.Terminate;
Abort;
end else
form2.Update_ProgressBar.Position := Trunc(Progress);
end;
But if I press STOP-button(SetEvent(Events[1])) nothing happens.
PS: I am using WaitForMultipleObjects(Event[1],Event[2]) in a thread. Event [1] is being used as a signal of STOP in two parts: in ZipForge1OverallProgress and WaitForMultipleObjects.
Call WaitForMultipleObjects, but do it properly. You haven't shown that code, and the code you have shown doesn't look right anyway.
First, it looks like you're trying to check whether the Events[1] element is a null pointer. Null pointers in Delphi are spelled nil, not null; the latter is a function that returns a null Variant value (but since Variant is convertible to lots of other types, the compiler probably doesn't alert you that your code is wrong). Next, it looks as though the event you're handling has a Cancel parameter that you can set to notify the caller that it should stop what it's doing, but instead of just setting that, you're throwing an EAbort exception.
If the progress event you show here is really running in a separate thread, then it must not modify property of VCL objects like TProgressBar. You need to use Synchronize to make sure VCL operations only occur in the VCL thread.
As I said, you need to call WaitForMultipleObjects property. That means passing it four parameters, for one thing. You appear to have an array with at least two handles in it, so call it like this:
var
Ret: DWord;
Ret := WaitForMultipleObjects(2, #Events[1], False, Timeout);
case Ret of
Wait_Object_0: begin
// Events[1] is signaled
end;
Wait_Object_0 + 1: begin
// Events[2] is signaled
end;
Wait_Timeout: begin
// Neither is signaled. Do some more work, or go back to waiting.
end;
Wait_Failed: begin
RaiseLastOSError;
end;
end;
If all you want to do is check whether the handle is signaled, but you don't want to wait for it to become signaled if it isn't already, then use a timeout value of zero.
'if Events[1]<>null then begin' is this pseudocode? Doesn't lok like it - looks more like real Delphi to me:) If so, you are just checking to see if the Event object is assigned, rather than signaled.
If you want to poll the stop event in your OverallProgress handler, you need to call WaitForSingleObject() with a timeout of 0.
Can you not just check a 'stop' boolean in your handler? This would be much quicker than a kernel call. You may need the Event as well so that the WFMO call at the top of the thread gets signaled when an abort/terminate is needed or you might get away with signaling some other event in the WFMO array by always checking for stop:
TmyThread = class(TThread)
..
public
stopRequested:boolean;
procedure stop;
..
end;
procedure TmyThread.stop;
begin
stopRequested:=true;
someEventInWFMOarray.signal;
end;
procedure TmyThread.execute;
begin;
while true do
begin
waitForMultipeObjects();
if stopRequested then exit;
work;
end;
end;
TForm2.ZipForge1OverallProgress(sender:TObject,......)
begin
cancel:=TmyThread(Sender).stopRequested;
if cancel then exit;
doStuff;
end;
Here I provide simple piece of code.
function GetStringList:TStringList;
var i:integer;
begin
Result:=TStringList.Create;
Result.Add('Adam');
Result.Add('Eva');
Result.Add('Kain');
Result.Add('Abel');
end;
procedure ProvideStringList(SL:TStringList);
var i:integer;
Names:TStringList;
begin
Names:=TStringList.Create;
Names.Add('Adam');
Names.Add('Eva');
Names.Add('Kain');
Names.Add('Abel');
SL.Assign(Names);
Names.Free;
end;
procedure TForm1.btn1Click(Sender: TObject);
var SL:TStringList;
i:integer;
begin
SL:=TStringList.Create;
SL.Assign(GetStringList);
for i:=0 to 3 do ShowMessage(SL[i]);
SL.Free;
end;
procedure TForm1.btn2Click(Sender: TObject);
var SL:TStringList;
i:integer;
begin
SL:=TStringList.Create;
ProvideStringList(SL);
for i:=0 to 3 do ShowMessage(SL[i]);
SL.Free;
end;
And now the question: what will happen to result object in function GetStringList:Tstringlist, which is created, but never freed? (I call 2 times Create and only 1 time Free)
Is it memory safe to provide objects by function or should I use procedures to do this task, where object creation and destroying is simply handled (procedure ProvideStringlist)? I call 2 times Create and 2 times Free.
Or is there another solution?
Thanx in advance
Lyborko
Is it memory safe to provide an object as a function result?
It is possible, but it needs attention from the implementor and the call.
Make it clear for the caller, the he controls the lifetime of the returned object
Make shure you don't have a memory leak when the function fails.
For example:
function CreateBibleNames: TStrings;
begin
Result := TStringList.Create;
try
Result.Add('Adam');
Result.Add('Eva');
Result.Add('Kain');
Result.Add('Abel');
except
Result.Free;
raise;
end;
end;
But in Delphi the most commen pattern for this is:
procedure GetBibleNames(Names: TStrings);
begin
Names.BeginUpdate;
try
//perhaps a Names.Clear here
//but I don't use it often because the other
//way is more flexible for the caller
Names.Add('Adam');
Names.Add('Eva');
Names.Add('Kain');
Names.Add('Abel');
finally
Names.EndUpdate;
end;
end;
so the caller code can look like this:
procedure TForm1.btn1Click(Sender: TObject);
var
Names: TStrings;
i:integer;
begin
Names := CreateBibleNames;
try
for i := 0 to Names.Count -1 do
ShowMessage(Names[i]);
finally
Names.Free;
end;
end;
and the other, more common version:
procedure TForm1.btn1Click(Sender: TObject);
var
Names: TStrings;
i:integer;
begin
Names := TStringList.Create;
try
GetBibleNames(Names);
for i := 0 to Names.Count -1 do
ShowMessage(Names[i]);
finally
Names.Free;
end;
end;
(I have no compiler at the moment, so perhaps there are some errors)
I don't know what you mean by safe, but it is common practice. The caller of the function becomes responsible for freeing the returned object:
var
s : TStringList;
begin
s := GetStringList;
// stuff
s.free;
end;
Memory safety is a stricter variant of type safety. For memory safety, you typically need a precise garbage collector and a type system which prevents certain kinds of typecasts and pointer arithmetic. By this metric, Delphi is not memory safe, whether you write functions returning objects or not.
These are the very kinds of questions I grappled with in my early days of Delphi. I suggest you take your time with it:
write test code with debug output
trace your code step-by-step
try different options and code constructs
and make sure you understand the nuances properly;
The effort will prove a great help in writing robust code.
Some comments on your sample code...
You should get into the habit of always using resource protection in your code, even in simple examples; and especially since your question pertains to memory (resource) protection.
If you name a function GetXXX, then there's no reason for anyone to suspect that it's going to create something, and they're unlikely to protect the resource. So careful naming of methods is extremely important.
Whenever you call a method that creates something, assume it's your responsibility to destroy it.
I noticed some code that would produce Hints from the compiler. I recommend you always eliminate ALL Hints & Warnings in your programs.
At best a Hint just means some arbitrary redundant code (excesses of which make maintenance more difficult). More likely it implies you haven't finished something, or rushed it and haven't finished testing/checking.
A Warning should always be taken seriously. Even though sometimes the compiler's concern is a logical impossibility in the specific situation, the warning may indicate some subtle language nuance that you're not aware of. The code can always be rewritten in a more robust fashion.
I have seen many examples of poor resource protection where there is a compiler warning giving a clue as to the problem. So check them out, it will aid in the learning.
If an exception is raised in a method that returns a new object, care should be taken to ensure there isn't a memory leak as a result.
//function GetStringList:TStringList;
function CreateStringList:TStringList; //Rename method lest it be misinterpreted.
//var i: Integer; You don't use i, so why declare it? Get rid of it and eliminate your Hints and Warnings!
begin
Result := TStringList.Create;
try //Protect the memory until this method is done; as it can **only** be done by **this** method!
Result.Add('Adam');
Result.Add('Eva');
Result.Add('Kain');
Result.Add('Abel');
except
Result.Destroy; //Note Destroy is fine because you would not get here if the line: Result := TStringList.Create; failed.
raise; //Very important to re-raise the exception, otherwise caller thinks the method was successful.
end;
end;
A better name for the following would be PopulateStringList or LoadStringList. Again, resource protection is required, but there is a simpler option as well.
procedure ProvideStringList(SL:TStringList);
var //i:integer; You don't use i, so why declare it? Get rid of it and eliminate your Hints and Warnings!
Names:TStringList;
begin
Names:=TStringList.Create;
try //ALWAYS protect local resources!
Names.Add('Adam');
Names.Add('Eva');
Names.Add('Kain');
Names.Add('Abel');
SL.Assign(Names);
finally //Finally is the correct choice here
Names.Free; //Destroy would also be okay.
end;
end;
However; in the above code, creating a temporary stringlist is overkill when you could just add the strings directly to the input object.
Depending on how the input stringlist is used, it is usually advisable to enclose a BeginUpdate/EndUpdate so that the changes can be handled as a batch (for performance reasons). If your method is general purpose, then you have no idea of the origin of the input, so you should definitely take the precaution.
procedure PopulateStringList(SL:TStringList);
begin
SL.BeginUpdate;
try //YES BeginUpdate must be protected like a resource
SL.Add('Adam');
SL.Add('Eva');
SL.Add('Kain');
SL.Add('Abel');
finally
SL.EndUpdate;
end;
end;
our original code below had a memory leak because it called a method to create an object, but did not destroy. However, because the method that created the object was called GetStringList, the error is not immediately obvious.
procedure TForm1.btn1Click(Sender: TObject);
var SL:TStringList;
i:integer;
begin
//SL:=TStringList.Create; This is wrong, your GetStringList method creates the object for you.
//SL.Assign(GetStringList);
SL := CreateStringList; //I also used the improved name here.
try //Don't forget resource protection.
for i:=0 to 3 do ShowMessage(SL[i]);
finally
SL.Free;
end;
end;
The only error in your final snippet was the lack of resource protection. The technique used is quite acceptable, but may not be ideally suited to all problems; so it helps to also be familiar with the previous technique.
procedure TForm1.btn2Click(Sender: TObject);
var SL:TStringList;
i:integer;
begin
SL:=TStringList.Create;
try //Be like a nun (Get in the habit)
ProvideStringList(SL);
for i:=0 to 3 do ShowMessage(SL[i]);
finally
SL.Free;
end;
end;
No, it is not "memory safe". When you create an object, someone has to free it.
Your first example leaks memory:
SL:=TStringList.Create;
SL.Assign(GetStringList); // <-- The return value of GetStringList is
// used, but not freed.
for i:=0 to 3 do ShowMessage(SL[i]);
SL.Free;
The second example works fine, but you don't have to create and free an additional temporary instance (Names)
In general, the second example is slightly better, because it is obvious, who is responsible for the creation and destruction of the list. (The caller) In other situations, a returned object must be freed by the caller or perhaps it's forbidden. You can't tell from the code. If you must do so, it's good practice to name your methods accordingly. (CreateList is better than GetList).
It is the usage that is the leak, not the construct itself.
var sl2 : TStringlist;
sl2:=GetStringList;
sl.assign(sl2);
sl2.free;
is perfectly fine, or easier even,
sl:=getstringlist;
// no assign, thus no copy, one created one freed.
sl.free;
In btn1Click you should do:
var sl2: TStringList;
sl2 := GetStringList:
SL.Assign(sl2);
sl2.Free;
In btn2Click you don't have to create an instance of SL before calling ProvideStringList to not create a memory leak.
I use a combination of both idioms. Pass the object as an optional parameter and if not passed, create the object. And in either case return the object as the function result.
This technique has (1) the flexibility of the creation of the object inside of the called function, and (2) the caller control of the caller passing the object as a parameter. Control in two meanings: control in the real type of the object being used, and control about the moment when to free the object.
This simple piece of code exemplifies this idiom.
function MakeList(aList:TStrings = nil):TStrings;
var s:TStrings;
begin
s:=aList;
if s=nil then
s:=TSTringList.Create;
s.Add('Adam');
s.Add('Eva');
result:=s;
end;
And here are three different ways to use it
simplest usage, for quick and dirty code
var sl1,sl2,sl3:TStrings;
sl1:=MakeList;
when programmer wants to make more explicit ownership and/or use a custom type
sl2:=MakeList(TMyStringsList.create);
when the object is previously created
sl3:=TMyStringList.Create;
....
MakeList(sl3);
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.