mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-16 21:58:26 +02:00
+ BinToHex and HexToBin from Marco added
This commit is contained in:
parent
0e70c8f975
commit
1cf4d20b51
@ -24,9 +24,63 @@ begin
|
|||||||
Result:=True;
|
Result:=True;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
|
||||||
|
Const
|
||||||
|
HexDigits='0123456789ABCDEF';
|
||||||
|
var
|
||||||
|
i : longint;
|
||||||
|
begin
|
||||||
|
for i:=0 to binbufsize-1 do
|
||||||
|
begin
|
||||||
|
HexValue[0]:=hexdigits[(ord(binvalue^) and 15)];
|
||||||
|
HexValue[1]:=hexdigits[(ord(binvalue^) shr 4)];
|
||||||
|
inc(hexvalue,2);
|
||||||
|
inc(binvalue);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
|
||||||
|
// more complex, have to accept more than bintohex
|
||||||
|
// A..F 1000001
|
||||||
|
// a..f 1100001
|
||||||
|
// 0..9 110000
|
||||||
|
var
|
||||||
|
i,j : integer;
|
||||||
|
begin
|
||||||
|
i:=binbufsize;
|
||||||
|
while (i>0) do
|
||||||
|
begin
|
||||||
|
if hexvalue^ IN ['A'..'F','a'..'f'] then
|
||||||
|
j:=(ord(hexvalue^)+9) and 15
|
||||||
|
else
|
||||||
|
if hexvalue^ IN ['0'..'9'] then
|
||||||
|
j:=(ord(hexvalue^)) and 15
|
||||||
|
else
|
||||||
|
break;
|
||||||
|
inc(hexvalue);
|
||||||
|
if hexvalue^ IN ['A'..'F','a'..'f'] then
|
||||||
|
j:=j+((ord(hexvalue^)+9) and 15) shl 4
|
||||||
|
else
|
||||||
|
if hexvalue^ IN ['0'..'9'] then
|
||||||
|
j:=j+((ord(hexvalue^)) and 15) shl 4
|
||||||
|
else
|
||||||
|
break;
|
||||||
|
inc(hexvalue);
|
||||||
|
binvalue^:=chr(j);
|
||||||
|
inc(binvalue);
|
||||||
|
dec(i);
|
||||||
|
end;
|
||||||
|
result:=binbufsize-i;
|
||||||
|
end;
|
||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.1 2003-10-06 21:01:06 peter
|
Revision 1.2 2005-02-03 20:17:05 florian
|
||||||
|
+ BinToHex and HexToBin from Marco added
|
||||||
|
|
||||||
|
Revision 1.1 2003/10/06 21:01:06 peter
|
||||||
* moved classes unit to rtl
|
* moved classes unit to rtl
|
||||||
|
|
||||||
Revision 1.3 2002/09/07 15:15:26 peter
|
Revision 1.3 2002/09/07 15:15:26 peter
|
||||||
|
Loading…
Reference in New Issue
Block a user