paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 21:10:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Fix for BintoHex and hextobin by Uberto Barbini

Browse Source
This commit is contained in:
michael 2005-04-14 17:43:35 +00:00
parent 16f5f310b1
commit e0f4f77b94
2 changed files with 71 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
rtl/objpas/classes/util.inc
View File

@ -33,10 +33,10 @@ var
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);
HexValue[0]:=hexdigits[1+((ord(binvalue^) shr 4))];
HexValue[1]:=hexdigits[1+((ord(binvalue^) and 15))];
inc(hexvalue,2);
inc(binvalue);
end;
end;
@ -46,38 +46,40 @@ function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
// A..F 1000001
// a..f 1100001
// 0..9 110000
var
i,j : integer;
var i,j,h,l : 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;
i:=binbufsize;
while (i>0) do
begin
if hexvalue^ IN ['A'..'F','a'..'f'] then
h:=((ord(hexvalue^)+9) and 15)
else if hexvalue^ IN ['0'..'9'] then
h:=((ord(hexvalue^)) and 15)
else
break;
inc(hexvalue);
if hexvalue^ IN ['A'..'F','a'..'f'] then
l:=(ord(hexvalue^)+9) and 15
else if hexvalue^ IN ['0'..'9'] then
l:=(ord(hexvalue^)) and 15
else
break;
j := l + (h shl 4);
inc(hexvalue);
binvalue^:=chr(j);
inc(binvalue);
dec(i);
end;
result:=binbufsize-i;
end;
end;
{
$Log$
Revision 1.3 2005-02-14 17:13:31 peter
Revision 1.4 2005-04-14 17:43:53 michael
+ Fix for BintoHex and hextobin by Uberto Barbini
Revision 1.3 2005/02/14 17:13:31 peter
* truncate log
Revision 1.2 2005/02/03 20:17:05 florian

72
rtl/objpas/strutils.pp
View File

@ -1627,51 +1627,52 @@ end;
// def from delphi.about.com:
procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
Const HexDigits='0123456789ABCDEF';
var i :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);
HexValue[0]:=hexdigits[1+((ord(binvalue^) shr 4))];
HexValue[1]:=hexdigits[1+((ord(binvalue^) and 15))];
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
// A..F    1000001
// a..f    1100001
// 0..9     110000
var i,j : integer;
var i,j,h,l : 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:=((ord(hexvalue^)+9) and 15)+ (j shl 4)
else
if hexvalue^ IN ['0'..'9'] then
j:=((ord(hexvalue^)) and 15) + (j shl 4)
else
break;
inc(hexvalue);
binvalue^:=chr(j);
inc(binvalue);
dec(i);
end;
i:=binbufsize;
while (i>0) do
begin
if hexvalue^ IN ['A'..'F','a'..'f'] then
h:=((ord(hexvalue^)+9) and 15)
else if hexvalue^ IN ['0'..'9'] then
h:=((ord(hexvalue^)) and 15)
else
break;
inc(hexvalue);
if hexvalue^ IN ['A'..'F','a'..'f'] then
l:=(ord(hexvalue^)+9) and 15
else if hexvalue^ IN ['0'..'9'] then
l:=(ord(hexvalue^)) and 15
else
break;
j := l + (h shl 4);
inc(hexvalue);
binvalue^:=chr(j);
inc(binvalue);
dec(i);
end;
result:=binbufsize-i;
end;
@ -1679,7 +1680,10 @@ end.
{
$Log$
Revision 1.15 2005-03-25 22:53:39 jonas
Revision 1.16 2005-04-14 17:43:35 michael
+ Fix for BintoHex and hextobin by Uberto Barbini
Revision 1.15 2005/03/25 22:53:39 jonas
* fixed several warnings and notes about unused variables (mainly) or
uninitialised use of variables/function results (a few)