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

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);

Answer 1

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;

Answer 2

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.