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

--- Merging r48967 into '.':

Browse Source 
U    packages/rtl-objpas/src/inc/strutils.pp
--- Recording mergeinfo for merge of r48967 into '.':
 U   .

# revisions: 48967
r48967 | michael | 2021-03-14 16:29:27 +0100 (Sun, 14 Mar 2021) | 1 line
Changed paths:
   M /trunk/packages/rtl-objpas/src/inc/strutils.pp

* Patch from N. Neumann to add delphi-compatible bintohex

git-svn-id: branches/fixes_3_2@49009 -
This commit is contained in:
marco 2021-03-19 12:30:10 +00:00
parent 8dd4e2e281
commit 994797ef11
1 changed files with 71 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
packages/rtl-objpas/src/inc/strutils.pp
View File

@ -129,6 +129,7 @@ function StringsReplace(const S: string; OldPattern, NewPattern: array of string
Function ReplaceStr(const AText, AFromText, AToText: string): string;inline;
Function ReplaceText(const AText, AFromText, AToText: string): string;inline;
{ ---------------------------------------------------------------------
Soundex Functions.
---------------------------------------------------------------------}
@ -226,7 +227,13 @@ function IntToRoman(Value: Longint): string;
function TryRomanToInt(S: String; out N: LongInt; Strictness: TRomanConversionStrictness = rcsRelaxed): Boolean;
function RomanToInt(const S: string; Strictness: TRomanConversionStrictness = rcsRelaxed): Longint;
function RomanToIntDef(Const S : String; const ADefault: Longint = 0; Strictness: TRomanConversionStrictness = rcsRelaxed): Longint;
procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
procedure BinToHex(const BinBuffer: TBytes; BinBufOffset: Integer; var HexBuffer: TBytes; HexBufOffset: Integer; Count: Integer); overload;
procedure BinToHex(BinValue: Pointer; HexValue: PWideChar; BinBufSize: Integer); overload;
procedure BinToHex(const BinValue; HexValue: PWideChar; BinBufSize: Integer); overload;
procedure BinToHex(BinValue: PAnsiChar; HexValue: PAnsiChar; BinBufSize: Integer); overload;
procedure BinToHex(BinValue: PAnsiChar; HexValue: PWideChar; BinBufSize: Integer); overload;
procedure BinToHex(const BinValue; HexValue: PAnsiChar; BinBufSize: Integer); overload;
procedure BinToHex(BinValue: Pointer; HexValue: PAnsiChar; BinBufSize: Integer); overload;
function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
const
@ -3188,6 +3195,7 @@ begin
end;
// def from delphi.about.com:
(*
procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
Const
@ -3203,6 +3211,68 @@ begin
inc(binvalue);
end;
end;
*)
procedure BinToHex(BinValue: PAnsiChar; HexValue: PAnsiChar; BinBufSize: Integer);
const
HexDigits : AnsiString='0123456789ABCDEF';
var
i : longint;
begin
for i:=0 to BinBufSize-1 do
begin
HexValue[0]:=HexDigits[1+((Ord(BinValue[i]) shr 4))];
HexValue[1]:=HexDigits[1+((Ord(BinValue[i]) and 15))];
Inc(HexValue,2);
end;
end;
procedure BinToHex(BinValue: PAnsiChar; HexValue: PWideChar; BinBufSize: Integer);
const
HexDigits : WideString='0123456789ABCDEF';
var
i : longint;
begin
for i:=0 to BinBufSize-1 do
begin
HexValue[0]:=HexDigits[1+((Ord(BinValue[i]) shr 4))];
HexValue[1]:=HexDigits[1+((Ord(BinValue[i]) and 15))];
Inc(HexValue,2);
end;
end;
procedure BinToHex(const BinBuffer: TBytes; BinBufOffset: Integer; var HexBuffer: TBytes; HexBufOffset: Integer; Count: Integer);
const
HexDigits : String='0123456789ABCDEF';
var
i : longint;
begin
for i:=0 to Count-1 do
begin
HexBuffer[HexBufOffset+2*i+0]:=Byte(HexDigits[1+(BinBuffer[BinBufOffset + i] shr 4)]);
HexBuffer[HexBufOffset+2*i+1]:=Byte(HexDigits[1+(BinBuffer[BinBufOffset + i] and 15)]);
end;
end;
procedure BinToHex(BinValue: Pointer; HexValue: PAnsiChar; BinBufSize: Integer);
begin
BinToHex(PAnsiChar(BinValue), HexValue, BinBufSize);
end;
procedure BinToHex(BinValue: Pointer; HexValue: PWideChar; BinBufSize: Integer);
begin
BinToHex(PAnsiChar(BinValue), HexValue, BinBufSize);
end;
procedure BinToHex(const BinValue; HexValue: PAnsiChar; BinBufSize: Integer);
begin
BinToHex(PAnsiChar(BinValue), HexValue, BinBufSize);
end;
procedure BinToHex(const BinValue; HexValue: PWideChar; BinBufSize: Integer);
begin
BinToHex(PAnsiChar(BinValue), HexValue, BinBufSize);
end;
function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;