Thema: Delphi Bitweiser Zugriff auf Daten

Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.147 Beiträge
 
Delphi 12 Athens
 
#8

Re: Bitweiser Zugriff auf Daten

  Alt 13. Okt 2009, 12:34
falls ich jetzt keinen Fehler gemacht hab ...

hätte ja liebendgern die TBits-Klasse von Delphi erweitert, aber die ist einfach so besch*** definiert, daß sie sich absolut nicht erweitern läßt, da man keinen Zugriff auf wichtige Felder bekommt

man kann via SetData externen Speicher auslesen/bearbeiten
oder internen Speicher verwalten lassen.
zusammenfalten · markieren
Delphi-Quellcode:
Type
  TByteArray = Array[0..0] of Byte;
  PByteArray = ^TByteArray;
  TBits = Class
  Protected
    _Data: PByteArray;
    _Size, _Pos: Integer;
    _Extern: Boolean;
    Procedure SetSize ( Value: Integer);
    Procedure SetBSize( Value: Integer); //Inline;
    Function GetBSize: Integer; //Inline;
    Procedure SetPos ( Value: Integer); //Inline;
    Procedure SetBPos ( Value: Integer); //Inline;
    Procedure SetABit ( Value: Boolean); //Inline;
    Function GetABit: Boolean; //Inline;
    Procedure SetABits( Length: Integer; Value: LongWord); //Inline;
    Function GetABits( Length: Integer): LongWord; //Inline;
    Procedure SetBit (Index: Integer; Value: Boolean); //Inline;
    Function GetBit (Index: Integer): Boolean; //Inline;
    Procedure SetBits (Index: Integer; Length: Integer; Value: LongWord); //Inline;
    Function GetBits (Index: Integer; Length: Integer): LongWord; //Inline;
    Procedure SetMask (Index: Integer; Mask: LongWord; Value: LongWord);
    Function GetMask (Index: Integer; Mask: LongWord): LongWord;
  Public
    Destructor Destroy; Override;
    Procedure SetData(Data: Pointer = nil; SizeInByte: Integer = -1);
    Procedure Clear;
    Function OpenBit: Integer;
    Function CloseBit: Integer;
    Property Size: Integer Read _Size Write SetSize;
    Property ByteSize: Integer Read GetBSize Write SetBSize;
    Property Position: Integer Read _Pos Write SetPos;
    Property BytePos: Integer Write SetBPos;
    Property aBit: Boolean Read GetABit Write SetABit;
    Property aBits[ Length: Integer]: LongWord Read GetABits Write SetABits;
    Property Bit [Index: Integer]: Boolean Read GetBit Write SetBit; Default;
    Property Bits [Index: Integer; Length: Integer]: LongWord Read GetBits Write SetBits;
    Property Mask [Index: Integer; Mask: LongWord]: LongWord Read GetMask Write SetMask;
    Procedure WriteBlock(Index, Length: Integer; Data: Pointer);
    Procedure ReadBlock (Index, Length: Integer; Data: Pointer);
  End;

Procedure TBits.SetSize(Value: Integer);
  Begin
    If _Extern Then System.Error(reInvalidOp);
    ReallocMem(_Data, (Value + 7) div 8);
    If Value > _Size Then Begin
      If _Size mod 8 > 0 Then
        _Data[_Size div 8] := _Data[_Size div 8] and ($FF shr (8 - _Size mod 8));
      ZeroMemory(@_Data[(_Size + 7) div 8], ((Value + 7) div 8) - ((_Size + 7) div 8));
    End;
    _Size := Value;
  End;

Procedure TBits.SetBSize(Value: Integer);
  Begin
    SetSize(Value * 8);
  End;

Function TBits.GetBSize: Integer;
  Begin
    Result := (_Size + 7) div 8;
  End;

Procedure TBits.SetPos(Value: Integer);
  Begin
    _Pos := Value;
  End;

Procedure TBits.SetBPos(Value: Integer);
  Begin
    SetPos(Value * 8);
  End;

Procedure TBits.SetABit(Value: Boolean);
  Begin
    SetBit(_Pos, Value);
  End;

Function TBits.GetABit: Boolean;
  Begin
    Result := GetBit(_Pos);
  End;

Procedure TBits.SetABits(Length: Integer; Value: LongWord);
  Begin
    SetBits(_Pos, Length, Value);
  End;

Function TBits.GetABits(Length: Integer): LongWord;
  Begin
    Result := GetBits(_Pos, Length);
  End;

Procedure TBits.SetBit(Index: Integer; Value: Boolean);
  Const X: Array[Boolean] of LongWord = ($0, $1);

  Begin
    SetBits(Index, 1, X[Value]);
  End;

Function TBits.GetBit(Index: Integer): Boolean;
  Begin
    Result := GetBits(Index, 1) <> 0;
  End;

Procedure TBits.SetBits(Index: Integer; Length: Integer; Value: LongWord);
  Begin
    If Length = 0 Then Exit; // to prevent the mistake by "shr 32"
    SetMask(Index, $FFFFFFFF shr (32 - Length), Value);
  End;

Function TBits.GetBits(Index: Integer; Length: Integer): LongWord;
  Begin
    If Length = 0 Then Begin
      // to prevent the mistake by "shr 32"
      Result := 0;
      Exit;
    End;
    Result := GetMask(Index, $FFFFFFFF shr (32 - Length));
  End;

Procedure TBits.SetMask(Index: Integer; Mask: LongWord; Value: LongWord);
  Var i, i2: Integer;

  Begin
    _Pos := Index;
    i := Mask;
    While (i <> 0) do Begin
      Inc(_Pos);
      i := i shr 1;
    End;
    If (Index < 0) or (_Pos > _Size) Then System.Error(reRangeError);

    i2 := Index mod 8;
    If i2 <> 0 Then Begin
      i := 8 - i2;
      _Data[Index div 8] := (_Data[Index div 8] and not (Mask shl i2))
        or ((Value and Mask) shl i2);
      Inc(Index, i);
      Mask := Mask shr i;
      Value := Value shr i;
    End;
    While Mask <> 0 do Begin
      _Data[Index div 8] := (_Data[Index div 8] and not Mask)
        or (Value and Mask);
      Inc(Index, 8);
      Mask := Mask shr 8;
      Value := Value shr 8;
    End;
  End;

Function TBits.GetMask(Index: Integer; Mask: LongWord): LongWord;
  Var i, i2: Integer;

  Begin
    _Pos := Index;
    i := Mask;
    While (i <> 0) do Begin
      Inc(_Pos);
      i := i shr 1;
    End;
    If (Index < 0) or (_Pos > _Size) Then System.Error(reRangeError);

    i2 := Index mod 8;
    If i2 <> 0 Then Begin
      i := 8 - (i2);
      Result := (_Data[Index div 8] shr i2) and Mask;
      Inc(Index, i);
      Mask := Mask shr i;
    End Else Begin
      i := 0;
      Result := 0;
    End;
    While Mask <> 0 do Begin
      Result := Result or ((_Data[Index div 8] and Mask) shl i);
      Inc(i, 8);
      Inc(Index, 8);
      Mask := Mask shr 8;
    End;
  End;

Destructor TBits.Destroy;
  Begin
    SetData(nil, -1);
  End;

Procedure TBits.SetData(Data: Pointer = nil; SizeInByte: Integer = -1);
  Begin
    If not _Extern Then FreeMem(_Data);
    If SizeInByte >= 0 Then Begin
      _Data := Data;
      _Size := SizeInByte * 8;
    End Else Begin
      _Data := nil;
      _Size := 0;
    End;
    _Extern := SizeInByte >= 0;
    _Pos := 0;
  End;

Procedure TBits.Clear;
  Begin
    ZeroMemory(_Data, (_Size + 7) div 8);
  End;

Function TBits.OpenBit: Integer;
  Var i: Integer;

  Begin
    For i := 0 to _Size - 1 do
      If GetBit(i) Then Begin
        Result := i;
        Exit;
      End;
    Result := -1;
  End;

Function TBits.CloseBit: Integer;
  Var i: Integer;

  Begin
    For i := _Size - 1 downto 0 do
      If GetBit(i) Then Begin
        Result := i;
        Exit;
      End;
    Result := -1;
  End;

Procedure TBits.WriteBlock(Index, Length: Integer; Data: Pointer);
  Begin
    While Length >= 8 do Begin
      SetBits(Index, 8, PByte(Data)^);
      Dec(Length, 8);
      Inc(Index, 8);
      Inc(Integer(Data));
    End;
    If Length > 0 Then
      SetBits(Index, Length, PByte(Data)^);
  End;

Procedure TBits.ReadBlock(Index, Length: Integer; Data: Pointer);
  Begin
    While Length >= 8 do Begin
      PByte(Data)^ := GetBits(Index, 8);
      Dec(Length, 8);
      Inc(Index, 8);
      Inc(Integer(Data));
    End;
    If Length > 0 Then
      PByte(Data)^ := GetBits(Index, Length);
  End;
'n kleiner Test
zusammenfalten · markieren
Delphi-Quellcode:
Procedure TForm1.FormCreate(Sender: TObject);
  Const NUM: Array[Boolean] of Char = ('0', '1');

  Var b: TBits;
    x, i: Integer;
    s: String;

  Begin
    x := $12345678;
    b := TBits.Create;
    b.SetData(@x, 4);
    Edit1.Clear;
    For i := 0 to 31 do
      Edit1.Text := NUM[b.aBit] + Edit1.Text;
    b.Free;

    b := TBits.Create;
    b.ByteSize := 4;
    s := '00010010001101000101011001111000';
    For i := 32 downto 1 do
      b.aBit := s[i] <> '0';
    b.ReadBlock(0, 32, @x);
    Edit1.Text := Edit1.Text + ' $' + IntToHex(x, 8);
    b.Free;
  End;
und raus kommt dabei dieses ... 's scheint also zu funktionieren
markieren
Code:
00010010001101000101011001111000   $12345678
nja, intern ist eigentlich fast nix optimiert, aber was soll's ... so isses hoffentlich noch etwas übersichtlich


das Wichtigste der Schnittstellen nochma im Überblick
zusammenfalten · markieren
Delphi-Quellcode:
TBits = Class
  Procedure SetData(Data: Pointer = nil; SizeInByte: Integer = -1);

  Procedure Clear; // set all bits to 0
  Function OpenBit: Integer;
  Function CloseBit: Integer;

  Property Size: Integer;
  Property ByteSize: Integer;
  Property Position: Integer
  Property BytePos: Integer; // write only

  Property aBit: Boolean;
  Property aBits[Length: Integer]: LongWord;

  Property Bit [Index: Integer]: Boolean; Default;
  Property Bits [Index: Integer; Length: Integer]: LongWord;
  Property Mask [Index: Integer; Mask: LongWord]: LongWord;

  Procedure WriteBlock(Index, Length: Integer; Data: Pointer);
  Procedure ReadBlock (Index, Length: Integer; Data: Pointer);
End;
[edit]
ich dachte schon meine Klasse ließt falsch, als ich ihr grad dein Beispiel beibrachte
zusammenfalten · markieren
Delphi-Quellcode:
var
  bits: TBits;

// Byte 4 | Byte 3 | Byte 2 | Byte 1
// 1010 1010 | 1010 1010 | 1010 1010 | 1010 1010
const
  data: AnsiString = #170#170#170#170;

begin
  bits := TBits.Create;
  bits.SetData(@data[1], 4);
  try
    WriteLn(bits.aBits[4]); // 1010 = 10
    WriteLn(bits.aBits[1]); // 0 = 0
    WriteLn(bits.aBits[1]); // 1 = 1
    WriteLn(bits.aBits[3]); // 010 = 2
    WriteLn(bits.aBits[1]); // 1 = 1
    WriteLn(bits.aBits[2]); // 10 = 2
    WriteLn(bits.aBits[3]); // 010 = 2
    WriteLn(bits.aBits[2]); // 01 = 1
    WriteLn(bits.aBits[6]); // 0101 01 = 21
    WriteLn(bits.aBits[8]); // 0101 0101 = 85
    WriteLn(bits.aBits[1]); // 1 = 1
  finally
    bits.Free;
  end;
  ReadLn;
end.
aber nein, ich schieb jetzt einfach mal die Schuld auf dich

vergiß bitte nicht, daß du die Bits vom LSB aus nach oben auslesen solltest
du machst es aber genau andersrum
- innherhalb der gelesenen Bits stimmt zwar die Reihenvolge, aber insgesammt stimmt dieses leider nicht ... siehe die Ergebnisse im obrigen Code.

> also Bytes andersrum anordnen und dann von rechts nach links lesen.

und du hattest auch ein Bit vergessen

markieren
Code:
>> wenn man es so betrachtet, dann könnte man denken es stimmt

Byte 1    | Byte 2    | Byte 3    | Byte 4
1010 1010 | 1010 1010 | 1010 1010 | 1010 1010
4444
     1
      1
       33 | 3
             1
              22
                 333
                    2 | 2
                         666 666
                                8 | 8888 888
                                            *

>> aber in der "richtigeren" Reihenfolge .... nja, ich glaub so fällt es auf

Byte 4    | Byte 3    | Byte 2    | Byte 1
1010 1010 | 1010 1010 | 1010 1010 | 1010 1010
                                    4444
                                         1
                                          1
                        3         |        33
                         1
                          22
                             333
            2         |         2
             666 666
8888 888  |         8
        *

>> und so würden die meißten das Ergebnis aber erwarten ;)

Byte 4    | Byte 3    | Byte 2    | Byte 1
1010 1010 | 1010 1010 | 1010 1010 | 1010 1010
                                         4444
                                       1
                                      1
                                3 | 33
                               1
                             22
                         333
                    2 | 2
             666 666
 888 8888 | 8
1
laß deinen Code einfach mal auf einen Integer los, dann sollte dieses Problem auch auffallen
und dort kannst'e dir z.B. vom IntToBin oder dem Windows-Taschenrechner eine Verleichsbitfolge erstellen lassen.

PS: das AnsiString hat nicht viel zu sagen, daß daß ab Delphi2009 deine Bits nicht mehr wie erwartet wären ... Unicode halt
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat