diff options
| -rw-r--r-- | protokollunit.pas | 114 |
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. + |