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
  cxgrid sutun toplamı hatası (Çözüldü) cinarbil 0 23 6 saat önce
Son Yorum: cinarbil
  Çözüldü-istenen işlem yükseltme gerekiyor hatası delphi7 sadikacar60 7 178 19-02-2019, Saat: 10:34
Son Yorum: sadikacar60
  Dbgridi vertikal dbgrid olarak nasıl kullanabilirim?[ÇÖZÜLDÜ] baloglurecep 5 166 06-02-2019, Saat: 11:28
Son Yorum: idealist
  [ÇÖZÜLDÜ] Google Calendar API Server tipi Erişim Metodu hakkında tecrübesi olan mrmarman 41 3.291 01-02-2019, Saat: 09:30
Son Yorum: Bay_Y
  podesktopcenter (vs) poscreencenter Arasındaki Fark [ÇÖZÜLDÜ] SenayAkgun 6 209 30-01-2019, Saat: 00:00
Son Yorum: SenayAkgun



Konuyu Okuyanlar: 1 Ziyaretçi