1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
unit protokollunit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
tProtokolldatei = record
datei: textfile;
einrueckung: longint;
end;
{ tProtokollant }
tProtokollant = class(TObject)
private
sDat: ^tProtokolldatei;
bes: string;
kinder: array of tProtokollant;
elter: tProtokollant;
public
constructor create(dateiname: string); overload;
constructor create(elter_: tProtokollant; besitzer: string); overload;
destructor destroy; override;
procedure schreibe(s: string);
procedure schreibe(s: string; tee: boolean);
procedure destroyall;
end;
implementation
{ tProtokollant }
constructor tProtokollant.create(dateiname: string);
begin
inherited create;
getmem(sDat,sizeof(tProtokolldatei));
sDat^.einrueckung:=10;
assignfile(sDat^.datei,dateiname);
rewrite(sDat^.datei);
bes:='';
setlength(kinder,0);
elter:=nil;
end;
constructor tProtokollant.create(elter_: tProtokollant; besitzer: string);
begin
inherited create;
sDat:=elter_.sDat;
setlength(elter_.kinder,length(elter_.kinder)+1);
elter_.kinder[length(elter_.kinder)-1]:=self;
elter:=elter_;
setlength(kinder,0);
bes:=elter.bes+'.'+besitzer;
if pos('.',bes)=1 then delete(bes,1,1);
if length(bes)+4 > sDat^.einrueckung then
sDat^.einrueckung:=length(bes)+4;
end;
destructor tProtokollant.destroy;
var
i: longint;
begin
while length(kinder)>0 do
kinder[length(kinder)-1].free;
if assigned(elter) then begin
flush(sDat^.datei);
i:=0;
while (i<length(elter.kinder)) and (elter.kinder[i]<>self) do
inc(i);
if i>=length(elter.kinder) then
schreibe('destroy fehlgeschlagen, ich kann mich nicht sehen.');
inc(i);
while i<length(elter.kinder) do begin
elter.kinder[i-1]:=elter.kinder[i];
inc(i);
end;
setlength(elter.kinder,length(elter.kinder)-1);
end
else begin
closefile(sDat^.datei);
freemem(sDat,sizeof(tProtokolldatei));
end;
inherited destroy;
end;
procedure tProtokollant.destroyall;
begin
if Assigned(elter) then elter.destroyall
else destroy;
end;
procedure tProtokollant.schreibe(s: string);
begin
schreibe(s,false);
end;
procedure tProtokollant.schreibe(s: string; tee: boolean);
var
i: longint;
begin
for i:=length(bes)+1 to sDat^.einrueckung do
s:=' '+s;
writeln(sDat^.datei,bes+s);
if tee then
writeln(bes+s);
end;
end.
|
