mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-11 14:18:38 +02:00
+ BinToHex and HexToBin from Marco added
This commit is contained in:
parent
0e70c8f975
commit
1cf4d20b51
@ -24,9 +24,63 @@ begin
|
||||
Result:=True;
|
||||
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$
|
||||
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
|
||||
|
||||
Revision 1.3 2002/09/07 15:15:26 peter
|
||||
|
Loading…
Reference in New Issue
Block a user