D2010, Win7 64bit.
Hello,
I have a buttonClick event with needs to process a TDataSet opened in another routine...
GetDBGenericData.
The function GetDBGenericData returns a TDataSet. This routine basically takes a tQuery component, sets it's SQL property, and opens it. It then returns the TDataSet to my buttonclick.
procedure TForm1.Button2Click(Sender: TObject);
var
DS : TDataSet;
begin
DS := TDataSet.Create(nil);
DS := GetDBGenericData(dbSOURCE, 'LIST_ALL_SCHEMAS', [] );
while Not DS.EOF do
begin
ShowMessage(DS.FieldByName('USERNAME').AsString);
DS.Next;
end;
DS.Close;
DS.Free;
My problem is -- Understanding DS.
I am creating it here in this routine. I am "assigning" it to a TDataSet that points to a component. If I DON'T Free it, I have a memory leak (as reported by EurekaLog).
If I do free it, I get an AV the next time I run this routine. (specifically inside the GetDBGenericData routine).
What I think is happening is that DS is getting assigned to (as opposed to copying) to the TDataSet that is being returned, so in effect, I am FREEING BOTH DS in this routine, and the tQuery in GetDBGenericData, when I do a free.
How do I "break" the linkage, and then delete the memory associated to ONLY the one I am dynamically creating.
Thanks,
GS
If your DS variable is being assigned another TDataSet by GetDBGenericData, you should neither Create or Free it. You're just using it to refer to an existing dataset.
procedure TForm1.Button2Click(Sender: TObject);
var
DS : TDataSet;
UserNameField: TField; // Minor change for efficiency
begin
DS := GetDBGenericData(dbSOURCE, 'LIST_ALL_SCHEMAS', [] );
// Call FieldByName only once; no need to create or
// free this either.
UserNameField := DS.FieldByName('USERNAME');
while not DS.Eof do
begin
ShowMessage(UserNameField.AsString);
DS.Next;
end;
// I'd probably remove the `Close` unless the function call
// above specifically opened it before returning it.
DS.Close;
end;
Related
I try to create new unit Ado_Op , in this unit i try to create a procedure like this :
procedure CloseAllTables ();
Var I : Integer; T : TADOTable;
begin
for I := 1 to ComponentCount-1 do
if Components[i] is TADOTable then
begin
T := FindComponent(Components[i].Name) as TADOTable;
T.Close;
end;
T.Destroy;
end;
Error :
ComponentCount inaccessible.
Note : I'm using Delphi 10 Seattle.
The compiler error you report is just the beginning of your problems. There are quite a few more. I see the following problems, with item 1 being the one noted in the question:
You need to supply an object on which to refer to the properties ComponentCount and Components[].
You are erroneously using one based indexing.
You needlessly call FindComponent to find the component that you already have.
You call Destroy once only, on whichever object you found last. Or on an uninitialized variable if you don't find any. The compiler should warn of this, and I do hope you have warnings and hints enabled, and heed them.
Based on the comments you are trying to call the Close method on each table owned by a form. Do that like so:
procedure CloseAllTables(Owner: TComponent);
var
i: Integer;
begin
for i := 0 to Owner.ComponentCount-1 do
if Owner.Components[i] is TADOTable then
TADOTable(Owner.Components[i]).Close;
end;
If you wish to destroy all of these components too, which I doubt, then you would need to run the loop in descending order. That's because when you destroy an component, it is removed from its owners list of components. That code would look like this, assuming that there was no need to call Close on an object that is about to be destroyed.
procedure DestroyAllTables(Owner: TComponent);
var
i: Integer;
begin
for i := Owner.ComponentCount-1 downto 0 do
if Owner.Components[i] is TADOTable then
Owner.Components[i].Free;
end;
Code like this logs all table inserts (from the entire application):
procedure TForm1.ACRDatabase1AfterInsertRecord(Sender: TACRDataSet;
const TableName: WideString; const FieldValues: TACRArrayOfTACRVariant);
begin
if (AnsiUpperCase(TableName) = AnsiUpperCase(LogTable.TableName)) then
Exit;
if (Sender is TACRTable) then
LogTable.Insert();
LogTable.FieldByName('EventTime').AsDateTime := Now;
LogTable.FieldByName('TableName').AsString := TableName;
LogTable.FieldByName('EventType').AsString := 'Insert ';
LogTable.FieldByName('Whatever').AsString := FieldValues[4].AsString;
LogTable.Post();
end;
But fieldValues are different for each table so you might crash
the application (almost sure) using fieldvalues i.e their index number.
How do you overcome this ? Is it possible to log each table separately ?
As I mentioned in a comment, I don't have Accuracer, but thought it might be helpful
to post a generic method of doing client-side logging, which can capture the value
of one or more fields and be used for as many datasets as you need. You may be
able to use part of it in your ACRDatabase1AfterInsertRecord handler, as its Sender
parameter appears to identify the dataset into which the new row has been inserted.
As you can see, there is a LogFields procedure which can be included in the AfterInsert
handler of any dataset you like and this calls a separate GetFieldsToLog procedure which
adds the names of the field(s) to log for a given dataset to a temporary StringList. It's
only the GetFieldsToLog procedure which needs to be adapted to the needs of a given set of datasets.
procedure TForm1.GetFieldsToLog(ADataSet : TDataSet; FieldList : TStrings);
begin
FieldList.Clear;
if ADataSet = AdoQuery1 then begin
FieldList.Add(ADataSet.Fields[0].FieldName);
end
else
// obviously, deal with other specific tables here
end;
procedure TForm1.LogFields(ADataSet : TDataSet);
var
TL : TStringList;
i : Integer;
ValueToLog : String;
begin
TL := TStringList.Create;
try
GetFieldsToLog(ADataSet, TL);
for i := 0 to TL.Count - 1 do begin
ValueToLog := ADataSet.FieldByName(TL[i]).AsString;
// do your logging here however you want
end;
finally
TL.Free;
end;
end;
procedure TForm1.ADOQuery1AfterInsert(DataSet: TDataSet);
begin
LogFields(DataSet);
end;
Btw, one of the points of having a separate GetFieldsToLog procedure is that it helps to extend
client-side logging to changes in existing dataset records. If you generate this list
at start-up and save it somewhere, you can use it in the BeforePost event of a dataset to
pick up the current and previous values of the field (using its Value and OldValue properties),
save those in an another StringList and log them in the AfterPost event. Of course,
if you'e using a common store for these value from more than one dataset, you need to make
sure that the AfterPost of one dataset fire before the BeforePost of any other, or do the logging
entirely within the BeforePost (having to store the old and current field values between
Before- and AfterPost is messy, and it would be better to do everything in the AfterPost,
but unfortunately the OldValue is out-of-date by the time AfterPost occurs.
Be aware that getting the OldValue requires the specific dataset type to correctly implement
it. Not all types of dataset I've come across do, though, so it needs checking.
Btw #2, supposing you have a procedure like this
procedure TForm1.DoSomething(AnObject : TObject);
then you can use "if AnObject is ..." to do something like this
var
AnAdoQuery : TAdoQuery;
begin
if AnObject is TAdoQuery then begin
// First, use a cast to assign Sender to the local AnAdoQuery variable
AnAdoQuery := TAdoQuery(AnObject);
// Then, we can do whatever we like with it, e.g.
Caption := AnAdoQuery.Name;
end;
end;
Otoh, if for some reason (and I can't immediately think why we would want to but never mind)
we just want to check that what we've been passed as the AnObject parameter is a particular
object, we can omit the cast and just do
if AnObject = AdoQuery1 then
ShowMessage('Received AdoQuery1');
This equality check works, regardless of the actual class of what we've been passed
as the AnObject parameter because all other classes are descendants of AnObject's
declared class, namely TObject.
is this piece of code safe from memory leaks?
s := TStringList.Create; // create first object
try
// Here line comes that seems to be dangerous
s := GetSomeSettings; // Overrides reference to first object by second one
finally
s.free; // Destroying only second object, leave first object to live somewhere in memory
end;
function GetSomeSettings : TStringList;
var
rawString : string;
settings : TStringList;
begin
// Singleton pattern implementation
// Trying to find already existing settings in class variable
settings := TSettingsClass.fSettings;
// If there is no already defined settings then get them
if not Assigned(settings) then
begin
GetSettingsInDB(rawString);
TSettingsClass.fSettings := ParseSettingsString(rawString);
settings := TSettingsClass.fSettings;
end;
Result := settings;
end;
I'm wondering s := GetSomeSettings; potentially harmful and ignoring first object, keeps it in the memory?
Yes, the StringList created on line 1 is leaked.
Essentialy, you are doing:
s := TStringList.Create;
s := AnotherStringList;
AnotherStringList.Free;
As for the GetSomeSettings routine:
Normally it is not wise or encouraged to return newly created instances as function results, because you transfer the responsibility for ownership and destruction to the calling code. Unless you have a mechanism/framework in place that takes care of it, which seems to be the case with your TSettingsClass, but there is not enough evidence for that in this little piece of code.
Nevertheless, the combination of both pieces of code display another problem: After s.Free, TSettingsClass.fSettings is destroyed but not nil. Thus the second time GetSomeSettings is called, it returns a dangling pointer.
1) you should not ask when you can check in two minutes!
program {$AppType Console};
uses Classes, SysUtils;
type TCheckedSL = class(TStringList)
public
procedure BeforeDestruction; override;
procedure AfterConstruction; override;
end;
procedure TCheckedSL.BeforeDestruction;
begin
inherited;
WriteLn('List ',IntToHex(Self,8), ' going to be safely destroyed.');
end;
procedure TCheckedSL.AfterConstruction;
begin
WriteLn('List ',IntToHex(Self,8), ' was created - check whether it is has matched destruction.');
inherited;
end;
procedure DoTest; var s: TStrings;
function GetSomeSettings: TStrings;
begin Result := TCheckedSL.Create end;
begin
Writeln('Entered DoTest procedure');
s := TCheckedSL.Create; // create first object
try
// Here line comes that seems to be dangerous
s := GetSomeSettings; // Overrides reference to first object by second one
finally
s.free; // Destroying only second object, leave first object
end;
Writeln('Leaving DoTest procedure');
end;
BEGIN
DoTest;
Writeln;
Writeln('Check output and press Enter when done');
ReadLn;
END.
2) Still that could be safe in few niche cases.
in FPC (http://FreePascal.org) S could be a "global property" of some unit, having a setter which would free old list.
in Delphi Classic S could be of some interface type, supported by the created object. Granted, standard TStringList lacks any interface, but some libraries ( for example http://jcl.sf.net ) do offer interface-based string lists, with richer API (iJclStringList type and related).
in Delphi/LLVM all objects were made reference-counted, like interfaces without GUID's. So that code would be safe there.
You can declare S as a record - a so-called Extended Record having re-defined class operator Implicit so that the typecast s{record} := TStringList.Create would free the previous instance before assigning a new one. That is dangerous though, as it is VERY fragile and easy to misuse, and destroy the list in some other place leaving a dangling pointer inside the S record.
Your object may be not that vanilla TStringList, but some subclass, overriding constructors or AfterConstruction to register itself in some list, that would be all-at-once in some place. Kind of Mark/Sweep heap management around large chunk of workload. VCL TComponent may be seen as following this pattern: form is owning its component and frees them when needed. And this is what you - in reduced form - are trying to do with TSettingsClass.fSettings containter (any reference is 1-sized container). However those frameworks do require a loopback: when the object is freed it should also remove itself from all the containers, referencing it.
.
procedure TCheckedSL.BeforeDestruction;
begin
if Self = TSettingsClass.fSettings then TSettingsClass.fSettings := nil;
inherited;
end;
class procedure TSettingsClass.SetFSettings(Value);
var fSet2: TObject;
begin
if fSettings <> nil then begin
fSet2 := fSettings;
f_fSettings := nil; // breaking the loop-chain
fSet2.Destroy;
end;
f_fSettings := Value;
end;
class destructor TSettingsClass.Destroy;
begin
fSettings := nil;
end;
However then - by the obvious need to keep design symmetric - the registration should also be done as a part of the class. Who is responsible for de-registration is usually the one responsible for registration as well, unless there are reasons to skew the design.
procedure TCheckedSL.AfterConstruction;
begin
inherited;
TSettingsClass.fSettings := Self;
end;
...
if not Assigned(settings) then
begin
GetSettingsInDB(rawString);
TCheckedSL.Create.Text := ParseSettingsString(rawString);
settings := TSettingsClass.fSettings;
Assert( Assigned(settings), 'wrong class used for DB settings' );
end;
Result := settings;
I have a design and run-time component that contains a large number of event handlers. I'll call it TNewComp for now. I create an instance of TNewComp on a TForm and fill in the event stubs with specific code via the property editor at design time, and realize I would like to be able to create new instances of TNewcomp that use the current set of event handler code.
To do this now, I call TNewComp's constructor and then "manually" assign each of the new instance's event handlers the corresponding event stub code resident on the form that contains the TNewComp instance created at design time. So if I have an instance of TNewComp assigned to a variable named FNewComp on a form called TNewForm, for each event handler I would do:
FNewComp.onSomething = TNewform.onSomething
(... repeat for each event handler belonging to TNewComp ...)
This works fine, but it is cumbersome and worse, if I add a new event handler to TNewComp, I have to remember to update my "newTComp()" function to make the event handler assignment. Rinse and repeat this process for every unique component type that I create new instances of dynamically.
Is there way to automate this process, perhaps using property inspection or some other Delphi 6 introspection technique?
-- roschler
I used the following code. Be careful with the Dest owner when creating, the safest way is to pass Nil and free the component by yourself later.
implementation uses typinfo;
procedure CopyComponent(Source, Dest: TComponent);
var
Stream: TMemoryStream;
TypeData : PTypeData;
PropList: PPropList;
i, APropCount: integer;
begin
Stream:=TMemoryStream.Create;
try
Stream.WriteComponent(Source);
Stream.Position:=0;
Stream.ReadComponent(Dest);
finally
Stream.Free;
end;
TypeData := GetTypeData(Source.ClassInfo);
if (TypeData <> nil) then
begin
GetMem(PropList, SizeOf(PPropInfo)*TypeData^.PropCount);
try
APropCount:=GetPropList(Source.ClassInfo, [tkMethod], PropList);
for i:=0 to APropCount-1 do
SetMethodProp(Dest, PropList[i], GetMethodProp(Source, PropList[i]))
finally
FreeMem(PropList);
end;
end;
end;
One option would be to save "the properly set up component" into stream and then load that strem into new, dynamically created component as if it is done by Delphi IDE/runtime.
Another option is to use RTTI, the TypInfo unit. There you have function GetPropList witch will enable you to query for available events (TypeKind tkMethod) and then you can use GetMethodProp and SetMethodProp to copy eventhandlers from one component to other.
I tweaked Maksee's solution to the following:
function CopyComponent(Source: TComponent; Owner: TComponent = nil): TComponent;
var
Stream: TMemoryStream;
TypeData : PTypeData;
PropList: PPropList;
i, APropCount: integer;
begin
if not Assigned(Source) then
raise Exception.Create('(CopyComponent) The Source component is not assigned.');
Result := TComponent.Create(Owner);
Stream := TMemoryStream.Create;
try
Stream.WriteComponent(Source);
Stream.Position := 0;
Stream.ReadComponent(Result);
finally
Stream.Free;
end; // try()
// Get the type data for the Source component.
TypeData := GetTypeData(Source.ClassInfo);
if (TypeData <> nil) then
begin
// Get the property information for the source component.
GetMem(PropList, SizeOf(PPropInfo) * TypeData^.PropCount);
try
// Get the properties count.
APropCount := GetPropList(Source.ClassInfo, [tkMethod], PropList);
// Assign the source property methods to the destination.
for i := 0 to APropCount - 1 do
SetMethodProp(Result, PropList[i], GetMethodProp(Source, PropList[i]))
finally
// Free the property information object.
FreeMem(PropList);
end; // try()
end; // if (TypeData <> nil) then
end;
So that a new component is returned by the function rather than passing in an existing component reference (the Dest parameter in Maksee's version). If anyone can see a flaw or problem that will result from this variant please comment.
In my app I have different forms that use the same datasource (so the queries are the same too), defined in a common datamodule. Question is, is there a way to know how many times did I open a specific query? By being able to do this, I could avoid close that query without closing it "every where else".
Edit: It's important to mention that I'm using Delphi3 and it is not a single query but several.
The idea is to use the DataLinks property of the TDataSource.
But, as it is protected, you have to gain access to it. One common trick is to create a fake descendant just for the purpose of casting:
type
TDataSourceHack = class(TDataSource);
Then you use it like:
IsUsed := TDataSourceHack(DataSource1).DataLinks.Count > 0;
You can get creative using a addref/release like approach. Just create a few functions and an integer variable in your shared datamodule to do the magic, and be sure to call them..partial code follows:
TDMShared = class(tDataModule)
private
fQueryCount : integer; // set to 0 in constructor
public
function GetQuery : tDataset;
procedure CloseQuery;
end;
function TDMShared.GetQuery : tDataset;
begin
inc(fQueryCount);
if fQueryCount = 1 then
SharedDatsetQry.open;
Result := shareddatasetqry; // your shared dataset here
end;
procedure TDMShared.CloseQuery;
begin
dec(fQueryCount);
if fQueryCount <= 0 then
shareddatasetqry.close; // close only when no refs left.
end;
EDIT: To do this with multiple queries, you need a container to hold the query references, and a way to manipulate them. a tList works well for this. You will need to make appropriate changes for your TDataset descendant, as well as create a FreeAndNil function if you are using an older version of Delphi. The concept I used for this was to maintain a list of all queries you request and manipulate them by the handle which is in effect the index of the query in the list. The method FreeUnusedQueries is there to free any objects which no longer have a reference...this can also be done as part of the close query method, but I separated it to handle the cases where a specific query would need to be reopened by another module.
Procedure TDMShared.DataModuleCreate(Sender:tObject);
begin
dsList := tList.create;
end;
Function TDMShared.CreateQuery(aSql:String):integer;
var
ds : tAdoDataset;
begin
// create your dataset here, for this example using TADODataset
ds := tAdoDataset.create(nil); // self managed
ds.connection := database;
ds.commandtext := aSql;
ds.tag := 0;
Result := dsList.add(ds);
end;
function TDMShared.GetQuery( handle : integer ) : tDataset;
begin
result := nil;
if handle > dsList.count-1 then exit;
if dsList.Items[ handle ] = nil then exit; // handle already closed
result := tAdoDataset( dsList.items[ handle ]);
Inc(Result.tag);
if Result.Tag = 1 then
Result.Open;
end;
procedure TDMShared.CloseQuery( handle : integer );
var
ds : tAdoDataset;
begin
if handle > dsLIst.count-1 then exit;
ds := tAdoDataset( dsList.items[ handle ]);
dec(ds.Tag);
if ds.Tag <= 0 then
ds.close;
end;
procedure TDMShared.FreeUnusedQueries;
var
ds : tAdoDataset;
ix : integer;
begin
for ix := 0 to dsList.Count - 1 do
begin
ds := tAdoDataset(dsLIst.Items[ ix ]);
if ds.tag <= 0 then
FreeAndNil(dsList.Items[ix]);
end;
end;
procedure TDMShared.DataModuleDestroy(Sender: TObject);
var
ix : integer;
begin
for ix := 0 to dsList.count-1 do
begin
if dsLIst.Items[ix] <> nil then
FreeAndNil(dsLIst.Items[ix]);
end;
dsList.free;
end;
Ok, a completely different solution...one that should work for Delphi 3.
Create a new "Descendant Object" from your existing dataset into a new unit, and add some behavior in the new object. Unfortunately I do not have Delphi 3 available for testing, but it should work if you can find the proper access points. For example:
TMySharedDataset = class(tOriginalDataset)
private
fOpenCount : integer;
protected
procedure Internal_Open; override;
procedure Internal_Close; override;
end;
TMySharedDataset.Internal_Open;
begin
inherited Internal_Open;
inc(fOpenCount);
end;
TMySharedDataset.Internal_Close;
begin
dec(fOpenCount);
if fOpenCount <= 0 then
Inherited Internal_Close;
end;
Then just include the unit in your data module, and change the reference to your shared dataset (you will also have to register this one and add it to the palette if your using components). Once this is done, you won't have to make changes to the other units as the dataset is still a descendant of your original one. What makes this all work is the creation of YOUR overridden object.
You could have a generic TDataSet on the shared datamodule and set it on the OnDataChange, using the DataSet property of the Field parameter
dstDataSet := Field.DataSet;
This way, when you want to close the dataset, close the dataset on the datamodule, which is a pointer to the correct DataSet on some form you don't even have to know