Systemressourcen erschöpft beim VirtualStringTree.AfterCellPaint

[Hobbycoder]

Zitat von Bernhard Geyer:

Zitat von Hobbycoder:

Leider liefern die mir auch (nicht wenige) MemoryLeaks von UniDAC, zu denen ich aber keine Sources habe.

Wir haben auch Unidac und nutzen auch FastMM und uns ist bisher kein MemoryLeak von Unidac (Oracle + MySQL) aufgefallen.

Gut. Aber wenn ich meine Anwendung kurz starte, dann bekomme ich eine ganz Liste (ReportMemoryLeaksOnShutDown, FastMM muss ich noch mal ausprobieren für mehr Details).
Und da mach ich dann noch nicht mal viel. Die Connection wird geöffnet, es werden 2-3 Query abgefragt, 2 Threads laufen durch. Das wars. Da sind ein paar Einträge, über deren Klassennamen kann meine Klassen erkennen. Das meiste stammt von UniDAC.
Ich will aber nicht ausschließen, dass es mein Fehler ist. Ich arbeite grundsätzlich über Klassen, in denen die Datenbankabfragen laufen. Alles ist über Try..Finally abgesichert, dass jedes object auch wieder freigegeben wird (kann höchstens sein, dass ich es mal an einer Stelle übersehen habe. Aber soweit ich das bisher gesichtet habe, sollte das nicht der Fall sein).

Die Connection halte in einer globalen Klasse, die beim Programmstart erzeugt wird und übergebe die halt immer an die Querys.
Hier mal ein Beispiel für eine Query-Klasse:

Delphi-Quellcode:

procedure TZeitenList.LoadFromDB(Con: TUniConnection; Betriebguid: TGUID);
var
  q: TUniQuery;
  z: TZeiten;
begin
  q:=TUniQuery.Create(nil);
  try
    self.Clear;
    q.Connection:=Con;
    q.SQL.Text:='Select * from zeiten where betriebguid=:betriebguid order by ID';
    q.Params.ParamValues['betriebguid']:=Betriebguid.ToString;
    q.Active:=True;
    while not q.Eof do
    begin
      z:=TZeiten.Create;
      z.ID:=q.FieldByName('ID').AsInteger;
      z.guid:=StringToGUID(q.FieldByName('guid').AsString);
      z.betriebguid:=StringToGUID(q.FieldByName('betriebguid').AsString);
      z.zeitstr:=q.FieldByName('zeitstr').AsString;
      self.Add(z);
      q.Next;
    end;
    q.active:=False
  finally
    q.Free;
  end;
end;

Ungefähr so sehen alle Abfragen aus.
Und meine globale Klasse sieht so aus:

Delphi-Quellcode:

unit Data.tpdbaccess;

interface

uses Classes, System.SysUtils, Data.DB, DBAccess, Uni, Tools.globalTypes, MySQLUniProvider, Local.ConnectionList, Tools.globalConst,
  MemData;

type
  TOnConnect=procedure(Verindungsname: string) of object;
  TOnDisconnect=procedure of object;
  TOnSendDBUpdateMessage=procedure(Msg: string; Append: Boolean) of object;

  TDBAccess=class
  private
    class var FCon: TUniConnection;
    class var FConnectionList: TConnectionList;
    class var FVerbindungsname: string;
    class var FOnConnect: TOnConnect;
    class var FOnDisconnect: TOnDisconnect;
    class var FOnSendDBUpdatemessage: TOnSendDBUpdateMessage;
    class constructor Create; overload;
    class procedure SetConnectionList(const Value: TConnectionList); static;
    class procedure SetVerbindungsname(const Value: string); static;
    class procedure DoConnect(Verbindungsname: string);
    class procedure DoDisconnect;
    class procedure AfterConnect(Sender: TObject);
    class procedure BeforeDisconnect(Sender: TObject);
    class procedure ConnectionLost(Sender: TObject; Component: TComponent; ConnLoseCouse: TConnLostCause; RetryMode: TRetryMode);
  public
    constructor Create(ConnectionItem: TConnectionItem); overload;
    destructor Destroy; override;
    class function open: Boolean; overload;
    class function open(ConnectionItem: TConnectionItem): Boolean; overload;
    class procedure Close;
    class property ConnectionList: TConnectionList read FConnectionList write SetConnectionList;
    class property Verbindungsname: string read FVerbindungsname write SetVerbindungsname;
    class procedure DoSendDBUpdateMessage(Msg: string; Append: Boolean = False);
    class property OnConnect: TOnConnect read FOnConnect write FOnConnect;
    class property OnDisconnect: TOnDisconnect read FOnDisconnect write FOnDisconnect;
    class property OnSendDBUpdateMessage: TOnSendDBUpdateMessage read FOnSendDBUpdatemessage write FOnSendDBUpdatemessage;
    class procedure GetTables(Strings: TStrings);
    class function ExecuteStatement(Statement: string): Variant; overload;
    class function ExecuteStatement(Statement: string; Params: array of Variant): Variant; overload;
    class function GetNewGUID: TGUID;
    class property Con: TUniConnection read FCon;
  end;

const
  NullGUID='{00000000-0000-0000-0000-000000000000}';

implementation

{ TDBAccess }

class constructor TDBAccess.Create;
begin
  inherited;
  FCon:=TUniConnection.Create(nil);
  FCon.AfterConnect:=AfterConnect;
  FCon.BeforeDisconnect:=BeforeDisconnect;
//  FCon.OnConnectionLost:=ConnectionLost;
  FConnectionList:=TConnectionList.Create(true);
end;

class procedure TDBAccess.AfterConnect(Sender: TObject);
begin
  DoConnect(FVerbindungsname);
end;

class procedure TDBAccess.BeforeDisconnect(Sender: TObject);
begin
  DoDisconnect;
end;

class procedure TDBAccess.Close;
begin
  FCon.Disconnect;
  FVerbindungsname:='';
end;

class procedure TDBAccess.ConnectionLost(Sender: TObject; Component: TComponent;
  ConnLoseCouse: TConnLostCause; RetryMode: TRetryMode);
begin
  RetryMode:=rmReconnect;
end;

constructor TDBAccess.Create(ConnectionItem: TConnectionItem);
begin
  self.Create;
  FCon.ProviderName:=TTPConnectionTypeStr[integer(ConnectionItem.ConnectionType)];
  FCon.Server:=ConnectionItem.Hostname;
  FCon.Port:=ConnectionItem.Port;
  FCon.Database:=ConnectionItem.Database;
  FCon.Username:=ConnectionItem.UserName;
  FCon.Password:=ConnectionItem.Password;
  FVerbindungsname:=ConnectionItem.ConnectionName;
  open;
end;

destructor TDBAccess.Destroy;
begin
  if FCon.Connected then FCon.Disconnect;
  FConnectionList.Free;
  FCon.Free;
  inherited;
end;

class procedure TDBAccess.DoConnect(Verbindungsname: string);
begin
  if Assigned(FOnConnect) then
    FOnConnect(Verbindungsname);
end;

class procedure TDBAccess.DoDisconnect;
begin
  if Assigned(FOnDisconnect) then
    FOnDisconnect;
end;

class procedure TDBAccess.DoSendDBUpdateMessage(Msg: string; Append: Boolean);
begin
  if Assigned(FOnSendDBUpdatemessage) then
    FOnSendDBUpdatemessage(Msg, Append);
end;

class function TDBAccess.ExecuteStatement(Statement: string;
  Params: array of Variant): Variant;
begin
  Result:=FCon.ExecSQL(Statement, Params);
end;

class function TDBAccess.ExecuteStatement(Statement: string): Variant;
begin
  Result:=FCon.ExecSQL(Statement);
end;

class function TDBAccess.GetNewGUID: TGUID;
begin
  createGUID(Result);
end;

class procedure TDBAccess.GetTables(Strings: TStrings);
begin
  FCon.GetTableNames(Strings);
end;

class function TDBAccess.open: Boolean;
begin
  try
    Try
      FCon.Connect;
    Except
      FVerbindungsname:='';
    End;
  finally
    Result:=FCon.Connected;
  end;
end;

class function TDBAccess.open(ConnectionItem: TConnectionItem): Boolean;
begin
  FCon.ProviderName:=TTPConnectionTypeStr[integer(ConnectionItem.ConnectionType)];
  FCon.Server:=ConnectionItem.Hostname;
  FCon.Port:=ConnectionItem.Port;
  FCon.Database:=ConnectionItem.Database;
  FCon.Username:=ConnectionItem.UserName;
  FCon.Password:=ConnectionItem.Password;
  FVerbindungsname:=ConnectionItem.ConnectionName;
  Result:=open;
end;

class procedure TDBAccess.SetConnectionList(const Value: TConnectionList);
begin
  FConnectionList := Value;
end;

class procedure TDBAccess.SetVerbindungsname(const Value: string);
begin
  FVerbindungsname := Value;
end;

end.

Diese wird im Create der Mainform erzeugt und in deren Destroy auch wieder freigegeben.
(Die Threads erzeugen sich natürlich eine eigene TUniConnection).

Bisher hat das auch recht gut funktioniert. Leider habe ich nicht von Anfang an mit ReportMemoryLeaksOnShutDown gearbeitet. Die größe des Projekt macht es jetzt natürlich umso schwieriger.