unit HexUtils;

interface
uses Windows,SysUtils;

type   THexValue=0..15;

function BufToHexStr(Buf:Pointer; BufLen: integer): string;
function BufToHex_Str(Buf:Pointer; BufLen: integer): string;
function HexToByteStr(Buf:Pointer; BufLen: integer): string;
procedure HexTopByte(Buf:Pointer; BufLen: integer; OutBuf : pointer);
//function HexToByteStr(Buf:Pointer; BufLen: integer): string;
function BinToStr( bin: byte; bits: integer): string;
function StrToBin(const s: string): byte;
function Int2Digs(num,len : dword): string;
function StrToBufHex(const s: string;Buf:Pointer): integer;
function TwoChrToByte (a,b : char): byte;
function Bcd2Hex (a : byte): byte;
function CompareTwoHexBuf (Buf:Pointer;Buf1:Pointer;BufLen:integer): boolean;
//function CharToHex(c:char):THexValue;
function HexToInt(hex:string):integer;
function GetWord(Str, Smb: string; WordNmbr: Byte): string;
function CharToHex(c:char):THexValue;
function Byte2Str(b: Byte): string;
function Hex2Chr(S: string): string;
procedure DWordSwap(dwswap:pointer);
procedure WordSwap(wswap:pointer);
function BufCopy(BufFrom:pointer;BufTo:pointer;Len:integer):pointer;
function Str2Byte(b: string): byte;
function BufCopySwapWord(BufFrom:pointer;BufTo:pointer;Len:integer):pointer;


implementation

function BufCopy(BufFrom:pointer;BufTo:pointer;Len:integer):Pointer;
begin
     while Len<>0 do begin
     byte(BufTo^):=byte(BufFrom^);
     inc(Integer(BufTo));
     inc(Integer(BufFrom));
     Len:=Len-1;
     end;
     Result:=BufFrom;
end;

function BufCopySwapWord(BufFrom:pointer;BufTo:pointer;Len:integer):pointer;
begin
     Len:=Len shr 1;
     while Len<>0 do begin
     word(BufTo^):=word(BufFrom^);
     WordSwap(BufTo);
     inc(Integer(BufTo));
     inc(Integer(BufTo));
     inc(Integer(BufFrom));
     inc(Integer(BufFrom));
     Len:=Len-1;
     end;
     Result:=BufTo;
end;

function Str2Byte(b: string): byte;
begin
  Result := HexToint(b);
end;


procedure WordSwap(wswap:pointer);
var
a,b:byte;
begin
    a:=byte(wswap^);
    inc(Integer(wswap));
    b:=byte(wswap^);
    byte(wswap^):=a;
    dec(Integer(wswap));
    byte(wswap^):=b;
end;

procedure DWordSwap(dwswap:pointer);
var
a,b,c,d:byte;
begin
    a:=byte(dwswap^);
    inc(Integer(dwswap));
    b:=byte(dwswap^);
    inc(Integer(dwswap));
    c:=byte(dwswap^);
    inc(Integer(dwswap));
    d:=byte(dwswap^);
    byte(dwswap^):=a;
    dec(Integer(dwswap));
    byte(dwswap^):=b;
    dec(Integer(dwswap));
    byte(dwswap^):=c;
    dec(Integer(dwswap));
    byte(dwswap^):=d;
end;

function CharToHex(c:char):THexValue;
begin
  c:=upcase(c);
  Result:=0;
  if c in ['0'..'9']then
    Result:=ord(c)-ord('0')
  else if c in ['A'..'F']then
    Result:=ord(c)-ord('A')+10;
end;

function GetWord(Str, Smb: string; WordNmbr: Byte): string;
var
   SWord: string;
StrLen, N: Byte;
begin
     N := 1;
     StrLen := SizeOf(Str);
     while ((WordNmbr >= N) and (StrLen <> 0)) do
     begin
          StrLen := Pos(Smb, str);
          if StrLen <> 0 then
          begin
               SWord := Copy(Str, 1, StrLen - 1);
               Delete(Str, 1, StrLen);
               Inc(N);
          end else
          SWord := Str;
     end;
     if WordNmbr <= N then Result := SWord
     else Result := '';
end;

function HexToInt(hex:string):integer;
var
  i:byte;
  HexFactor:integer;
begin
  result:=0;
  HexFactor:=1;
  if length(hex)=0 then exit;
  for i:=1 to length(hex)do
    begin
      inc(result,CharToHex(hex[length(hex)-pred(i)])*HexFactor);
      HexFactor:=HexFactor*16;
    end;
end;

function CompareTwoHexBuf (Buf:Pointer;Buf1:Pointer;BufLen:integer): boolean;
var
i: integer;
begin
     Result:=false;
     for i:=0 to BufLen-1 do begin
     if byte (Buf^) <> byte (Buf1^) then exit;
     inc (Integer(Buf));
     inc (Integer(Buf1));
     end;
     Result:=true;
end;

function StrToBufHex(const s: string; Buf:Pointer): integer;
var
i: integer;
a,b : char;
begin
 Result :=0 ;
 i:=1;
 while s[i] >= chr($0d) do begin
   if (s[i] >= '0') and (s[i] <= 'F') then begin
     a:=s[i];
     i :=i+1 ;
     b:=s[i];
     byte(Buf^):= TwoChrToByte (a,b);
     inc(Integer(Buf));
     Result:=Result+1;
           end;
  i:=i+1;
 end;
end;

function Bcd2Hex (a : byte): byte;
begin
   Result:= (a div 16)*10 + a mod 16;
end;


function TwoChrToByte (a,b : char): byte;
var
   c,d: byte ;
begin
         if a >= 'A' then c:= ord (a) - $37
                    else c:= ord (a) - $30 ;
        if b >= 'A' then d:= ord (b) - $37
                    else d:= ord (b) - $30 ;
        c:= c shl 4 ;
        Result:= c + d ;
end;


function Int2Digs(num,len : dword): string;
begin
   if len>10 then len := 10;
   result:=IntToStr(num);
   while dword(length(result))<len do result:='0'+result;
end;

function BufToHexStr(Buf:Pointer; BufLen: integer): string;
begin
 Result:='';
  while BufLen > 0 do begin
   Result:=Result+IntToHex(Byte(Buf^), 2);
   inc(Integer(Buf)); dec(BufLen);
  end;
end;

function BufToHex_Str(Buf:Pointer; BufLen: integer): string;
begin
 Result:='';
  while BufLen > 1 do begin
   Result:=Result+IntToHex(Byte(Buf^), 2)+' ';
   inc(Integer(Buf)); dec(BufLen);
  end;
  Result:=Result+IntToHex(Byte(Buf^), 2);
end;

function HexToByteStr(Buf:Pointer; BufLen: integer): string;
var
 i: integer;
 defHex : string;
begin
  defHex := '$PV'; i:=1;
  SetLength(Result,BufLen);
  while i<=BufLen do begin
   while (Char(Buf^)<'0') or (Char(Buf^)>'f') do
     if(Byte(Buf^)=0) then break else inc(Dword(Buf));
   defHex[2] := Char(Buf^); inc(Dword(Buf));
   defHex[3] := Char(Buf^); inc(Dword(Buf));
   Byte(Result[i]) := StrToIntDef(defHex,0);
   inc(i);
  end;
end;

procedure HexTopByte(Buf:Pointer; BufLen: integer; OutBuf : pointer);
var
 i: integer;
 defHex : string;
begin
  defHex := '$PV'; i:=1;
  while i<=BufLen do begin
   while (Char(Buf^)<'0') or (Char(Buf^)>'f') do
     if(Byte(Buf^)=0) then break else inc(Dword(Buf));
   defHex[2] := Char(Buf^); inc(Dword(Buf));
   defHex[3] := Char(Buf^); inc(Dword(Buf));
   Byte(OutBuf^) := StrToIntDef(defHex,0);
   inc(integer(OutBuf));
   inc(i);
  end;
end;

function BinToStr( bin: byte; bits: integer): string;
var
 i,x : integer;
 mask : dword;
 Buffer : array[0..8] of Char;
begin
  result:='';
  if bits=0 then begin
   result:='0';
   exit;
  end;
  mask := 1 shl (bits-1);
  x := bits;
  if x > 8 then x:=8;
  for i:=0 to x do begin
   if (bin and mask) <> 0 then
     Buffer[i]:='1'
   else
     Buffer[i]:='0';
   mask := mask shr 1;
  end;
  Buffer[x]:=#0;
  result := Buffer;
end;

function StrToBin(const s: string): byte;
var
 i: integer;
 m: dword;
begin
    i:=1;
    m:=1;
    result := 0;
    while (i <= Length(s)) and ((s[i] = '1') or (s[i] = '0')) do inc(i);
    while i>1 do begin
      dec(i);
      if s[i] = '1' then
        result := result or m;
      m := m shl 1;
    end;
end;

function Byte2Str(b: Byte): string;
begin
  Result := IntToHex(b, 2);
end;


function Hex2Chr(S: string): string;
var
  i, j: integer;
  b: BYTE;
begin
  i := 1;
  j := 0;
  while i < length(s) do
  begin
    b := STrToInt('$' + S[i] + S[i + 1]);
    inc(i, 2);
    result := result + Chr(b);
  end;
end;

end.