Konuyu Oyla:
  • Derecelendirme: 5/5 - 1 oy
  • 1
  • 2
  • 3
  • 4
  • 5
ÇÖZÜLDÜ --- RTTI Destroy Yardım
#1
Bir düzen içinde olan sınıfın tüm elemanlarını ve alt elemanlarını Destroy etmek için RTTI kullanıyorum. Fakat alt elemanları bir şekilde destroy etmiş olsam dahi MemoryLeak uyarısı alıyorum.
Sorunum TFieldDB Create edilirken IsFK parametresi True verilirse.
TFieldDB elemanının altında FKCol ve FKTable sınıfları da Create ediliyor.
RTTI ile destroy yaptığımda ise aslında Debug ile altındaki sınıfları da Free ediyor. Fakat uygulamayı kapatırken MemoryLeak uyarısı alıyorum.

Önce mevcut yapanın iskeletini belirteyim. 
TTable  //TCity sınıfı
  TFieldDB  //CityName
  TFieldDB  //CountryID  Ülke sınıfına bağlantı
    TForeingKey  //Farkı tabloya bağlantı bilgileri
      FKTable //TTable Tipinden TCountry ülke sınıfı
        TFieldDB  // CountryName
        ...
        TFieldDB  //IsEUMember
      FKCol  //TFieldDB Tipinden
      ..
  TFieldDB

TTable = class; //for forward declaration

TFieldDB = class; //for forward declaration

TForeingKey = class
 private
   FFKTable: TTable;
   FFKCol: TFieldDB;
 public
   constructor Create();
   destructor Destroy; override;
   property FKTable: TTable read FFKTable write FFKTable;
   property FKCol: TFieldDB read FFKCol write FFKCol;
 end;

 TFieldDB = class
 private
   FFieldName: string;
   FFieldType: TFieldType;
   FValue: Variant;
   FSize: Integer;
   FIsPK: Boolean;
   FIsUnique: Boolean;
   FIsNullable: Boolean;
   FIsFK: Boolean;
   FFK: TForeingKey;
 public
   destructor Destroy; override;
   property FieldName: string read FFieldName write FFieldName;
   property FieldType: TFieldType read FFieldType write FFieldType;
   property Value: Variant read FValue write FValue;
   property Size: Integer read FSize write FSize default 0;
   property IsPK: Boolean read FIsPK write FIsPK default False;
   property IsUnique: Boolean read FIsUnique write FIsUnique default False;
   property IsNullable: Boolean read FIsNullable write FIsNullable default True;
   property IsFK: Boolean read FIsFK write FIsFK default False;
   property FK: TForeingKey read FFK write FFK;

   constructor Create(const pFieldName: string; const pFieldType: TFieldType;
     const pValue: Variant; const pMaxLength: Integer=0; const pIsFK: Boolean=False; const pIsNullable: Boolean=True);

   procedure Clone(var pField: TFieldDB);
   procedure SetControlProperty(const pTableName: string; pControl: TWinControl);
 end;
 
Aşağıdaki gibi bir tablo sınıfım var. Ben bu tablo sınıfının içindeki tüm FCityName gibi private alanların hepsini destroy etmek istiyorum.

type
 TSysCity = class(TTable)
 private
   FCityName: TFieldDB;
   FCarPlateCode: TFieldDB;
   FCountryID: TFieldDB;
 protected
 published
   ...
 public
    ...
   property CityName: TFieldDB read FCityName write FCityName;
   property CountryID: TFieldDB read FCountryID write FCountryID;
   property CarPlateCode: TFieldDB read FCarPlateCode write FCarPlateCode;
 end;

implementation

constructor TSysCity.Create(OwnerDatabase:TDatabase);
begin
  inherited Create(OwnerDatabase);
  TableName := 'sys_city';
  SourceCode := '1000';

  FCityName := TFieldDB.Create('city_name', ftString, '', 0, False, False);
  FCountryID := TFieldDB.Create('country_id', ftInteger, 0, 0, True, False);  //burada olduğu gibi Create edip alt satırdaki gibi FK bağlantılı create edildiğinde sorun oluyor. 
  FCountryID.FK.FKTable := TSysCountry.Create(Database);  //Bu satırı ve altındaki satırı eklemeden üst satırdaki 0,0 dan sonraki True parametreyi false olarak alırsam sorunsuz çalışıyor.
  FCountryID.FK.FKCol := TFieldDB.Create(TSysCountry(FCountryID.FK.FKTable).CountryName.FieldName, TSysCountry(FCountryID.FK.FKTable).CountryName.FieldType, '', 0, False, False);
  FCarPlateCode := TFieldDB.Create('car_plate_code', ftInteger, 0, 0, False, True);
end;
destructor TTable.Destroy;
var
 vCtx : TRttiContext;
 vRtm : TRttiMethod;
 vRtf : TRttiField;
 vRtt : TRttiType;
 AValue: TValue;
 AObject: TObject;
 AField: TFieldDB;
begin
 vCtx := TRttiContext.Create;
 vRtt := vCtx.GetType(Self.ClassType);
 if Assigned(vRtt) then
   for vRtf in vRtt.GetFields do
     if Assigned(vRtf) then
       if vRtf.FieldType is TRttiInstanceType then
         //TFieldDB olup olmadığını burada kontrol edebileceğimiz gibi aşağıda da kontrol edebilirdik.
         if TRttiInstanceType(vRtf.FieldType).MetaclassType.InheritsFrom(TFieldDB) then
         begin
           AValue := vRtf.GetValue(Self);
           AObject := nil;
           if not AValue.IsEmpty then
             AObject := AValue.AsObject;

           if Assigned(AObject) then
             if AObject.InheritsFrom(TFieldDB) then  //TFieldDB olup olmadığını burada da kontrol edebiliriz.
               for vRtm in vRtf.FieldType.GetMethods('Destroy') do
               begin
                 if vRtm.IsDestructor then
                 begin
                   vRtm.Invoke(vRtf.GetValue(Self), []);
                   vRtf.SetValue(Self, nil);
                   break;
                 end;
               end;
         end
Ayrıca diğer Destroy kodlarıda burada.
destructor TFieldDB.Destroy;
begin
 if Assigned(FFK) then
   FFK.Free;
 inherited;
end;

destructor TForeingKey.Destroy;
begin
 if Assigned(FFKCol) then
   FFKCol.Free;
 if Assigned(FFKTable) then
   FFKTable.Free;
 inherited;
end;
Yanlış birşey yapmıyorsam normal şartlarda TFieldDB destroy olduğu anda TForeingKey sınıf tanımlı ise onuda destroy ediyor. Alt alta zincirleme şeklinde tüm elemanların silinmesi gerekiyor. Gerçi siliniyor görünüyor da. Fakat MemoryLeak oluşuyor. Sadece FK tanımlası yaptığım zaman.

MemoryLeak farklı bir durumdan kaynaklanıyormuş. 2 gündür gözden kaçırdığım farklı bir noktaya baktığım için bulamadığım bir sorundu. Şimdi buldum benim dalgınlığımdan kaynaklanan bir durum.

Örnek olması adına burada bu kod bulunsun belki başkalarının işine yarayabilir.
PostgreSQL - Linux - Delphi, Poliüretan
WWW
Cevapla


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  [ÇÖZÜLDÜ] Grafik VCL önerisi wiseman 8 259 11-04-2019, Saat: 22:21
Son Yorum: wiseman
  F9 ile derleme sonrası ortaya çıkan hatalar (Çözüldü) cinarbil 4 193 27-03-2019, Saat: 08:45
Son Yorum: Tuğrul HELVACI
  [Çözüldü] JSon String içindeki son altı bilgi CesuR 7 220 23-03-2019, Saat: 18:15
Son Yorum: Fesih ARSLAN
  [Çözüldü] HTTP üzerinden RTSP ile IP kamera stream işlemek Abdullah ILGAZ 3 1.372 06-03-2019, Saat: 00:47
Son Yorum: Yeliz
  String Fonksiyonları [Çözüldü] Mericx 8 292 04-03-2019, Saat: 15:39
Son Yorum: Mericx



Konuyu Okuyanlar: 1 Ziyaretçi