protokollunit.pas neu

1 files changed, 114 insertions, 0 deletions

diff --git a/protokollunit.pas b/protokollunit.pas
new file mode 100644
index 0000000..74e9caf
--- /dev/null
+++ b/protokollunit.pas
@@ -0,0 +1,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.
+