在Delphi中处理任意位长度的数据?

在Delphi中处理任意位长度的数据?,delphi,bit-manipulation,Delphi,Bit Manipulation,我正在开发一个显示/控制实用程序,以取代一个古老的工业机械专用硬件控制器。控制器本身无法维修(有人将1安培保险丝更换为13安培保险丝,“因为它一直在熔断”)。硬件接口通过标准RS232端口。数据格式专用于: 没有控制字符与ETB(Chr 23)的EXECTION一起用于标记消息的结尾 数据为7位,但仅使用可能的7位字符的子集。因此,每个7位数据字符的内容有效地减少到只有6位数据 数据未按字符对齐,例如,对于第一种消息类型,前3位为消息类型,后8位为计数器,后15位为数据值,后7位为值等 因此,将

我正在开发一个显示/控制实用程序,以取代一个古老的工业机械专用硬件控制器。控制器本身无法维修(有人将1安培保险丝更换为13安培保险丝,“因为它一直在熔断”)。硬件接口通过标准RS232端口。数据格式专用于:

没有控制字符与ETB(Chr 23)的EXECTION一起用于标记消息的结尾

数据为7位,但仅使用可能的7位字符的子集。因此,每个7位数据字符的内容有效地减少到只有6位数据

数据未按字符对齐,例如,对于第一种消息类型,前3位为消息类型,后8位为计数器,后15位为数据值,后7位为值等

因此,将数据从7位载体缩减为6位内容(例如)

特定的消息是固定长度的,但不同的消息具有不同的长度,并且包含不同数量的参数

我有一个处理一种特定消息类型的工作原型,但它目前使用的case语句太多;-)


我正在寻找一种干净的方法来处理这种压缩的任意位长度数据的建议?

一种可能的处理方法,虽然在内存使用方面非常低效,但就是在读取数据时分解位。因此,假设您从端口以8位(1字节)块的形式读取数据。您的第一次阅读将带来
00100101
。将其分解为8个整数的数组(例如,
位[0]:=0;位[1]:=0;位[2]:=1;
…)

现在,您可以编写助手例程,从数组中检索要查找的值:

function getInt(start, len: integer): integer;
function getChar(start: integer): String;

这些函数将使用start(可能还有len)参数将数组中的适当位组合成一个可用值。

使用SHL/SHR和掩蔽来读取缓冲区。我将编写一些函数对缓冲区(我将其声明为字节数组)进行操作,并从起始位位置返回特定位数的值。例如,假设您的最大值永远不会超过16位(一个字)。由于您的数据映射到一个字节数组,如果您总是从数组中获取3个字节(注意上界)并放入一个整数,那么您可以屏蔽和移位以获得特定的值。然后,要获取的字节的位置将是(假设基于0的数组):

将它们从数组中拉入整数

TempInt := 0;
if Byte1Index <= High(Buffer) then
  TempInt := Buffer[Byte1Index];
if Byte2Index <= High(Buffer) then 
  TempInt := TempInt OR ((Buffer[Byte2Index] and $000000FF) SHL 8);
if Byte3Index <= High(Buffer) then
  TempInt := TempInt OR ((Buffer[Byte2Index] and $000000FF) SHL 16);
您可以通过编程方式构建最终遮罩:

FinalMask := ($FFFFFFFF shl bitcount) xor $FFFFFFFF;
编辑

此方法当前限制为32位,但可以通过将掩码从32位整数更改为64位整数(例如从
$FFFFFFFF
更改为
$ffffffffff
)扩展到最多64位。如果不需要额外的字节,也可以通过不加载额外的字节来提高性能,我在这里只提供了16位的示例,但是如果
bitsneed+FirstBiT MOD 8 0


对于消息传递方面,我将创建一个知道如何从缓冲区读取数据的基本对象,然后将其扩展到一个知道如何读取参数的对象,然后创建知道如何处理每种消息类型的对象子体。你还有一份案情陈述,但是,在一个简单的调度程序级别上,只需将缓冲区传递给适当的对象即可。我可能会使用ASM块和一些汇编代码来处理这个问题-如果可以使用x86汇编,解析数据并将其转换为更可读的格式来传递数据会容易得多。

不同的消息/数据包具有不同的可变长度。处理任意位长度数据的干净方法如下

uses ubitstream;

procedure decode(buffer: Tbytes; var results: Tcustom_record);
var
  bstream: TBitStream;
  msg: byte;        //  3 bits
  cnt: byte;        //  8 bits
  Data_1: Word;     // 15 bits
  Data_2: Word;     //  7 bits
  Data_3: Word;     // ~~ bits
begin
  bstream:=TBitStream.Create;
  bstream.Load(buffer, sizeof(buffer) );
  msg := bstream.readCardinal(3);
  if msg = 1 then begin
    cnt := bstream.readCardinal(8);
    Data_1 := bstream.readCardinal(15);
    Data_2 := bstream.readCardinal(7);
    Data_3 := bstream.readCardinal(~~);
  end else if msg = 2 then begin // different msg type with different lengths
    cnt := bstream.readCardinal(5);
    Data_1 := bstream.readCardinal(14);
    Data_2 := bstream.readCardinal(12);
    Data_3 := bstream.readCardinal(~~);
  end; // etc etc...
  bstream.free;
end;
您将需要ubitstream.pas

unit ubitstream;

interface

uses classes, sysutils;

Type
TBitStream = class
   constructor Create;
   destructor Free;
public
   procedure clear;
   procedure LoadFromStr(s: string);
   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;

   //Sequential 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: TBytes;//Array of byte;
   stream_pos: cardinal; //position for sequential operations bits-based
   bitsize: cardinal;
end;

implementation

uses strutils;

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

destructor TBitStream.Free;
begin
   SetLength(bits,0); //free array
   bits:=nil;
   bitsize:=0;
   stream_pos:=0;
end;

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

function TBitStream.getSize:smallint;
begin
   if (bitsize mod 8)>0 then getSize := (bitsize div 8) +1
   else getSize := bitsize div 8;
end;

procedure TBitStream.setSize(newSize: smallint);
begin
   SetLength(bits,newSize);
   bitsize:=newSize*8;
   if stream_pos>bitsize then stream_pos:=bitsize; //set to end of stream
end;

function TBitStream.getCardinal(offset: cardinal; count: cardinal):cardinal;
//return count of bits from offset 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 
   begin 
      SetLength(bits,(offset div 8)+1); 
   end;
   bitsize:=offset;
   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 offset 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 begin
      SetLength(bits,((offset+count) div 8)+1); //Reallocate bits array
   end;
   bitsize:=offset+count;
   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, offset 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.LoadFromStr(s: string);
//load data from hex string
var 
   i,j: cardinal;
   b: byte;
   c1,c2:byte;
begin
   clear;
   s:=AnsiReplaceStr(s,' ','');
   if (length(s) mod 2) <> 0 then exit;
   i:=1;j:=0;
   SetLength(bits, length(s) div 2);
   bitsize:=(length(s) div 2 ) * 8; 
   repeat 
      c1:=0; c2:=0;
      if s[i] in ['0','1','2','3','4','5','6','7','8','9'] then c1:=ord(s[i])-$30;
      if s[i] in ['A','B','C','D','E','F'] then c1:=10+ord(s[i])-$41;
      if s[i+1] in ['0','1','2','3','4','5','6','7','8','9'] then c2:=ord(s[i+1])-$30;
      if s[i+1] in ['A','B','C','D','E','F'] then c2:=10+ord(s[i+1])-$41;
      b:=c1*16+c2;
      bits[j]:=b;
      inc(i,2);
      inc(j);
   until i>=length(s);
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);
      bitsize:= (i+1) * 8;
      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
   byteArray:=nil; //dealloc bytearray
   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);
   bitsize:=count;
   for i:=0 to len-1 do begin
      b:=bs.getCardinal(off,8);
      if (i>Size) then begin
         SetLength(bits,i+1);
      end;
      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);
   bitsize:=len * 8;
   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);
   bitsize:=(len-offset) * 8;
   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
   if (newPosition>bitsize) then exit;
   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=bitsize;//High(bits)+1;
end;

procedure TBitStream.writeString(s: ansistring);
var
   i:cardinal;
   b:Tbytes;
begin
   setLength(b,1);
   for i:=1 to length(s) do begin
      b[0]:=byte(s[i]);
      setBits(stream_pos,7,b);
      inc(stream_pos,7);
   end;
   b[0]:=$7f;
   setBits(stream_pos,7,b);
   inc(stream_pos,7);
   b:=nil;
end;

end.
单位ubitstream;
接口
使用类、sysutils;
类型
TBitStream=类
构造函数创建;
无自毁函数;
公众的
程序清晰;
过程LoadFromStr(s:string);
过程加载(文件名:字符串);超载;
过程加载(bs:TBitStream;偏移量:基数;计数:基数);超载;
过程加载(bs:TBitStream;计数:基数);超载;
程序负载(字节:t字节);超载;
过程加载(字节数组:T字节;偏移量:基数);超载;
过程保存(文件名:字符串);超载;
程序保存(var byteArray:t字节);超载;
函数toHex:String;
函数toBin:String;
//顺序存取
函数readCardinal(计数:整数):基数;
函数readBit:byte;
函数readString(count:cardinal):ansistring;
过程写入比特(位:字节);
过程写入位(计数:基数;数据:T字节);超载;
过程写片(计数:基数;pdata:Pbyte);超载;
程序写入(s:ansistring);
//----------------------------------------------------
函数getSize:smallint;
过程设置大小(新闻大小:smallint);
属性大小:smallint读取getSize写入setSize;
函数getPos:cardinal;
程序setPos(新位置:基数);
属性位置:基数读取getPos写入setPos;
函数eos:布尔型//断流
受保护的
//随机存取
函数getCardinal(偏移量:基数;计数:基数):基数;
函数getBit(偏移量:基数):字节;
函数getString(offset:cardinal;count:cardinal;var readCount:cardinal):ansistring;
程序setBit(偏移量:基数;位:字节);
过程设置(偏移量:基数;计数:基数;数据:T字节);
//----------------------------------------------------
私有的
位:t字节//字节数组;
溪流位置:红衣主教//基于位的顺序操作的位置
比特大小:基数;
结束;
实施
使用支柱;
构造函数TBitS
Result := TempInt AND $00003FFF;
FinalMask := ($FFFFFFFF shl bitcount) xor $FFFFFFFF;
uses ubitstream;

procedure decode(buffer: Tbytes; var results: Tcustom_record);
var
  bstream: TBitStream;
  msg: byte;        //  3 bits
  cnt: byte;        //  8 bits
  Data_1: Word;     // 15 bits
  Data_2: Word;     //  7 bits
  Data_3: Word;     // ~~ bits
begin
  bstream:=TBitStream.Create;
  bstream.Load(buffer, sizeof(buffer) );
  msg := bstream.readCardinal(3);
  if msg = 1 then begin
    cnt := bstream.readCardinal(8);
    Data_1 := bstream.readCardinal(15);
    Data_2 := bstream.readCardinal(7);
    Data_3 := bstream.readCardinal(~~);
  end else if msg = 2 then begin // different msg type with different lengths
    cnt := bstream.readCardinal(5);
    Data_1 := bstream.readCardinal(14);
    Data_2 := bstream.readCardinal(12);
    Data_3 := bstream.readCardinal(~~);
  end; // etc etc...
  bstream.free;
end;
unit ubitstream;

interface

uses classes, sysutils;

Type
TBitStream = class
   constructor Create;
   destructor Free;
public
   procedure clear;
   procedure LoadFromStr(s: string);
   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;

   //Sequential 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: TBytes;//Array of byte;
   stream_pos: cardinal; //position for sequential operations bits-based
   bitsize: cardinal;
end;

implementation

uses strutils;

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

destructor TBitStream.Free;
begin
   SetLength(bits,0); //free array
   bits:=nil;
   bitsize:=0;
   stream_pos:=0;
end;

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

function TBitStream.getSize:smallint;
begin
   if (bitsize mod 8)>0 then getSize := (bitsize div 8) +1
   else getSize := bitsize div 8;
end;

procedure TBitStream.setSize(newSize: smallint);
begin
   SetLength(bits,newSize);
   bitsize:=newSize*8;
   if stream_pos>bitsize then stream_pos:=bitsize; //set to end of stream
end;

function TBitStream.getCardinal(offset: cardinal; count: cardinal):cardinal;
//return count of bits from offset 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 
   begin 
      SetLength(bits,(offset div 8)+1); 
   end;
   bitsize:=offset;
   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 offset 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 begin
      SetLength(bits,((offset+count) div 8)+1); //Reallocate bits array
   end;
   bitsize:=offset+count;
   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, offset 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.LoadFromStr(s: string);
//load data from hex string
var 
   i,j: cardinal;
   b: byte;
   c1,c2:byte;
begin
   clear;
   s:=AnsiReplaceStr(s,' ','');
   if (length(s) mod 2) <> 0 then exit;
   i:=1;j:=0;
   SetLength(bits, length(s) div 2);
   bitsize:=(length(s) div 2 ) * 8; 
   repeat 
      c1:=0; c2:=0;
      if s[i] in ['0','1','2','3','4','5','6','7','8','9'] then c1:=ord(s[i])-$30;
      if s[i] in ['A','B','C','D','E','F'] then c1:=10+ord(s[i])-$41;
      if s[i+1] in ['0','1','2','3','4','5','6','7','8','9'] then c2:=ord(s[i+1])-$30;
      if s[i+1] in ['A','B','C','D','E','F'] then c2:=10+ord(s[i+1])-$41;
      b:=c1*16+c2;
      bits[j]:=b;
      inc(i,2);
      inc(j);
   until i>=length(s);
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);
      bitsize:= (i+1) * 8;
      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
   byteArray:=nil; //dealloc bytearray
   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);
   bitsize:=count;
   for i:=0 to len-1 do begin
      b:=bs.getCardinal(off,8);
      if (i>Size) then begin
         SetLength(bits,i+1);
      end;
      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);
   bitsize:=len * 8;
   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);
   bitsize:=(len-offset) * 8;
   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
   if (newPosition>bitsize) then exit;
   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=bitsize;//High(bits)+1;
end;

procedure TBitStream.writeString(s: ansistring);
var
   i:cardinal;
   b:Tbytes;
begin
   setLength(b,1);
   for i:=1 to length(s) do begin
      b[0]:=byte(s[i]);
      setBits(stream_pos,7,b);
      inc(stream_pos,7);
   end;
   b[0]:=$7f;
   setBits(stream_pos,7,b);
   inc(stream_pos,7);
   b:=nil;
end;

end.