Binärdatei schreiben und lesen?

[sx2008]

Wenn du ausschlieslich ein Array von Bits speichern möchtst dann könntest du meine TBitStream -Klasse benützen.
Z.Zt. fehlt noch das Laden der Bits aber das liese sich nachrüsten falls du Interesse hast.
Man kann die Bits nur seriell schreiben oder lesen; für wahlfreien Zugriff könnte man die Klasse TBits aus der VCL verwenden.

Delphi-Quellcode:

unit BitString;

interface

uses Classes;

type

  // verwaltet einen String der eine Liste von Bits repräsentiert
  TBitString = class(TObject)
    FData : AnsiString;
    FDataIdx : Integer;
    FDataBitpos: Integer;
    function GetCount:Integer;
  public
    function GetDataBit(var bit:Boolean):Boolean;
    procedure PutDataBit(bit:Boolean);
    procedure Reset;
    procedure SaveToStream(stream:TStream);
    procedure SaveToFile(const filename:string);

    property Data : AnsiString read FData write FData;
    property Count:Integer read GetCount;
  end;

implementation

{ TBitString }

function TBitString.GetCount: Integer;
begin
   Result := FDataIdx * 8 + FDataBitpos;
end;

function TBitString.GetDataBit(var bit: Boolean): Boolean;
begin
   bit := (ord(FData[FDataIdx]) and (1 shl FDataBitpos)) <> 0;

   Inc(FDataBitpos);
   if FDataBitpos >= 8 then
   begin
      FDataBitpos := 0;
      Inc(FDataIdx);
      Result := FDataIdx <= Length(FData);
   end
   else
      Result := True;
end;

procedure TBitString.PutDataBit(bit: Boolean);
begin
   if (FDataIdx = 1) and (FData = '') then
      FData := #0;

   if bit then
      FData[FDataIdx] := char(ord(FData[FDataIdx]) or (1 shl FDataBitpos))
   else
      FData[FDataIdx] := char(Ord(FData[FDataIdx]) and not (1 shl FDataBitpos));


   Inc(FDataBitpos);
   if FDataBitpos >= 8 then
   begin
      FDataBitpos := 0;
      Inc(FDataIdx);
      FData := FData + chr(0);
   end
end;

procedure TBitString.Reset;
begin
   FDataIdx := 1;
   FDataBitpos := 0;
   FData := '';
end;

procedure TBitString.SaveToStream(stream: TStream);
begin
   stream.WriteBuffer(Self.Data[1], Length(Data));
end;


procedure TBitString.SaveToFile(const filename: string);
var
  fs : TFileStream;
begin
   fs := TFileStream.Create(filename, fmCreate);
   try
      SaveToStream(fs);
   finally
      fs.Free;
   end;
end;


end.