View Issue Details

IDProjectCategoryView StatusLast Update
0038150FPCRTLpublic2021-03-23 14:08
ReporterBi0T1N Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityN/A
Status closedResolutionfixed 
Product Version3.3.1 
Fixed in Version3.3.1 
Summary0038150: [Patch] Implement BinToHex overloads for Delphi compatibility
Description1. Add a deprecated message to the function in Strutils as it's also available in Classes (would fix one part of 0038133)
2. There is no need to increment and use binvalue as in the initial version because one could directly use i which is already incremented due to the for-loop
3. I'm unsure about the implementation of TBytes as the documentation of Delphi says: "You can call BinToHex with or without specifying an offset for the input string (TextOffset) or the output buffer (BufOffset). However, you must specify either both offsets or specify none of them."
Not sure if that means that both Offsets have to be != 0 - which wouldn't make sense as long as it doesn't result in an out-of-bounds read or write. Using a default value is also not possible because the parameter is in between other parameters, so I've no clue what they mean...
4. I've attached a test but I haven't Delphi so cannot test it there - feedback would be appreciated

Additional Informationhttp://docwiki.embarcadero.com/Libraries/Sydney/en/System.Classes.BinToHex
TagsNo tags attached.
Fixed in Revision48967
FPCOldBugId
FPCTarget4.0.0
Attached Files

Relationships

has duplicate 0038133 closedMichael Van Canneyt Duplicate function for HexToBin and BinToHex 

Activities

Bi0T1N

2020-11-29 22:05

reporter  

BinToHex_Overloads.patch (4,704 bytes)   
diff --git packages/rtl-objpas/src/inc/strutils.pp packages/rtl-objpas/src/inc/strutils.pp
index a84075f9b7..c2c45a6dc6 100644
--- packages/rtl-objpas/src/inc/strutils.pp
+++ packages/rtl-objpas/src/inc/strutils.pp
@@ -226,7 +226,7 @@ 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(BinValue, HexValue: PChar; BinBufSize: Integer); deprecated 'use procedures from unit Classes';
 function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
 
 const
diff --git rtl/objpas/classes/classesh.inc rtl/objpas/classes/classesh.inc
index 6d9c45d55a..9992e694b4 100644
--- rtl/objpas/classes/classesh.inc
+++ rtl/objpas/classes/classesh.inc
@@ -2466,7 +2466,13 @@ procedure ObjectTextToResource(Input, Output: TStream);
 { Utility routines }
 
 function LineStart(Buffer, BufPos: PChar): PChar;
-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;
 function ExtractStrings(Separators, WhiteSpace: TSysCharSet; Content: PChar; Strings: TStrings; AddEmptyStrings : Boolean = False): Integer;
 
diff --git rtl/objpas/classes/util.inc rtl/objpas/classes/util.inc
index ffd8916d61..6c3a4c603c 100644
--- rtl/objpas/classes/util.inc
+++ rtl/objpas/classes/util.inc
@@ -11,21 +11,66 @@
 
  **********************************************************************}
 
-procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
-Const
-  HexDigits='0123456789ABCDEF';
+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^) shr 4))];
-    HexValue[1]:=hexdigits[1+((ord(binvalue^) and 15))];
-    inc(hexvalue,2);
-    inc(binvalue);
-    end;
+  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;
 // more complex, have to accept more than bintohex
BinToHex_Overloads.patch (4,704 bytes)   
BinToHex_tests.pas (3,660 bytes)   
program BinToHex_tests;

{$IFDEF FPC}
  {$mode Delphi}
{$ENDIF}

uses
  SysUtils, Classes;

var
  BinByteArray: array[0..10] of Byte = (0, 2, 3, 7, 8, 10, 11, 12, 13, 14, 15);
  HexText: String;
  HexTextA: AnsiString;
  HexTextW: WideString;
  BinBytes, HexBytes: TBytes;

begin
  { mode dependent char }
  SetLength(HexText, Length(BinByteArray) * 2);
  BinToHex(@BinByteArray[0], PChar(HexText), Length(BinByteArray));
  if HexText <> '00020307080A0B0C0D0E0F' then halt(1);

  SetLength(HexText, Length(BinByteArray) * 2);
  BinToHex(Pointer(@BinByteArray[0]), PChar(HexText), Length(BinByteArray));
  if HexText <> '00020307080A0B0C0D0E0F' then halt(2);

  SetLength(HexText, Length(BinByteArray) * 2);
  BinToHex(@BinByteArray, PChar(HexText), Length(BinByteArray));
  if HexText <> '00020307080A0B0C0D0E0F' then halt(3);

  { ansichar variants }
  SetLength(HexTextA, Length(BinByteArray) * 2);
  BinToHex(@BinByteArray[0], PAnsiChar(HexTextA), Length(BinByteArray));
  if HexTextA <> '00020307080A0B0C0D0E0F' then halt(4);

  SetLength(HexTextA, Length(BinByteArray) * 2);
  BinToHex(Pointer(@BinByteArray[0]), PAnsiChar(HexTextA), Length(BinByteArray));
  if HexTextA <> '00020307080A0B0C0D0E0F' then halt(5);

  SetLength(HexTextA, Length(BinByteArray) * 2);
  BinToHex(@BinByteArray, PAnsiChar(HexTextA), Length(BinByteArray));
  if HexTextA <> '00020307080A0B0C0D0E0F' then halt(6);

  { widechar variants }
  SetLength(HexTextW, Length(BinByteArray) * 2);
  BinToHex(@BinByteArray[0], PWideChar(HexTextW), Length(BinByteArray));
  if HexTextW <> '00020307080A0B0C0D0E0F' then halt(7);

  SetLength(HexTextW, Length(BinByteArray) * 2);
  BinToHex(Pointer(@BinByteArray[0]), PWideChar(HexTextW), Length(BinByteArray));
  if HexTextW <> '00020307080A0B0C0D0E0F' then halt(8);

  SetLength(HexTextW, Length(BinByteArray) * 2);
  BinToHex(@BinByteArray, PWideChar(HexTextW), Length(BinByteArray));
  if HexTextW <> '00020307080A0B0C0D0E0F' then halt(9);

  { two char pointer variants }
  SetLength(HexTextA, Length(BinByteArray) * 2);
  BinToHex(PAnsiChar(@BinByteArray[0]), PAnsiChar(HexTextA), Length(BinByteArray));
  if HexTextA <> '00020307080A0B0C0D0E0F' then halt(10);

  SetLength(HexTextW, Length(BinByteArray) * 2);
  BinToHex(PAnsiChar(@BinByteArray), PWideChar(HexTextW), Length(BinByteArray));
  if HexTextW <> '00020307080A0B0C0D0E0F' then halt(11);

  { TBytes variants }
  BinBytes := TBytes.Create(1, 4, 5, 9, 10, 11, 12, 13, 14, 15);
  try
    SetLength(HexBytes, Length(BinBytes) * 2);
    FillByte(HexBytes[0], Length(HexBytes), 0);
    BinToHex(BinBytes, 0, HexBytes, 0, Length(BinBytes));
    if TEncoding.ANSI.GetString(HexBytes) <> '010405090A0B0C0D0E0F' then halt(12);

    SetLength(HexBytes, Length(BinBytes) * 2);
    FillByte(HexBytes[0], Length(HexBytes), Ord('a'));
    BinToHex(BinBytes, 2, HexBytes, 0, Length(BinBytes) - 2);
    if TEncoding.Default.GetString(HexBytes) <> '05090A0B0C0D0E0Faaaa' then halt(13);

    SetLength(HexBytes, Length(BinBytes) * 2);
    FillByte(HexBytes[0], Length(HexBytes), Ord('a'));
    BinToHex(BinBytes, 4, HexBytes, 2, Length(BinBytes) - 4);
    if TEncoding.Default.GetString(HexBytes) <> 'aa0A0B0C0D0E0Faaaaaa' then halt(14);

    SetLength(HexBytes, Length(BinBytes) * 2);
    FillByte(HexBytes[0], Length(HexBytes), Ord('a'));
    BinToHex(BinBytes, 0, HexBytes, 4, Length(BinBytes) - 2);
    if TEncoding.Default.GetString(HexBytes) <> 'aaaa010405090A0B0C0D' then halt(15);
  finally
    SetLength(HexBytes, 0);
    SetLength(BinBytes, 0);
  end;

  writeln('everything passed');
end.
BinToHex_tests.pas (3,660 bytes)   

Michael Van Canneyt

2020-11-29 22:35

administrator   ~0127265

I think Classes is probably the worst possible location for this function. It has nothing to do with classes.
SysUtils or StrUtils are better suited for this (which is why we have it there).

Unfortunately, if Delphi has it in Classes, we're pretty much forced to have it there as well,
and even more unfortunately, it can not depend on strutils because of how we organized the files,
or we could have it simply as an inline to the strutils version.

I'll think of how to solve this. I may still decide to put it in strutils.
Asking people to add strutils to their uses clause is not the worst thing.

Bi0T1N

2020-12-02 17:39

reporter   ~0127321

Last edited: 2020-12-02 17:43

View 3 revisions

I guess it's in classes because its useful for (debugging) streams. More useful than for strings - I mean how often do you convert binary string bits to hexadecimal strings? But converting some incoming data on e.g. a socket to its hexadecimal representation is a common praxis.
However, I believe we'll never know the real reason...

Thaddy de Koning

2020-12-02 19:24

reporter   ~0127323

Last edited: 2020-12-02 19:31

View 6 revisions

Note the helpers for integer types already support this? And can choose the correct size for the type? (I wrote them in part)
Like, part of the helpers:
    Function <intsize>.ToHexString: string; overload; inline; // for all integer types the correct size
    Function <intsize>ToHexString(const AMinDigits: Integer): string; overload; inline; // this was there already

It is in sysutils and that is the correct place imo. (syshelph, syshelp)
I also wrote the equivalent tobinstring with the correct size.

Thaddy de Koning

2020-12-02 19:35

reporter   ~0127324

I am not sure about Delphi, so maybe it should be examined anyway. But the functionality is there.

Michael Van Canneyt

2021-03-14 16:30

administrator   ~0129660

Last edited: 2021-03-14 16:30

View 2 revisions

Added to strutils, don't think classes.pas is the place for this.
Thanks for the patch.

Bi0T1N

2021-03-23 12:41

reporter   ~0129836

Wouldn't it be better to add the provided deprecated message to the function in Classes?


-procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer);
+procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer); deprecated 'use procedures from unit StrUtils';


Then the code duplication can be removed someday.

Michael Van Canneyt

2021-03-23 12:53

administrator   ~0129837

Added in rev. 49038.

Bi0T1N

2021-03-23 14:08

reporter   ~0129841

Thanks!

Issue History

Date Modified Username Field Change
2020-11-29 22:05 Bi0T1N New Issue
2020-11-29 22:05 Bi0T1N File Added: BinToHex_Overloads.patch
2020-11-29 22:05 Bi0T1N File Added: BinToHex_tests.pas
2020-11-29 22:31 Michael Van Canneyt Assigned To => Michael Van Canneyt
2020-11-29 22:31 Michael Van Canneyt Status new => assigned
2020-11-29 22:35 Michael Van Canneyt Note Added: 0127265
2020-11-29 22:36 Michael Van Canneyt Relationship added related to 0038133
2020-12-02 17:39 Bi0T1N Note Added: 0127321
2020-12-02 17:41 Bi0T1N Note Edited: 0127321 View Revisions
2020-12-02 17:43 Bi0T1N Note Edited: 0127321 View Revisions
2020-12-02 19:24 Thaddy de Koning Note Added: 0127323
2020-12-02 19:27 Thaddy de Koning Note Edited: 0127323 View Revisions
2020-12-02 19:28 Thaddy de Koning Note Edited: 0127323 View Revisions
2020-12-02 19:29 Thaddy de Koning Note Edited: 0127323 View Revisions
2020-12-02 19:30 Thaddy de Koning Note Edited: 0127323 View Revisions
2020-12-02 19:31 Thaddy de Koning Note Edited: 0127323 View Revisions
2020-12-02 19:35 Thaddy de Koning Note Added: 0127324
2021-03-14 16:30 Michael Van Canneyt Status assigned => resolved
2021-03-14 16:30 Michael Van Canneyt Resolution open => fixed
2021-03-14 16:30 Michael Van Canneyt Fixed in Version => 3.3.1
2021-03-14 16:30 Michael Van Canneyt Fixed in Revision => 48967
2021-03-14 16:30 Michael Van Canneyt FPCTarget => 4.0.0
2021-03-14 16:30 Michael Van Canneyt Note Added: 0129660
2021-03-14 16:30 Michael Van Canneyt Note Edited: 0129660 View Revisions
2021-03-14 16:42 Michael Van Canneyt Relationship replaced has duplicate 0038133
2021-03-23 12:41 Bi0T1N Status resolved => feedback
2021-03-23 12:41 Bi0T1N Resolution fixed => open
2021-03-23 12:41 Bi0T1N Note Added: 0129836
2021-03-23 12:53 Michael Van Canneyt Status feedback => resolved
2021-03-23 12:53 Michael Van Canneyt Resolution open => fixed
2021-03-23 12:53 Michael Van Canneyt Note Added: 0129837
2021-03-23 14:08 Bi0T1N Status resolved => closed
2021-03-23 14:08 Bi0T1N Note Added: 0129841