diff options
Diffstat (limited to 'RaetselFileUnit.pas')
| -rw-r--r-- | RaetselFileUnit.pas | 274 |
1 files changed, 0 insertions, 274 deletions
diff --git a/RaetselFileUnit.pas b/RaetselFileUnit.pas deleted file mode 100644 index 1a389ab..0000000 --- a/RaetselFileUnit.pas +++ /dev/null @@ -1,274 +0,0 @@ -unit raetselFileUnit;
-
-interface
-
- uses
- dialogs, math;
-
- type
- tWort = record
- w: array of byte;
- bits: integer;
- end;
- tRaetselFile = class
- private
- f: file;
- wacc: boolean;
- inhalt,
- conv: array of byte;
- fPoint: integer;
- wB: array of tWort;
- procedure fFlush;
- procedure initWB;
- procedure concatWs(a,b: integer);
- function bIsAX(a: tWort; b: array of byte): boolean;
- procedure rConvert;
- procedure wConvert;
- public
- kennung: string;
- procedure fAssignFile(fileName: string);
- function fReset: boolean;
- procedure fRewrite;
- procedure fCloseFile;
- procedure fBlockWrite(var data; len: integer);
- function fBlockRead(var data; len: integer): boolean;
- end;
-
-implementation
-
-procedure tRaetselFile.fAssignFile(FileName: string);
-begin
- assignFile(f,fileName);
-end;
-
-function tRaetselFile.fReset: boolean;
-var
- c: cardinal;
- s: string;
-begin
- wacc:=false;
- result:=false;
- c:=0;
- reset(f,1);
- if fileSize(f) < 4 then begin
- fCloseFile;
- exit;
- end;
- blockRead(f,c,4);
- if c<>$26594131 then begin
- fCloseFile;
- exit;
- end;
- setLength(conv,fileSize(f)-4);
- blockRead(f,conv[0],length(conv));
- rConvert;
- if length(inhalt)<length(kennung) then begin
- fCloseFile;
- exit;
- end;
- s:=kennung;
- fBlockRead(s[1],length(s));
- if s<>kennung then begin
- fCloseFile;
- exit;
- end;
- result:=true;
-end;
-
-procedure tRaetselFile.initWB;
-var
- b: byte;
-begin
- setLength(wB,128);
- for b:=0 to 127 do begin
- setLength(wB[b].w,2);
- wB[b].w[0]:=b;
- wB[b].w[1]:=0;
- wB[b].bits:=7;
- end;
-end;
-
-procedure tRaetselFile.concatWs(a,b: integer);
-var
- i: integer;
-begin
- setLength(wB,length(wB)+1); // wB erweitern
- with wB[length(wB)-1] do begin
- bits:=wB[a].bits+wB[b].bits;
- setLength(w,(bits+7) div 8 + 1);
- for i:=0 to length(w)-1 do
- w[i]:=0;
- for i:=0 to length(wB[a].w)-2 do
- w[i]:=wB[a].w[i];
- for i:=0 to length(wB[b].w)-2 do begin
- w[length(wB[a].w)-2+i]:=
- w[length(wB[a].w)-2+i] or
- ($ff and (wB[b].w[i] shl (wB[a].bits mod 8)));
- if length(wB[a].w)-1+i < length(w) then
- w[length(wB[a].w)-1+i]:=
- w[length(wB[a].w)-1+i] or
- (wB[b].w[i] shr (8 - (wB[a].bits mod 8)));
- end;
- end;
-end;
-
-function tRaetselFile.bIsAX(A: tWort; b: array of byte): boolean;
-var
- i: integer;
-begin
- result:=true;
- for i:=0 to (A.bits div 8)-1 do
- result:=result and (A.w[i] = b[i]);
- result:=result and ((A.w[length(A.w)-2] and ($ff shr (8-(A.bits mod 8)))) =
- (b[length(A.w)-2] and ($ff shr (8-(A.bits mod 8)))));
-end;
-
-procedure tRaetselFile.rConvert;
-var
- rP: longint;
- wP,i: integer;
- passt,lp: integer;
- wBuff: byte;
-begin
- initWB;
- setLength(inhalt,0);
- rP:=0;
- wP:=0;
- wBuff:=0;
- lp:=-1;
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=0;
- while rP<((length(conv)-1)*8) do begin
- passt:=0;
- for i:=0 to ceil(ln(length(wB))/ln(2))-1 do begin
- passt:=passt or (byte(odd(conv[rP div 8] shr (rP mod 8))) shl i);
- inc(rP);
- end;
- for i:=0 to wB[passt].bits-1 do begin
- if wP=8 then begin
- setLength(inhalt,length(inhalt)+1);
- inhalt[length(inhalt)-1]:=wBuff;
- wP:=0;
- wBuff:=0;
- end;
- wBuff:=wBuff or (byte(odd((wB[passt].w[i div 8] shr (i mod 8)))) shl wP);
- inc(wP);
- end;
- if lp<>-1 then
- concatWs(lp,passt);
- lp:=passt;
- end;
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=wBuff;
-end;
-
-procedure tRaetselFile.wConvert;
-var
- rP: longint;
- wP,i,j: integer;
- rBuff: array of byte;
- rBBits,passt,lp: integer;
- wBuff: byte;
-begin
- initWB;
- setLength(conv,0);
- rP:=0;
- wP:=0;
- wBuff:=0;
- lp:=-1;
- setLength(inhalt,length(inhalt)+1);
- inhalt[length(inhalt)-1]:=0;
- while rP<((length(inhalt)-1)*8) do begin
- setLength(rBuff,0);
- rBBits:=0;
- passt:=-1;
- for i:=length(wB)-1 downto 0 do
- with wB[i] do begin
- if bits > (8*length(inhalt) - rP) then continue;
- if bits > rBBits then begin // mehr r-buffern
- setLength(rBuff,(bits+7) div 8);
- rBBits:=bits;
- for j:=0 to length(rBuff)-1 do begin
- rBuff[j]:=0;
- if j + rP div 8 < length(inhalt) then
- rBuff[j]:=rBuff[j] or (inhalt[j + rP div 8] shr (rP mod 8));
- if j+1 + rP div 8 < length(inhalt) then
- rBuff[j]:=rBuff[j] or ($ff and (inhalt[(rP div 8) + j+1] shl (8-(rP mod 8))));
- end;
- end;
- if ((passt=-1) or (wB[passt].bits < wB[i].bits)) and
- bIsAX(wB[i],rBuff) then
- passt:=i;
- end;
- if passt=-1 then begin // geht ja gar nicht - geht ja wohl!
- messageDlg('Zu wenig wörter im wörterbuch!',mterror,[mbOk],0);
- exit;
- end;
- rP:=rP+wB[passt].bits;
- for i:=0 to ceil(ln(length(wB))/ln(2))-1 do begin // wB-index speichern
- if wP=8 then begin // w-buffer leeren
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=wBuff;
- wP:=0;
- wBuff:=0;
- end;
- wBuff:=wBuff or byte(odd(passt shr i)) shl wP;
- inc(wP);
- end;
- if lp<>-1 then
- concatWs(lp,passt);
- lp:=passt;
- end;
- setLength(conv,length(conv)+1);
- conv[length(conv)-1]:=wBuff;
-end;
-
-procedure tRaetselFile.fFlush;
-begin
- wConvert;
- blockWrite(f,conv[0],length(conv));
- setLength(inhalt,0);
-end;
-
-procedure tRaetselFile.fRewrite;
-var
- c: cardinal;
-begin
- wacc:=true;
- rewrite(f,1);
- c:=$26594131;
- blockWrite(f,c,4);
- setLength(inhalt,length(kennung));
- move(kennung[1],inhalt[0],length(kennung));
- fPoint:=length(inhalt);
-end;
-
-procedure tRaetselFile.fCloseFile;
-begin
- if wacc then begin
- fFlush;
- closeFile(f);
- end;
- setLength(inhalt,0);
- fPoint:=0;
-end;
-
-procedure tRaetselFile.fBlockWrite(var data; len: integer);
-begin
- setLength(inhalt,length(inhalt)+len);
- move(data,inhalt[fPoint],len);
- fPoint:=length(inhalt);
-end;
-
-function tRaetselFile.fBlockRead(var data; len: integer): boolean;
-begin
- result:=len<=(length(inhalt)-fPoint);
- if not result then begin
- fCloseFile;
- exit;
- end;
- move(inhalt[fPoint],data,len);
- fPoint:=fPoint+len;
-end;
-
-end.
|