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;
procedure reversedword(rswap: pointer);
function swapstring(s: string): string;
function swapL8string(s: string): string;

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;

procedure reversedword(rswap: pointer);
var
  a, b, c, d: byte;
begin
  a := byte(rswap^);
  inc(Integer(rswap));
  b := byte(rswap^);
  inc(Integer(rswap));
  c := byte(rswap^);
  inc(Integer(rswap));
  d := byte(rswap^);
  byte(rswap^) := c;
  dec(Integer(rswap));
  byte(rswap^) := d;
  dec(Integer(rswap));
  byte(rswap^) := a;
  dec(Integer(rswap));
  byte(rswap^) := b;
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;

function swapstring(s: string): string;
var
  s1, s2, s3: string;
  i, i2: integer;
begin
  s3 := '';
  result := '0000000000000000';
  if length(s) <> 16 then exit;
  if s = 'FFFFFFFFFFFFFFFF' then exit;
  if s = '0000000000000000' then exit;
  i2 := 0;
  for i := 1 to 8 do
  begin
    s2 := copy(s, i + i2, 1);
    s1 := copy(s, i + (i2 + 1), 1);
    inc(i2);
    s3 := s3 + s1 + s2;
  end;
  result := s3;
end;

function swapL8string(s: string): string;
var
  s1, s2, s3: string;
  i, i2: integer;
begin
  s3 := '';
  result := '00000000';
  if length(s) <> 8 then exit;
  if s = 'FFFFFFFF' then exit;
  if s = '00000000' then exit;
  i2 := 7;
  for i := 1 to 2 do
  begin
    s2 := copy(s, i2, 2);
    s1 := copy(s, (i2 - 2), 2);
    dec(i2, 4);
    s3 := s3 + s2 + s1;
  end;
  result := s3;
end;
end.