util.inc 1.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162
  1. {
  2. This file is part of the Free Component Library (FCL)
  3. Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
  4. See the file COPYING.FPC, included in this distribution,
  5. for details about the copyright.
  6. This program is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  9. **********************************************************************}
  10. procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
  11. Const
  12. HexDigits='0123456789ABCDEF';
  13. var
  14. i : longint;
  15. begin
  16. for i:=0 to binbufsize-1 do
  17. begin
  18. HexValue[0]:=hexdigits[1+((ord(binvalue^) shr 4))];
  19. HexValue[1]:=hexdigits[1+((ord(binvalue^) and 15))];
  20. inc(hexvalue,2);
  21. inc(binvalue);
  22. end;
  23. end;
  24. function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
  25. // more complex, have to accept more than bintohex
  26. // A..F 1000001
  27. // a..f 1100001
  28. // 0..9 110000
  29. var i,j,h,l : integer;
  30. begin
  31. i:=binbufsize;
  32. while (i>0) do
  33. begin
  34. if hexvalue^ IN ['A'..'F','a'..'f'] then
  35. h:=((ord(hexvalue^)+9) and 15)
  36. else if hexvalue^ IN ['0'..'9'] then
  37. h:=((ord(hexvalue^)) and 15)
  38. else
  39. break;
  40. inc(hexvalue);
  41. if hexvalue^ IN ['A'..'F','a'..'f'] then
  42. l:=(ord(hexvalue^)+9) and 15
  43. else if hexvalue^ IN ['0'..'9'] then
  44. l:=(ord(hexvalue^)) and 15
  45. else
  46. break;
  47. j := l + (h shl 4);
  48. inc(hexvalue);
  49. binvalue^:=chr(j);
  50. inc(binvalue);
  51. dec(i);
  52. end;
  53. result:=binbufsize-i;
  54. end;