diff options
Diffstat (limited to 'RaetselFileUnit.pas')
| -rw-r--r-- | RaetselFileUnit.pas | 291 |
1 files changed, 291 insertions, 0 deletions
diff --git a/RaetselFileUnit.pas b/RaetselFileUnit.pas new file mode 100644 index 0000000..8d88ef6 --- /dev/null +++ b/RaetselFileUnit.pas @@ -0,0 +1,291 @@ +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;
+ 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; *)
+ Setlength(WB,2);
+ setlength(WB[0].W,2);
+ WB[0].W[0]:=$0;
+ WB[0].W[1]:=0;
+ WB[0].Bits:=1;
+ setlength(WB[1].W,2);
+ WB[1].W[0]:=$1;
+ WB[1].W[1]:=0;
+ WB[1].Bits:=1;
+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 // geht ja gar nicht ...
+ begin // ... 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.
|