summaryrefslogtreecommitdiff
path: root/protokollunit.pas
blob: f03f4bc3f301d08bcc9cb45a9134bf866600a065 (plain)
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
115
116
117
118
119
120
121
122
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 destroyall;
    procedure schreibe(s: string);
    procedure schreibe(s: string; tee: boolean);
    procedure spuelen;
  end;


implementation

{ tProtokollant }

constructor tProtokollant.create(dateiName: string);
begin
  inherited create;
  getMem(sDat,sizeOf(tProtokollDatei));
  sDat^.einrueckung:=10;
  assignFile(sDat^.datei,dateiName);
  if fileExists(dateiName) then
    deleteFile(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;

procedure tProtokollant.spuelen;
begin
  flush(sDat^.datei);
end;

end.