All Projects FPC fpcprojects fpprofilerfpGUI Lazarus Packages PatchesLazarus CCR Mantis pas2js

View Issue Details

Jump to NotesJump to History
IDProjectCategoryView StatusDate SubmittedLast Update
0038150FPCRTLpublic2020-11-29 22:052020-12-02 19:35
ReporterBi0T1N Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityN/A
Status assignedResolutionopen 
Product 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 Revision
FPCOldBugId
FPCTarget
Attached Files

Relationships

related to 0038133 assignedMichael 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.

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