From 156b6cdf2d34620a093680380a692a4fd8e22006 Mon Sep 17 00:00:00 2001
From: marco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2>
Date: Fri, 19 Mar 2021 12:30:10 +0000
Subject: --- Merging r48967 into '.': 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: https://svn.freepascal.org/svn/fpc/branches/fixes_3_2@49009 3ad0048d-3df7-0310-abae-a5850022a9f2
---
 packages/rtl-objpas/src/inc/strutils.pp | 72 ++++++++++++++++++++++++++++++++-
 1 file changed, 71 insertions(+), 1 deletion(-)

diff --git a/packages/rtl-objpas/src/inc/strutils.pp b/packages/rtl-objpas/src/inc/strutils.pp
index 76592e4e05..beb7b96eb5 100644
--- a/packages/rtl-objpas/src/inc/strutils.pp
+++ b/packages/rtl-objpas/src/inc/strutils.pp
@@ -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;
-- 
cgit v1.2.1