paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 01:19:38 +01:00
Code Issues Packages Projects Releases Wiki Activity

* committed bintohex and hextobin

Browse Source
This commit is contained in:
marco 2005-02-03 21:38:17 +00:00
parent 18cb61a28a
commit d68427c934
1 changed files with 62 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
rtl/objpas/strutils.pp
View File

@ -169,6 +169,8 @@ function Numb2Dec(S: string; Base: Byte): Longint;
function IntToBin(Value: Longint; Digits, Spaces: Integer): string;
function IntToRoman(Value: Longint): string;
function RomanToInt(const S: string): Longint;
procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
const
DigitChars = ['0'..'9'];
@ -810,7 +812,7 @@ end;
Function DecodeSoundexWord(AValue: Word): string;
begin
Result := Chr(Ord0+ (AValue mod 7)) + Result;
Result := Chr(Ord0+ (AValue mod 7));
AValue := AValue div 7;
Result := Chr(Ord0+ (AValue mod 7)) + Result;
AValue := AValue div 7;
@ -1028,7 +1030,7 @@ end;
function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
var
l : Integer;
// l : Integer;
P,PE : PChar;
begin
@ -1567,7 +1569,7 @@ End;
Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : Integer; overload;
var
i,MaxLen,llen : Integer;
MaxLen,llen : Integer;
c : char;
pc,pc2 : pchar;
begin
@ -1576,7 +1578,7 @@ begin
maxlen:=length(source);
if (llen>0) and (maxlen>0) and ( llen<=maxlen) then
begin
i:=maxlen;
// i:=maxlen;
pc:=@source[maxlen];
pc2:=@source[llen-1];
c:=substr[llen];
@ -1595,7 +1597,7 @@ end;
Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : Integer; overload;
var
i,MaxLen,llen : Integer;
MaxLen,llen : Integer;
c : char;
pc,pc2 : pchar;
begin
@ -1605,7 +1607,7 @@ begin
if offs<maxlen then maxlen:=offs;
if (llen>0) and (maxlen>0) and ( llen<=maxlen) then
begin
i:=maxlen;
// i:=maxlen;
pc:=@source[maxlen];
pc2:=@source[llen-1];
c:=substr[llen];
@ -1622,12 +1624,65 @@ begin
end;
end;
// def from delphi.about.com:
procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
Const HexDigits='0123456789ABCDEF';
var i :integer;
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:=((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;
result:=binbufsize-i;
end;
end.
{
$Log$
Revision 1.12 2005-01-26 11:05:09 marco
Revision 1.13 2005-02-03 21:38:17 marco
* committed bintohex and hextobin
Revision 1.12 2005/01/26 11:05:09 marco
* fix
Revision 1.11 2005/01/01 18:45:25 marco