summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorErich Eckner <git@eckner.net>2015-07-23 15:20:13 +0200
committerErich Eckner <git@eckner.net>2015-07-23 15:20:13 +0200
commit271339bda9e87962e8384238de2752a0be741202 (patch)
tree887a89f1f091f1d554edcc7874396c12f246f0b8
parentc32e27b77d08e0583e55c9459e166924ab8840bd (diff)
downloadunits-271339bda9e87962e8384238de2752a0be741202.tar.xz
etliche Prozeduren aus ../epost/*.pas uebernommen
-rw-r--r--lowlevelunit.pas577
-rw-r--r--mystringlistunit.pas187
2 files changed, 518 insertions, 246 deletions
diff --git a/lowlevelunit.pas b/lowlevelunit.pas
index d97cbf3..8fc6fa0 100644
--- a/lowlevelunit.pas
+++ b/lowlevelunit.pas
@@ -5,44 +5,35 @@ unit lowlevelunit;
interface
uses
- math, Classes, SysUtils, gmp, RegExpr, process;
+ math, Classes, SysUtils, gmp, RegExpr, process, agg_2D, FPimage, agg_basics;
type
- tMersenneTwister = class
- private
- state: array[0..623] of longword;
- index: longint;
- public
- procedure init(seed: longword);
- function extract_number: longword;
- function random(ma: longword): longword; overload;
- function random: extended; overload;
- procedure generate_numbers;
- end;
-
- tMyStringlist = class;
-
- tInputThread = class (tThread)
- fertig: boolean;
- inhalt: tMyStringList;
- proc: tProcess;
- constructor create(p: tProcess; sl: tMyStringList);
- destructor destroy; override;
- procedure execute; override;
- end;
-
- tMyStringlist = class (tStringlist)
- private
- line: longint;
- public
- constructor create;
- procedure loadFromFile(const s: ansiString); override;
- procedure loadFromGz(const s: ansiString);
- procedure saveToGz(const s: ansiString);
- function readln(out s: string): boolean;
- procedure grep(expr: string);
- function eof: boolean;
+ generic tArray<T> = array of T;
+ tLongintArray = specialize tArray<longint>;
+ pTLongintArray = ^tLongintArray;
+ tSingleArray = specialize tArray<single>;
+ pTSingleArray = ^tSingleArray;
+ tIntPoint = array['x'..'y'] of longint;
+ tExtPoint = array['x'..'y'] of extended;
+ t2x2Longint = array['x'..'y','x'..'y'] of longint;
+ t2x2Extended = array['x'..'y','x'..'y'] of extended;
+ tExtPointArray = specialize tArray<tExtPoint>;
+ pTExtPointArray = ^tExtPointArray;
+ tExtendedArray = specialize tArray<extended>;
+ pTExtendedArray = ^tExtendedArray;
+ tInt32Array = specialize tArray<int32>;
+ tByteArray = specialize tArray<byte>;
+ tStringArray = specialize tArray<string>;
+ tIntPointArray = specialize tArray<tIntPoint>;
+ tRGB = record
+ rgbBlue : byte;
+ rgbGreen: byte;
+ rgbRed : byte;
end;
+ tRgbArray = specialize tArray<tRGB>;
+ tKodierung = (kUnbekannt,k32BitSignedInteger);
+ tWarnstufe = (wsStreng,wsLasch);
+ tGenauigkeit = (gSingle,gExtended);
function signSqr(x: extended): extended; inline;
function mpfToStr(f: mpf_t): string;
@@ -55,221 +46,39 @@ function belegterSpeicher: int64;
function minCache: int64;
function cmpStr(s1,s2: string): longint;
function mitte(s1,s2: string): string;
-function myFloatToStr(x: extended): string;
+function myFloatToStr(x: extended): string; overload;
+function myFloatToStr(x: extended; ex: string): string; overload;
function myStrToFloat(s: string): extended;
+function floattostrtrunc(f: extended; dig: longint; laessig: boolean): string;
+function binOpPos(op: char; s: string): integer;
+function fktPos(fkt,s: string): integer;
+procedure gibAus(s: string; ausgaben: byte);
+function strToGen(out gen: tGenauigkeit; s: string): boolean;
+function orFarben(a,b: tRGB): tRGB;
+function andFarben(a,b: tRGB): tRGB;
+function wertZuFarbe(x: extended; p: tRGBArray): tRGB;
+function tFPColor2tRgb(c: tFPColor): tRGB;
+function tRgb2tFPColor(c: tRGB): tFPColor;
+procedure myDebugLnThreadLog(s: string);
+function belegterSpeicher: longint;
+procedure cleanupLogs;
+procedure cleanupLog(tid: PtrUInt);
+procedure dumpExceptionCallStack(E: Exception);
+function startetMit(start: string; var s: string): boolean;
+function endetMit(ende: string; var s: string): boolean;
+function trimAll(s: string): string;
+function erstesArgument(var s: string): string; overload;
+function erstesArgument(var s: string; Trenner: string): string; overload;
+function mydatetimetostr(t: tDateTime): string;
+function tExtPointToStr(p: tExtPoint): string;
+function tIntPointToStr(p: tIntPoint): string;
+procedure fehler(s: string);
+
implementation
var _cpuLastUsed,_cpuLastIdle: int64;
-// tMersenneTwister ************************************************************
-
-procedure tMersenneTwister.init(seed: longword);
-var
- i: longint;
-begin
- index:=0;
- state[0]:=seed;
- for i:=1 to 623 do
- state[i]:=longword($ffffffff and (qword(1812433253) * qword(state[i-1] xor state[i-1] shr 30) + i)); // 0x6c078965
-end;
-
-function tMersenneTwister.extract_number: longword;
-begin
- if index=0 then
- generate_numbers;
-
- result:=state[index];
- result:=result xor (result shr 11);
- result:=result xor longword(qword(result shl 7) and 2636928640); // 0x9d2c5680
- result:=result xor longword(qword(result shl 15) and 4022730752); // 0xefc60000
- result:=result xor (result shr 18);
-
- index := (index + 1) mod 624;
-end;
-
-function tMersenneTwister.random(ma: longword): longword;
-var
- i: longword;
-begin
- repeat
- i:=extract_number;
- until i<((high(longword)+1) div qword(ma))*ma;
- result:=i mod ma;
-end;
-
-function tMersenneTwister.random: extended;
-begin
- result:=(extract_number/(high(longword)+1) + extract_number)/(high(longword)+1);
-end;
-
-procedure tMersenneTwister.generate_numbers;
-var
- i,y: longint;
-begin
- for i:=0 to 623 do begin
- y:=longint((state[i] and $80000000) or // bit 31 (32nd bit) of MT[i]
- (state[(i+1) mod 624] and $7fffffff)); // bits 0-30 (first 31 bits) of MT[...]
- state[i]:=state[(i + 397) mod 624] xor (y shr 1);
- if odd(y) then
- state[i]:=longword(state[i] xor 2567483615); // 0x9908b0df
- end;
-end;
-
-// tInputThread ****************************************************************
-
-constructor tInputThread.create(p: tProcess; sl: tMyStringList);
-begin
- inherited create(true);
- fertig:=false;
- inhalt:=sl;
- proc:=p;
- suspended:=false;
-end;
-
-destructor tInputThread.destroy;
-begin
- inhalt:=nil;
- proc:=nil;
- inherited destroy;
-end;
-
-procedure tInputThread.execute;
-var
- wb,cwb: longint;
-begin
- wb:=0;
- while wb<length(inhalt.text) do begin
- cwb:=proc.input.write(inhalt.text[wb+1],length(inhalt.text)-wb);
- if cwb=0 then
- sleep(1)
- else
- wb:=wb+cwb;
- end;
- proc.CloseInput;
- fertig:=true;
-end;
-
-// tMyStringlist ***************************************************************
-
-constructor tMyStringlist.create;
-begin
- inherited create;
- line:=0;
-end;
-
-procedure tMyStringlist.loadFromFile(const s: ansiString);
-var i: longint;
-begin
- inherited loadFromFile(s);
- for i:=0 to count-1 do
- self[i]:=trim(self[i]);
- line:=0;
- writeln(inttostr(count)+' Zeilen eingelesen');
-end;
-
-procedure tMyStringlist.loadFromGz(const s: ansiString);
-var p: tProcess;
- buf: ansiString;
- rb,br: longint;
-begin
- p:=tProcess.create(nil);
- p.executable:='/usr/bin/zcat';
- p.parameters.add(s);
- p.options:=p.options + [poUsePipes];
- setlength(buf,0);
- br:=0;
- p.execute;
- while p.running do begin
- rb:=p.output.numBytesAvailable;
- if rb>0 then begin
- if length(buf)<br+rb then
- setlength(buf,br+rb+1048576);
- rb:=p.output.read(buf[br+1],rb);
- br:=br+rb;
- end
- else sleep(1);
- end;
- setlength(buf,br);
- rb:=p.output.numBytesAvailable;
- while rb>0 do begin
- setlength(buf,br+rb);
- rb:=p.output.read(buf[br+1],rb);
- br:=br+rb;
- rb:=p.output.numBytesAvailable;
- end;
- text:=buf;
- setlength(buf,0);
- p.free;
- for rb:=0 to count-1 do
- self[rb]:=trim(self[rb]);
- line:=0;
- writeln(inttostr(count)+' Zeilen eingelesen');
-end;
-
-procedure tMyStringlist.saveToGz(const s: ansiString);
-var
- p: tProcess;
- buf: array of byte;
- f: file;
- rb: longint;
- it: tInputThread;
-const
- outBufLen = 1024*1024;
-begin
- p:=tProcess.create(nil);
- p.executable:='/usr/bin/gzip';
- p.parameters.add('--best');
- p.parameters.add('-c');
- p.options:=p.options + [poUsePipes];
- p.execute;
- setlength(buf,outBufLen);
- fillchar(buf[0],length(buf)*sizeof(buf[0]),$0);
- it:=tInputThread.create(p,self);
- assignfile(f,s);
- rewrite(f,1);
- while p.running or (not it.fertig) or (p.output.numBytesAvailable>0) do begin
- rb:=min(length(buf),p.output.numBytesAvailable);
- if rb>0 then begin
- rb:=p.output.read(buf[0],rb);
- blockwrite(f,buf[0],rb);
- end
- else
- sleep(1); // nix zu Schreiben, nix zu Lesen, also warten wir
- end;
- it.free;
- closefile(f);
-end;
-
-function tMyStringlist.readln(out s: string): boolean;
-begin
- result:=not eof;
- if not result then begin
- s:='';
- exit;
- end;
- s:=self[line];
- inc(line);
-end;
-
-procedure tMyStringlist.grep(expr: string);
-var
- re: tRegExpr;
- i: longint;
-begin
- re:=tRegExpr.create;
- re.Expression:=expr;
- for i:=count-1 downto 0 do
- if not re.Exec(self[i]) then
- delete(i);
- re.free;
-end;
-
-function tMyStringlist.eof: boolean;
-begin
- result:=line>=count;
-end;
-
// allgemeine Funktionen *******************************************************
function signSqr(x: extended): extended;
@@ -478,6 +287,11 @@ begin
end;
function myFloatToStr(x: extended): string;
+begin
+ result:=myFloatToStr(x,'E');
+end;
+
+function myFloatToStr(x: extended; ex: string): string;
var
i,e: longint;
begin
@@ -506,7 +320,7 @@ begin
result:=result+char(ord('0')+floor(x));
end;
if e<>0 then
- result:=result+'E'+inttostr(e);
+ result:=result+ex+inttostr(e);
end;
function myStrToFloat(s: string): extended;
@@ -538,6 +352,279 @@ begin
result:=-result;
end;
+
+// allgemeine Funktionen *******************************************************
+
+function floattostrtrunc(f: extended; dig: longint; laessig: boolean): string;
+begin
+ result:=inttostr(round(f*power(10,dig)));
+ result:=copy(result,1,length(result)-dig)+'.'+copy(result,length(result)-dig+1,dig);
+ if laessig then
+ while result[length(result)]='0' do
+ delete(result,length(result),1);
+ if result[length(result)]='.' then
+ delete(result,length(result),1);
+end;
+
+function ZeitDarstellen(t: extended): string;
+var schreibe: boolean;
+begin
+ result:='(';
+ schreibe:=t>=1;
+ if schreibe then begin
+ result:=result+inttostr(floor(t))+' Tage ';
+ t:=t-floor(t);
+ end;
+ t:=t*24;
+ schreibe:=schreibe or (t>=1);
+ if schreibe then begin
+ result:=inttostr(floor(t))+':';
+ t:=t-floor(t);
+ end;
+ t:=t*60;
+ schreibe:=schreibe or (t>=1);
+ if schreibe then begin
+ result:=inttostr(floor(t))+':';
+ t:=t-floor(t);
+ end;
+ t:=t*60;
+ result:=result+inttostr(round(t))+' s)';
+end;
+
+function binOpPos(op: char; s: string): integer;
+begin
+ result:=0;
+ repeat
+ result:=result+max(1,pos(op,copy(s,result+1,length(s)-result)));
+ until ((result>1) and not (s[result-1] in ['+','-','*','/','(','E','e'])) or (result>length(s)) or (s[result]<>op);
+ if (result>length(s)) or (s[result]<>op) then result:=0;
+end;
+
+function fktPos(fkt,s: string): integer;
+var tmp: longint;
+begin
+ result:=pos(fkt,s);
+ while (result<>0) and ((result+length(fkt)>length(s)) or not (s[result+length(fkt)] in [' ','('])) do begin
+ tmp:=pos(fkt,copy(s,result+1,length(s)));
+ if tmp=0 then result:=0
+ else result:=result + tmp;
+ end;
+end;
+
+procedure gibAus(s: string; ausgaben: byte);
+begin
+ if odd(ausgaben) then myDebugLnThreadLog(s);
+ if odd(ausgaben div 2) then writeln(s);
+end;
+
+function strToGen(out gen: tGenauigkeit; s: string): boolean;
+begin
+ result:=true;
+ if (s='float') or (s='single') then
+ begin
+ gen:=gSingle;
+ exit;
+ end;
+ if s='extended' then
+ begin
+ gen:=gExtended;
+ exit;
+ end;
+ gibAus('Kenne Genauigkeitstyp '''+s+''' nicht!',3);
+ result:=false;
+end;
+
+function mischeFarben(a,b: tRGB; x: extended): tRGB;
+begin
+ result.rgbRed:=min(255,max(0,round(a.rgbRed*(1-x)+b.rgbRed*x)));
+ result.rgbGreen:=min(255,max(0,round(a.rgbGreen*(1-x)+b.rgbGreen*x)));
+ result.rgbBlue:=min(255,max(0,round(a.rgbBlue*(1-x)+b.rgbBlue*x)));
+end;
+
+function orFarben(a,b: tRGB): tRGB;
+begin
+ result.rgbRed:=a.rgbRed or b.rgbRed;
+ result.rgbGreen:=a.rgbGreen or b.rgbGreen;
+ result.rgbBlue:=a.rgbBlue or b.rgbBlue;
+end;
+
+function andFarben(a,b: tRGB): tRGB;
+begin
+ result.rgbRed:=a.rgbRed and b.rgbRed;
+ result.rgbGreen:=a.rgbGreen and b.rgbGreen;
+ result.rgbBlue:=a.rgbBlue and b.rgbBlue;
+end;
+
+function wertZuFarbe(x: extended; p: tRGBArray): tRGB;
+var i: longint;
+begin
+ x:=min(1,max(0,x))*(length(p)-1);
+ i:=floor(x);
+ if i>=(length(p)-1) then begin
+ result.rgbRed:=p[length(p)-1].rgbRed;
+ result.rgbGreen:=p[length(p)-1].rgbGreen;
+ result.rgbBlue:=p[length(p)-1].rgbBlue;
+ exit;
+ end;
+ if i<0 then begin
+ result.rgbRed:=p[0].rgbRed;
+ result.rgbGreen:=p[0].rgbGreen;
+ result.rgbBlue:=p[0].rgbBlue;
+ exit;
+ end;
+ x:=x-i;
+ result:=mischeFarben(p[i],p[i+1],x);
+end;
+
+function tFPColor2tRgb(c: tFPColor): tRGB;
+begin
+ result.rgbRed:=c.red;
+ result.rgbGreen:=c.green;
+ result.rgbBlue:=c.blue;
+end;
+
+function tRgb2tFPColor(c: tRGB): tFPColor;
+begin
+ result.red:=c.rgbRed;
+ result.green:=c.rgbGreen;
+ result.blue:=c.rgbBlue;
+end;
+
+procedure myDebugLnThreadLog(s: string);
+var f: textfile;
+ id: PtrUInt;
+begin
+ id:=getThreadID;
+ assignfile(f,'Log'+inttostr(id));
+ if fileexists('Log'+inttostr(id)) then append(f)
+ else rewrite(f);
+ writeln(f,inttostr(id)+': '+s);
+ closefile(f);
+end;
+
+function belegterSpeicher: longint;
+var f: textFile;
+ s: string;
+begin
+ s:='/proc/'+inttostr(getProcessId)+'/smaps';
+ result:=0;
+ if not fileexists(s) then exit;
+ assignfile(f,s);
+ reset(f);
+ while not eof(f) do begin
+ readln(f,s);
+ if (leftStr(s,4)='Rss:') and (rightStr(s,3)=' kB') then begin
+ delete(s,1,4);
+ delete(s,length(s)-2,3);
+ s:=trim(s);
+ result:=result+strtoint(s);
+ end;
+ end;
+ closefile(f);
+end;
+
+procedure cleanupLogs;
+var sr: tSearchRec;
+ err: longint;
+begin
+ err:=findfirst('Log*',$3f,sr);
+ while err=0 do begin
+ deletefile(sr.name);
+ err:=findnext(sr);
+ end;
+ findclose(sr);
+end;
+
+procedure cleanupLog(tid: PtrUInt);
+var s: string;
+ Zeit: extended;
+begin
+ s:='Log'+inttostr(tid);
+ Zeit:=now+1/24/60/60;
+ while (not fileexists(s)) and (Zeit>now) do
+ sleep(100);
+ if fileexists(s) then
+ deletefile(s)
+ else begin
+ gibAus('Datei '''+s+''' kann nicht gelöscht werden, da sie nicht existiert!',3);
+ raise exception.create('Datei '''+s+''' kann nicht gelöscht werden, da sie nicht existiert!');
+ end;
+end;
+
+procedure dumpExceptionCallStack(E: Exception);
+var
+ I: Integer;
+ Frames: PPointer;
+ Report: string;
+begin
+ Report := 'Program exception! ' + LineEnding +
+ 'Stacktrace:' + LineEnding + LineEnding;
+ if E <> nil then begin
+ Report := Report + 'Exception class: ' + E.ClassName + LineEnding +
+ 'Message: ' + E.Message + LineEnding;
+ end;
+ Report := Report + BackTraceStrFunc(ExceptAddr);
+ Frames := ExceptFrames;
+ for I := 0 to ExceptFrameCount - 1 do
+ Report := Report + LineEnding + BackTraceStrFunc(Frames[I]);
+ gibAus(Report,3);
+end;
+
+function startetMit(start: string; var s: string): boolean;
+begin
+ result:=leftStr(s,length(start))=start;
+ if result then
+ s:=trim(rightStr(s,length(s)-length(start)));
+end;
+
+function endetMit(ende: string; var s: string): boolean;
+begin
+ result:=rightStr(s,length(ende))=ende;
+ if result then
+ s:=trim(leftStr(s,length(s)-length(ende)));
+end;
+
+function trimAll(s: string): string;
+begin
+ result:=s;
+ while pos(' ',result)>0 do
+ delete(result,pos(' ',result),1);
+end;
+
+function erstesArgument(var s: string): string;
+begin
+ result:=erstesArgument(s,' ');
+end;
+
+function erstesArgument(var s: string; Trenner: string): string;
+begin
+ result:=copy(s,1,pos(Trenner,s+Trenner)-1);
+ delete(s,1,length(result)+length(Trenner));
+ s:=trim(s);
+ result:=trim(result);
+end;
+
+function mydatetimetostr(t: tDateTime): string;
+begin
+ result:=formatDateTime('YYYY.MM.DD_hh.mm.ss',t);
+end;
+
+function tExtPointToStr(p: tExtPoint): string;
+begin
+ result:=floattostr(p['x'])+';'+floattostr(p['y']);
+end;
+
+function tIntPointToStr(p: tIntPoint): string;
+begin
+ result:=inttostr(p['x'])+';'+inttostr(p['y']);
+end;
+
+procedure fehler(s: string);
+begin
+ gibAus(s,1);
+ raise exception.create(s);
+end;
+
begin
_cpuLastUsed:=0;
_cpuLastIdle:=0;
diff --git a/mystringlistunit.pas b/mystringlistunit.pas
index d3fe052..45963d4 100644
--- a/mystringlistunit.pas
+++ b/mystringlistunit.pas
@@ -5,7 +5,7 @@ unit mystringlistunit;
interface
uses
- Classes, SysUtils, RegExpr, Process, Math;
+ Classes, SysUtils, RegExpr, Process, Math, lowlevelunit;
type
tMyStringlist = class;
@@ -30,8 +30,13 @@ type
function readln(out s: string): boolean;
procedure grep(expr: string);
function eof: boolean;
+ procedure rewind;
+ function stillNeed(bez: string): boolean;
+ function unfoldMacros: boolean;
end;
+procedure _del(var s: string; p,c: longint); inline; // identisch zu delete(s,p,c) -- lediglich um delete innerhalb von tMyStringlist verfügbar zu haben
+
implementation
// tInputThread ****************************************************************
@@ -188,5 +193,185 @@ begin
result:=line>=count;
end;
+procedure tMyStringlist.rewind;
+begin
+ line:=0;
+end;
+
+function tMyStringlist.stillNeed(bez: string): boolean;
+var i: longint;
+ s,t: string;
+begin
+ result:=false;
+ for i:=max(0,line-1) to count-1 do begin
+ s:=' '+self[i]+' ';
+ while pos(bez,s)>0 do begin
+ t:=copy(s,1,pos(bez,s)+length(bez));
+ _del(s,1,pos(bez,s)+length(bez)-1);
+ _del(t,1,length(t)-length(bez)-2);
+ if (t[1] in [' ',#9,':','[']) and (t[length(t)] in [' ',#9,':',']']) and (copy(t,2,length(bez))=bez) then begin
+ result:=true;
+ exit;
+ end;
+ end;
+ end;
+end;
+
+function tMyStringlist.unfoldMacros: boolean;
+var i,j,k,l,Ebene: longint;
+ s,t,u,v: string;
+ SchleifenInhalt: tMyStringlist;
+ istWahr,gefunden: boolean;
+const binops: array[0..8] of string =
+ ('<=','>=','<>','≤','≥','=','≠','<','>');
+begin
+ result:=false;
+
+ i:=0;
+ while i<count do begin // Kommentare löschen
+ s:=self[i];
+ s:=erstesArgument(s,'#');
+ if length(s)=0 then begin
+ delete(i);
+ continue;
+ end;
+ self[i]:=s;
+ inc(i);
+ end;
+
+ i:=0;
+ while i<count do begin // Übersprünge überspringen, alles nach 'Dateiende' löschen
+ s:=self[i];
+ if startetMit('!überspringe:',s) then begin
+ for j:=0 to strtoint(s) do
+ delete(i);
+ continue;
+ end;
+
+ if s='Dateiende' then begin
+ inc(i);
+ while i<count do
+ delete(i);
+ continue;
+ end;
+ inc(i);
+ end;
+
+ i:=0;
+ while i<count do begin // Schleifen ausrollen
+ s:=self[i];
+ if startetMit('!Schleife:',s) then begin
+ l:=i;
+ delete(i);
+ t:=erstesArgument(s,':');
+ if (length(t)=0) or (t[1]<>'$') then exit;
+
+ SchleifenInhalt:=tMyStringlist.create; // Schleifenkörper merken
+ Ebene:=0;
+ while (i<Count) and ((Ebene<>0) or (self[i]<>'!Schleifenende')) do begin
+ SchleifenInhalt.Add(self[i]);
+ if self[i]='!Schleifenende' then dec(Ebene);
+ if pos('!Schleife:',self[i])=1 then inc(Ebene);
+ delete(i);
+ end;
+ delete(i);
+
+ while length(s)>0 do begin // Schleifenzähler laufen lassen
+ u:=erstesArgument(s);
+ for j:=0 to SchleifenInhalt.Count-1 do begin // Schleifenkörper ...
+ v:=SchleifenInhalt[j];
+ k:=length(v);
+ while (pos(t,v)>0) and (k>0) do begin // ... nach Ersetzung ...
+ v:=copy(v,1,pos(t,v)-1)+u+copy(v,pos(t,v)+length(t),length(v));
+ dec(k);
+ end;
+ insert(i,v); // ... kopieren
+ inc(i);
+ end;
+ end;
+
+ SchleifenInhalt.free;
+ i:=l;
+ continue;
+ end;
+ self[i]:=s;
+ inc(i);
+ end;
+
+ i:=0;
+ while i<count do begin // Bedingungen auswerten
+ s:=self[i];
+ if startetMit('?',s) then begin
+ t:=erstesArgument(s,':');
+ gefunden:=false;
+ for j:=0 to length(binops)-1 do
+ if pos(binops[j],t)>0 then begin
+ gefunden:=true;
+ u:=trim(copy(t,1,pos(binops[j],t)-1));
+ _del(t,1,pos(binops[j],t)+length(binops[j])-1);
+ t:=trim(t);
+ case binops[j] of
+ '≤','<=': istWahr:=strtofloat(u)<=strtofloat(t);
+ '≥','>=': istWahr:=strtofloat(u)>=strtofloat(t);
+ '=':
+ try
+ istWahr:=strtofloat(u)=strtofloat(t);
+ except
+ istWahr:=u=t;
+ end;
+ '≠','<>':
+ try
+ istWahr:=strtofloat(u)<>strtofloat(t);
+ except
+ istWahr:=u<>t;
+ end;
+ '<': istWahr:=strtofloat(u)<strtofloat(t);
+ '>': istWahr:=strtofloat(u)>strtofloat(t);
+ else begin
+ gibAus('Operator '''+binops[j]+''' ist nicht implementiert!',3);
+ exit;
+ end;
+ end{of case};
+ if not istWahr then
+ delete(i);
+ break;
+ end;
+ if not gefunden then begin
+ gibAus('Ich kann keinen gültigen Operator in Bedingung '''+t+''' finden!',3);
+ exit;
+ end;
+ if not istWahr then
+ continue;
+ self[i]:=s;
+ end;
+ inc(i);
+ end;
+
+ i:=0;
+ while i<count do begin // nochmals Übersprünge überspringen und alles nach 'Dateiende' ignorieren
+ s:=self[i];
+ if startetMit('!überspringe:',s) then begin
+ for j:=0 to strtoint(s) do
+ delete(i);
+ continue;
+ end;
+
+ if s='Dateiende' then begin
+ inc(i);
+ while i<count do
+ delete(i);
+ continue;
+ end;
+ inc(i);
+ end;
+
+ result:=true;
+end;
+
+procedure _del(var s: string; p,c: longint);
+begin
+ delete(s,p,c);
+end;
+
end.