odList: TObjectList<Tod>;
constructor Tod.Create(AOwner: TComponent);
begin
inherited;
odList.Add(Self);
// od-Objekt registrieren
odClass := ClassName;
// Klassendefinitionen für meine RTTI-Funktionen und Datenspeicherung
if Self
is Todl
then
odClass := Copy(odClass, 4 + 1, MaxInt)
else
odClass := Copy(odClass, 3 + 1, MaxInt);
odName := odClass;
odId := GetNewOdId;
// eindeutige ObjektID zuweisen
end;
destructor Tod.Destroy;
begin
odList.Extract(Self);
// Liste meiner od-Objekte
odDestroy(Self);
inherited;
end;
procedure odDestroy(od: Tod);
var
I: Integer;
begin
I := 0;
while I <= odDataSetList.Count - 1
do // Liste von odControlern
begin
if odDataSetList[I].od = od
then
odDataSetList[I].od :=
nil;
if odDataSetList[I].use_od = od
then
odDataSetList[I].CalcUse;
Inc(I);
end;
TimerOdDestroy.Enabled := False;
// im Anschluss gleich die Refrenzen nilen
TimerOdDestroy.Enabled := True;
end;
procedure TTimerOdDestroy.DoTimer(Sender: TObject);
begin
TimerOdDestroy.Enabled := False;
odCheckPointer;
// Referenzen nilen
end;
procedure odCheckPointer;
var
iod: Tod;
begin
for iod
in odList
do
begin
if (iod <>
nil)
and (
not iod.HasNotOdPointer)
then
begin
odProp.CheckPointer(iod);
// Eigenschaften eines Objektes prüfen
end;
end;
end;
procedure TodProp.CheckPointer(
const od: Tod);
var
Context: TRttiContext;
RttiType: TRttiType;
PropInfo: TRttiProperty;
F: Boolean;
Attr: TCustomAttribute;
Value: TValue;
O: TObject;
PropValue:
String;
begin
if not Assigned(od)
then
Exit;
od.HasNotOdPointer := True;
Context := TRttiContext.Create;
RttiType := Context.GetType(od.ClassType);
if Assigned(RttiType)
then
begin
for PropInfo
in RttiType.GetProperties
do
begin
F := False;
for Attr
in PropInfo.GetAttributes
do
begin
if Attr
is AttrOd
then
F := True;
end;
if F
then
begin
PropValue := '
';
Value := TValue.Empty;
case PropInfo.PropertyType.TypeKind
of
tkClass:
begin
if PropInfo.IsWritable
then // betrifft die Eigenschaft eine Objektreferenz?
begin
od.HasNotOdPointer := False;
Value := PropInfo.GetValue(od);
if (
not Value.IsEmpty)
then
begin
O := Value.AsObject;
try // wenn das refenzierte Objekt nicht mehr existiert oder ein Zugriff fehl schlägt, dann nilen
if (O <>
nil)
and (O
is Tod)
and (
not odExist(O
as Tod))
then
begin
Value :=
nil;
PropInfo.SetValue(od, Value);
end;
except
Value :=
nil;
PropInfo.SetValue(od, Value);
end;
end;
end;
end;
end;
end;
end;
end;
Context.Free;
end;
function odExist(od: Tod): Boolean;
begin
Result := odList.IndexOf(od) >= 0;
end;