Reading variables from array of byte when positioned with arbitrary bit length

Question

In Delphi XE3 I am trying to decode some data being read from a UDP-socket. Apparently the data encoded like this (chronological order as listed):

NAME                    BITS    TYPE
RECURRENCE INDICATOR    1       BOOLEAN
TRANSMITTER CODE        24      STRING
LATITUDE                25      INTEGER
LONGITUDE               26      INTEGER
DERIVATION              4       INTEGER
//I am not able to reach the documentation from work but the lat and long
//translates with a constant of 0.00000536441, so you take the binary (2 based)
//number, convert to decimal (10 based) and multiply with the constant for the 
//float value of the coordinates.

Per now, my code looks like this (yes- this is early stage test and manual calculations):

procedure TForm1.UDPUDPRead(AThread: TIdUDPListenerThread; AData: array of Byte; 
                            ABinding: TIdSocketHandle);
var
  s: string;
  recInd: Boolean;
  trCode: String;
  lat, long, deri: Integer;
begin
Label1.Caption := IntToStr(Length(AData)) + ' bytes received @ ' + 
                  TimeToStr(Time);
s := BytesToHex(AData);
If CheckBox2.Checked Then Memo1.Lines.Clear;
Memo1.Lines.Add(s);
end;

The questions is how can I set the variables recInd, trCode, lat, long and deri from that array of bytes?
Desired function would be someting like:

function SubBin(AData: array of byte; start, length: integer):array of byte
//Used like this:
recInd := SubBin(AData, 0, 1);
trCode := SubBin(AData, 1, 24);
lat := SubBin(AData, 25, 25);
long := SubBin(AData, 50, 26);
deri := SubBin(AData, 76, 4);

Wow someone did you a favour with those lengths. You sure about them as this is going to be messy — Tony Hopkinson
– Tony Hopkinson, Commented Sep 22, 2013 at 23:39
@Tony The little documentation I have and my manual calculations prove the bit placement and lengths to be correct. But I am not quite able to figure it out programmatically... — wittrup
– wittrup, Commented Sep 22, 2013 at 23:48
So, the BOOLEAN type in your description is 1 byte, INTEGER 4 bytes and that STRING the rest of the packet length (assuming 1 byte per char) ? — TLama
– TLama, Commented Sep 22, 2013 at 23:49
@TLama basically. I get an array of byte with 10 bytes (80 bits). The first bit is a boolean recurrence indicator. The next 24 bits are the transmitter code. The next 25 bits Latitude. The next 26 bits longitude. The next 4 bits a derivation integer. — wittrup
– wittrup, Commented Sep 22, 2013 at 23:51
@wittrup To extract particular fields, you primary need to know endianess and bit order, secondary char encoding, negative number encoding etc... — pf1957
– pf1957, Commented Sep 23, 2013 at 6:39

pf1957 · Accepted Answer · 2013-09-23 11:44:58Z

3

Assuming bit order MSB first, you can try something like this (not debugged, not optimized, just as an idea):

function ExtractBitArray(AData:TBytes; AFrom,ALength:Integer): TBytes;
var
  ByteIdxFrom: integer;
  i: integer;
  BitEndOfs: integer;
  Mask: byte;

  procedure ___ShiftBytesRight(var ABuf:TBytes);
  var
    CFhi,CFlo: Byte;
    B: byte;
    i: integer;
  begin
    CFHi := 0;
    for i := low(ABuf) to high(ABuf) do
      begin
        B := ABuf[i];
        CFlo := B;
        B := (B shr 1) or CFhi;
        ABuf[i] := B;
        CFhi := CFlo shl 7 and $80;
      end;
  end;

begin
  ByteIdxFrom := AFrom div 8;
  BitEndOfs := (AFrom + ALength) mod 8;
  //
  SetLength(Result,ALength div 8 + 1);
  for i := Low(Result) to High(Result) do
    Result[i] := AData[ByteIdxFrom + i];
  //
  if BitEndOfs>0 then
    for I := BitEndOfs to 7 do
      ___ShiftBytesRight(Result);
  //
  Mask := $FF;
  for i := ALength mod 8 to 7 do
    Mask := Mask shr 1;
  Result[0] := Result[0] and Mask;
end;

answered Sep 23, 2013 at 11:44

pf1957

1,0071 gold badge6 silver badges20 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Tony Hopkinson Over a year ago

Only thing I'd add is I'd consider writing a class that to care of translating this weirdly compacted structure into something more palatable and hide all this stuff in it, hopefully never to be seen again.

pf1957 Over a year ago

Definitely. In our framework I'd create TAbstractBitStream and its descendants TLsbFirstBitStream / TMsbFirstBitStream with related methods and put local function ___ShiftBytesRight among generic utility functions and on the application level a I'd create a class representing packets.

wittrup · Accepted Answer · 2013-11-30 11:05:53Z

I finally came up with something in general looking like this:

procedure decode(adata: array of bytes; var results: Tcustom_record);
var
   bstream: TBitStream;
   buffer: Tbytes;
   ALen: integer;
begin
  ALen := Length(AData);
  SetLength(buffer, ALen);
  if ALen <> 0 then begin
    Move(AData[0], buffer[0], ALen);
  end;
  bstream:=TBitStream.Create;
  bstream.Load(buffer, sizeof(buffer) );
  results.RECURRENCE_INDICATOR  :=bstream.readBit;
  results.TRANSMITTER_CODE      :=bstream.readCardinal(24);
  results.LATITUDE              :=bstream.readCardinal(25);
  results.LONGITUDE             :=bstream.readCardinal(26);
  results.DERIVATION            :=bstream.readCardinal(4);

after digging down in the code i found i realized that TBitStream has to be defined:

unit ubitstream;



interface

uses classes,sysutils;

Type

TBitStream = class

   constructor Create;
   destructor Free;

public
   procedure clear;
   procedure Load(fileName: string); overload;
   procedure Load(bs:TBitStream; offset: cardinal; count:cardinal); overload;
   procedure Load(bs:TBitStream; count:cardinal); overload;
   procedure Load(byteArray: TBytes); overload;
   procedure Load(byteArray: TBytes; offset:cardinal); overload;
   procedure Save(fileName: string); overload;
   procedure Save(var byteArray: TBytes); overload;

   function toHex:String;
   function toBin:String;


   //Sequental Access
   function readCardinal(count: integer):cardinal;
   function readBit:byte;
   function readString(count:cardinal):ansistring;

   procedure writeBit(bit: byte);
   procedure writeBits(count: cardinal; data: TBytes); overload;
   procedure writeBits(count: cardinal; pdata: Pbyte); overload;
   procedure writeString(s: ansistring);
   //----------------------------------------------------
   function getSize:smallint;
   procedure setSize(newSize: smallint);
   property Size: smallint read getSize write setSize;
   function getPos: cardinal;
   procedure setPos(newPosition: cardinal);
   property Position: cardinal read getPos write setPos;
   function eos:boolean;//End Of Stream

protected
   //Random Access
   function getCardinal(offset: cardinal; count: cardinal):cardinal;
   function getBit(offset: cardinal):byte;
   function getString(offset: cardinal; count:cardinal; var readCount: cardinal):ansistring;

   procedure setBit(offset: cardinal; bit: byte);
   procedure setBits(offset: cardinal; count: cardinal; data: TBytes);
   //----------------------------------------------------

private
   bits: Array of byte;
   stream_pos: cardinal; //postinion for sequental operations bits-based
end;


implementation


constructor TBitStream.Create;
begin
   SetLength(bits,1); //initial size is 1b
   stream_pos := 0;
end;

destructor TBitStream.Free;
begin
   SetLength(bits,0); //free array
end;

procedure TBitStream.clear;
// clear data
begin
   SetLength(bits,1);
   bits[0] := 0;
   stream_pos := 0;
end;

function TBitStream.getSize:smallint;
begin
   getSize := High(bits) + 1; //index is zero-based
end;

procedure TBitStream.setSize(newSize: smallint);
begin
   SetLength(bits,newSize);
   if stream_pos>newSize-1 then stream_pos:=High(bits)+1;
end;

function TBitStream.getCardinal(offset: cardinal; count: cardinal):cardinal;
//return count of bits from ofsset as 32-bit data type
//offset and count size in bits   
var 
   res: cardinal;
   i,shift: cardinal;
begin
   getCardinal:=0;
   if (offset+count>Size*8) then raise Exception.Create('Index out of array bounds!');
   if count>32 then exit; //no more than 32-bit
   res := getBit(offset);
//   writeln(offset,' ',getBit(offset),' ',res);
   shift := 1;
   for i:=offset+1 to offset+count-1 do begin
      res := res or (getBit(i) shl shift);
      inc(shift);
//      writeln(i,' ',getBit(i),' ',res);
   end;
   getCardinal := res;
end;

procedure TBitStream.setBit(offset: cardinal; bit: byte);
//offset in bits
var 
   b: byte;
   off1: cardinal;
   pos1: byte;
begin
   if (offset>=Size*8) then SetLength(bits,(offset div 8)+1);
   off1 := offset div 8;
   pos1 := offset mod 8;
   b := bits[off1];
   if bit=0 then begin //drop bit
      b := b and (not (1 shl pos1));
   end else begin //set bit
      b := b or (1 shl pos1);
   end;
   bits[off1] := b;
end;

procedure TBitStream.setBits(offset: cardinal; count: cardinal; data: TBytes);
//set count of bits at ofsset from bytes array
//offset and count size in bits   
var 
   i,j: cardinal;
   b,bit: byte;
   byteCount: cardinal;
   off: cardinal;
Label STOP;   
begin
   if (offset+count>=Size*8) then SetLength(bits,((offset+count) div 8)+1); //Reallocate bits array
   byteCount := count div 8;
   off := offset;
   if (count mod 8)>0 then inc(byteCount);
   for i:=0 to byteCount-1 do begin //dynamic arrays is zero-based
      b  := data[i]; 
      for j:=0 to 7 do begin //all bits in byte
         bit := (b and (1 shl j)) shr j; 
         setBit(off,bit);
         inc(off);
         if (off>offset+count) then goto STOP;
      end;
   end;
STOP:
end;

function TBitStream.getBit(offset: cardinal):byte;
//offset in bits
var 
   b: byte;
   off1: cardinal;
   pos1: byte;
begin
   getBit := 0;
   if (offset>Size*8) then raise Exception.Create('Index out of array bounds!');
   off1 := offset div 8;
   pos1 := offset mod 8;
//   if (offset mod 8)>0 then inc(off1);
   b := bits[off1];
   b := (b and (1 shl pos1)) shr pos1;//get bit
   getBit := b;
end;

function TBitStream.getString(offset: cardinal; count:cardinal; var readCount: cardinal):ansistring;
//count, odffset in bits
var
   s: ansistring;
   len,i: cardinal;
   b: byte;
   off: cardinal;
begin
   getString:='';
   s := '';
   readCount := 0;
   off := offset;
   if (count mod 7)<>0 then exit; //string must contain 7-bits chars....
   len := count div 7;
   for i:=1 to len do begin 
      if (offset>Size*8) then raise Exception.Create('Index out of array bounds!');
      b := getCardinal(off,7); 
      inc(off,7);
      inc(readCount,7);
      if b=$7F then break; //this is EOL code
      s := s + ansichar(b);
   end;
   getString := s;
end;

function TBitStream.toHex:String;
var 
   i:integer;
   s,res:string;
begin
   res:='';
   for i:=Low(bits) to High(bits) do begin
      s := Format('%02.2X ',[bits[i]]);
      res := res + s;
   end;
   toHex := res;
end;

function TBitStream.toBin:String;
var 
   i,j:integer;
   s,res:string;
   b: byte;
begin
   res:='';
   for i:=Low(bits) to High(bits) do begin
      //s := Format('%02.2X',[bits[i]]);
      b := bits[i];
      s:='';
      for j:=7 downto 0 do begin
         if (b and (1 shl j))>0 then s:=s+'1' else s:=s+'0';
      end;
      s := s+' ';
      res := res + s;
   end;
   toBin := res;
end;

procedure TBitStream.Load(fileName: string);
//load data from binary file
var 
   f: file of byte;
   i: cardinal;
   b: byte;
begin
   clear;
   i:=0;
   assign(f,fileName);
   reset(f);
   while not eof(f) do begin
      blockread(f,b,1);
      SetLength(bits,i+1);
      bits[i] := b;
      inc(i);
   end;
   close(f);
end;

procedure TBitStream.Save(fileName: string);
//save data to binary file
var
   i:cardinal;
   f: file of byte;
   b: byte;
begin
   assign(f,fileName);
   rewrite(f);
   for i:=Low(bits) to High(bits) do begin
      b := bits[i];
      blockwrite(f,b,1);
   end;
   close(f);
end;

procedure TBitStream.Save(var byteArray: TBytes);
//save data to array of bytes
var 
   i: cardinal;
begin
   SetLength(byteArray,Size);
   for i:=0 to Size-1 do begin
      byteArray[i] := bits[i];
   end;
end;


procedure TBitStream.Load(bs:TBitStream; offset: cardinal; count: cardinal);
//load data from other stream
//offset/count in bits
var
   i,len,off: cardinal;
   b: byte;
begin
   clear;
   off := offset;
   len := count div 8;
   setLength(bits, len);
   for i:=0 to len-1 do begin
      b:=bs.getCardinal(off,8);
      if (i>Size) then SetLength(bits,i+1);
      bits[i] := b;   
      inc(off,8);
   end;
end;

procedure TBitStream.Load(bs:TBitStream; count: cardinal);
//load data from other stream
//count in bits
begin
   Load(bs, bs.Position, count);
   bs.Position:=bs.Position+count;
end;

procedure TBitStream.Load(byteArray: TBytes);
//load data from array of bytes
var
   i,len: cardinal;
begin
   clear;
   len := High(byteArray)+1;
   setLength(bits, len);
   for i:=0 to len-1 do begin
      bits[i] := byteArray[i];
   end;
end;

procedure TBitStream.Load(byteArray: TBytes; offset:cardinal);
//offset in bytes
var
   i,len: cardinal;
begin
   clear;
   len := High(byteArray)+1;
   if offset>len then exit;
   setLength(bits, len-offset);
   for i:=offset to len-1 do begin
      bits[i-offset] := byteArray[i];
   end;
end;

function TBitStream.getPos: cardinal;
begin
   getPos := stream_pos;
end;

procedure TBitStream.setPos(newPosition: cardinal);
begin
   stream_pos := newPosition;
end;

function TBitStream.readCardinal(count: integer):cardinal;
begin
   readCardinal := getCardinal(stream_pos, count);
   inc(stream_pos,count);
end;

function TBitStream.readBit:byte;
begin
   readBit := getBit(stream_pos);
   inc(stream_pos);
end;

function TBitStream.readString(count:cardinal):ansistring;
//count in bits
var readCount: cardinal;
begin
   readString := getString(stream_pos,count,readCount);
   inc(stream_pos,readCount);
end;

procedure TBitStream.writeBit(bit: byte);
begin
   setBit(stream_pos,bit);
   inc(stream_pos);
end;

procedure TBitStream.writeBits(count: cardinal; data: TBytes);
begin
   setBits(stream_pos,count,data);
   inc(stream_pos,count);
end;

procedure TBitStream.writeBits(count: cardinal; pdata: pbyte); 
var
   i:cardinal;
   len:cardinal;
   bytes: TBytes;
begin
   len:=count div 8;
   if (count mod 8)>0 then inc(len);
   setLength(bytes,len);
   for i:=0 to len-1 do begin
      bytes[i]:=pdata^;
      inc(pdata);
   end;
   writeBits(count,bytes);
end;

function TBitStream.eos:boolean;
begin
   eos := stream_pos=High(bits)+1;
end;

procedure TBitStream.writeString(s: ansistring);
var 
   i:cardinal;
   c: byte;
   eos:byte;
begin
   for i:=1 to length(s) do begin
      c:=byte(s[i]);
      setBits(stream_pos,7,TBytes(@c));
      inc(stream_pos,7);
   end;
   eos:=$7f;
   setBits(stream_pos,7,TBytes(@eos));
   inc(stream_pos,7);
end;

end.

Collectives™ on Stack Overflow

Reading variables from array of byte when positioned with arbitrary bit length

2 Answers 2

2 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related