unit binhex;
{$I define.pas}

interface

{uses crt;}
const  hexChars: array [0..$F] of Char =
    '0123456789ABCDEF';

type binstr=string[8];
     hexstr=string[8];

function bin(b:byte):binstr;
{prevod bytu do dvojkove reprezenatace}
function LongToBin(l:longint; bits:byte):string;

procedure setbit(position,value:byte; var b:byte);
{nastavuje position-ty bit(0-7) v promenne b na hodnotu value(0,1)}

function biton(position,b:byte):boolean;
{testuje je-li position-ty bit (0-7) promenne b =1}

function IsHexChar(ch:char):boolean;

function bytetohex(b:byte):hexstr;
{prevod bytu do hexadec.tvaru}

function hextobyte(ahex:hexstr):byte;

function wordtohex(w:word):hexstr;
{prevod w do hexadecimalniho tvaru}

function longtohex(l:longint):hexstr;

function hextoword(s:string):word;

function hextolong(s:string):longint;

function StringToHex(s:string):string;
function HexToString(s:string):string;

function RecToHex(var Rec; BufSize:byte):string;
function HexToRec(S:String; var Rec; BufSize:byte):boolean;

procedure SetFlag(AMask:word; var AFlag:word; OnOff:boolean);
function IsFlagSet(AMask:word; AFlag:word):boolean;
procedure ToggleFlag(AMask:word; var AFlag:word);

procedure SetBitInByteArray(var Rec; ABitNumber:word; OnOff:boolean);
function GetBitInByteArray(var Rec; ABitNumber:word):boolean;

procedure SetBitsInByte(var AByte:byte; AMask:byte; AValue:byte);
  {changes only those bits of AByte, that are in AMask in 1, to value
  specified in AValue}

procedure SetBitInByte(var by:byte; ABitNumber:byte; OnOff:boolean);
{set the ABitNumber bit in by to 1(onoff=true) or 0, e.g.
for ABitNumber = 6 it sets 6'th bit (numbering from 0) of the by}

function GetBitInByte(by:byte; ABitNumber:byte):boolean;

{function GetBitsInByte(AByte:byte; AMask:byte):byte;
  {retuns only the part of AByte with only those}
implementation

function bin{(b:byte):binstr};
{prevod bytu do dvojkove reprezenatace}
var i:Integer; bt:byte; s:binstr;
begin
  bt:= $01;
  s:='';
  for i := 1 to 8 do begin
    if (b and bt) > 0 then
      s := '1' + s
    else
      s := '0' + s;
  {$R-} bt:=bt shl 1; {$R+}
  end;
  bin:=s;
end;

function LongToBin(l:longint; bits:byte):string;
var
  s:string;
  m:longint;
begin
  if bits = 0 then
    bits := 32;
  m := 1;
  s := '';
  while bits > 0 do begin
    if (m and l) <> 0 then
      s := '1' + s
    else
      s := '0' + s;
    m := m shl 1;
    dec(bits);
  end;
  LongToBin := s;
end;

procedure setbit{(position,value:byte; var b:byte)};
{nastavuje position-ty bit(0-7) v promenne b na hodnotu value(0,1)}
var bt:byte;
begin
  bt:=$01;
  bt:= bt shl position;
  if value=1 then b:=b or bt else begin
    bt:=bt xor $ff;
    b:=b and bt;
  end;
end;

function biton{(position,b:byte):boolean};
{testuje je-li position-ty bit (0-7) promenne b =1}
var bt:byte;
begin
  bt:=$01;
  bt:=bt shl position;
  biton:=(bt and b) > 0;
end;

function IsHexChar(ch:char):boolean;
begin
  IsHexChar := (ch in ['0'..'9','a'..'f','A'..'F']);
end;

function bytetohex{(b:byte):hexstr};
{prevod bytu do hexadec.tvaru}
begin
  bytetohex:=hexChars[b shr 4]+hexChars[b and $F];
end;


function wordtohex{(w:word):hexstr};
{prevod w do hexadecimalniho tvaru}
begin
  wordtohex:=hexChars[Hi(w) shr 4]+hexChars[Hi(w) and $F]+
        hexChars[Lo(w) shr 4]+hexChars[Lo(w) and $F];
end;

function trim(s:string):string;
var i:Integer;
begin
  i := 1;
  while (i <= length(s)) and (s[i] = ' ') do
    inc(i);
  s := copy(s, i, 255);
  while (length(s) > 0) and (s[length(s)] = ' ') do begin
    {$IFDEF WIN32}
    SetLength(s, length(s) - 1);
    {$ELSE}
    dec(s[0]);
    {$ENDIF}
  end;
  trim := s;
end;

function hextobyte(ahex:hexstr):byte;
var b:byte; code:integer;
begin
  val('$'+trim(ahex), b, code);
  hextobyte:=b;
end;



function longtohex(l:longint):hexstr;
var
  lw:array[0..1]of word absolute l;
begin
  longtohex := wordtohex(lw[1]) + wordtohex(lw[0]);
end;

function hextoword(s:string):word;
var w:word;code:integer;
begin
  val('$'+trim(s),w,code);
  hextoword:=w;
end;

function hextolong(s:string):longint;
var w:longint; code:Integer;
begin
  val('$'+trim(s),w,code);
  hextolong:=w;
end;

function StringToHex(s:string):string;
var
  r:string;
  i:byte;
begin
  r := '';
  for i := 1 to length(s) do
    r := r + HexChars[ord(s[i]) shr 4] + HexChars[ord(s[i]) and $F];
  StringToHex := r;
end;

function HexToString(s:string):string;
var
  r:string;
  i,b:byte;
begin
  r := '';
  for i := 1 to (length(s) div 2) do begin
    b := hextobyte(copy(s,(i - 1) * 2 + 1, 2));
    r := r + chr(b);
  end;
  HexToString := r;
end;

function RecToHex(var Rec; BufSize:byte):string;
var S:String;
begin
  {$IFDEF WIN32}
  SetLength(S, BufSize);
  {$ELSE}
  S[0] := chr(BufSize);
  {$ENDIF}
  move(Rec, S[1], BufSize);
  RecToHex := StringToHex(S);
end;

function HexToRec(S:String; var Rec; BufSize:byte):boolean;
var l:byte;
begin
  S := HexToString(S);
  l := length(S);
  if l > BufSize then
    l := BufSize;
  move(S[1], Rec, l);
  HexToRec := true;
end;

procedure SetFlag(AMask:word; var AFlag:word; OnOff:boolean);
var Flag:word absolute AFlag;
begin
  if OnOff then
    Flag := Flag or AMask
  else
    Flag := Flag and (not AMask);
end;

function IsFlagSet(AMask:word; AFlag:word):boolean;
var Flag:word absolute AFlag;
begin
  IsFlagSet := (AMask and Flag) <> 0;
end;

procedure ToggleFlag(AMask:word; var AFlag:word);
var Flag:word absolute AFlag;
begin
  Flag := Flag xor AMask;
end;

type
  TBuffer = array[0..65520] of byte;

procedure SetBitInByteArray(var Rec; ABitNumber:word; OnOff:boolean);
var R:TBuffer absolute Rec;
  p:word;
  b:byte;
begin
  p := ABitNumber div 8;
  b := 1 shl (ABitNumber mod 8);
  if OnOff then
    R[p] := R[p] or b
  else
    R[p] := R[p] and (not b);
end;

procedure SetBitInByte(var by:byte; ABitNumber:byte; OnOff:boolean);
var b:byte;
begin
  b := 1 shl Abitnumber;
  if onoff then
    by := by or b
  else
    by := by and (not b);
end;

function GetBitInByte(by:byte; ABitNumber:byte):boolean;
var b:byte;
begin
  b := 1 shl Abitnumber;
  GetBitInByte := (by and b) <> 0;
end;

function GetBitInByteArray(var Rec; ABitNumber:word):boolean;
var R:TBuffer absolute Rec;
  p:word;
  b:byte;
begin
  p := ABitNumber div 8;
  b := 1 shl (ABitNumber mod 8);
  GetBitInByteArray := (R[p] and b) <> 0;
end;

procedure SetBitsInByte(var AByte:byte; AMask:byte; AValue:byte);
  {changes only those bits of AByte, that are in AMask in 1, to value
  specified in AValue}
begin
  AByte := (AByte and (not AMask)) or (AValue and AMask);
end;

end.
