View Issue Details

IDProjectCategoryView StatusLast Update
0038712FPCRTLpublic2021-04-10 21:38
ReporterBi0T1N Assigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
Product Version3.3.1 
Summary0038712: [Patch] Implement HexToBin overloads for Delphi compatibility
DescriptionThe attached patch includes the overloads of HexToBin that Delphi does provide.
See http://docwiki.embarcadero.com/Libraries/Sydney/en/System.Classes.HexToBin
Additional Information1. Delphi fails at compiling two tests with: "E2251 Ambiguous overloaded call to 'HexToBin'" while FPC compiles them. I've just uncommented both as the result for the WideChar test is not correct. It seems that FPC favours AnsiString for both cases: @HexInputA[1] and @HexInputW[1].
2. Since the RTL also favours AnsiString and thus PChar=PAnsiChar but in Delphi PChar is PWideChar I've written the tests for $mode DelphiUnicode so that it yields the same results and thus also implemented the PChar version of HexToBin as PWideChar. (If you want to have it for PAnsiChar as well then it should be enough to change the header declaration and the local variable to PAnsiChar.)
3. Deprecates the function in Classes as in the patch for BinToHex (0038150)
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files

Activities

Bi0T1N

2021-04-07 15:15

reporter  

HexToBin_tests.pas (8,461 bytes)   
program HexToBin_tests;

{$IFDEF FPC}
  // PChar in Delphi is PWideChar so make sure the tests behave the same
  {$mode DelphiUnicode}
{$ENDIF}

uses
  SysUtils,
  {$IFDEF FPC}
    StrUtils
  {$ELSE}
    Classes
  {$ENDIF};

var
  BinValueBytes: TBytes;
  HexValueBytes: TBytes;
  HexInLen, BinBufLen: Integer;
  ret: Integer;

const
  HexInputA: AnsiString = '1decaf';
  HexInputW: WideString = '1decaf';
  HexCorruptInputW: WideString = '9abcdefg';
  HexOffsetInputW: WideString = '608da975';

begin
  writeln('start testing of HexToBin methods');

  {* test simple methods *}
  // ansistring
  // write 2 bytes into 1 byte
  HexInLen := Length(HexInputA) * SizeOf(AnsiChar) div 2;

(*
  // Delphi: E2251 Ambiguous overloaded call to 'HexToBin'
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(@HexInputA[1], @BinValueBytes[0], BinBufLen);
  if ret <> 3 then halt(1);
  if BinValueBytes[0] <> 29 then halt(1);
  if BinValueBytes[1] <> 236 then halt(1);
  if BinValueBytes[2] <> 175 then halt(1);
*)

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PChar(HexInputA), PChar(BinValueBytes), BinBufLen);
  if ret <> 0 then halt(2);
  if BinValueBytes[0] <> 0 then halt(2);
  if BinValueBytes[1] <> 0 then halt(2);
  if BinValueBytes[2] <> 0 then halt(2);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PAnsiChar(HexInputA), PAnsiChar(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(3);
  if BinValueBytes[0] <> 29 then halt(3);
  if BinValueBytes[1] <> 236 then halt(3);
  if BinValueBytes[2] <> 175 then halt(3);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PAnsiChar(HexInputA), Pointer(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(4);
  if BinValueBytes[0] <> 29 then halt(4);
  if BinValueBytes[1] <> 236 then halt(4);
  if BinValueBytes[2] <> 175 then halt(4);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PAnsiChar(HexInputA), BinValueBytes, BinBufLen);
  if ret <> 3 then halt(5);
  if BinValueBytes[0] <> 29 then halt(5);
  if BinValueBytes[1] <> 236 then halt(5);
  if BinValueBytes[2] <> 175 then halt(5);

  // widestring
  // write 4 bytes into 1 byte
  HexInLen := Length(HexInputW) * SizeOf(WideChar) div 4;

(*
  // Delphi: E2251 Ambiguous overloaded call to 'HexToBin'
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(@HexInputW[1], @BinValueBytes[0], BinBufLen);
  if ret <> 3 then halt(6);
  if BinValueBytes[0] <> 29 then halt(6);
  if BinValueBytes[1] <> 236 then halt(6);
  if BinValueBytes[2] <> 175 then halt(6);
*)

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexInputW), PAnsiChar(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(7);
  if BinValueBytes[0] <> 29 then halt(7);
  if BinValueBytes[1] <> 236 then halt(7);
  if BinValueBytes[2] <> 175 then halt(7);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexInputW), Pointer(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(8);
  if BinValueBytes[0] <> 29 then halt(8);
  if BinValueBytes[1] <> 236 then halt(8);
  if BinValueBytes[2] <> 175 then halt(8);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexInputW), BinValueBytes, BinBufLen);
  if ret <> 3 then halt(9);
  if BinValueBytes[0] <> 29 then halt(9);
  if BinValueBytes[1] <> 236 then halt(9);
  if BinValueBytes[2] <> 175 then halt(9);

  // not fully valid widestring input
  HexInLen := Length(HexCorruptInputW) * SizeOf(WideChar) div 4;
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexCorruptInputW), PAnsiChar(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(10);
  if BinValueBytes[0] <> 154 then halt(10);
  if BinValueBytes[1] <> 188 then halt(10);
  if BinValueBytes[2] <> 222 then halt(10);
  if BinValueBytes[4] <> 0 then halt(10);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexCorruptInputW), Pointer(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(11);
  if BinValueBytes[0] <> 154 then halt(11);
  if BinValueBytes[1] <> 188 then halt(11);
  if BinValueBytes[2] <> 222 then halt(11);
  if BinValueBytes[4] <> 0 then halt(11);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexCorruptInputW), BinValueBytes, BinBufLen);
  if ret <> 3 then halt(12);
  if BinValueBytes[0] <> 154 then halt(12);
  if BinValueBytes[1] <> 188 then halt(12);
  if BinValueBytes[2] <> 222 then halt(12);
  if BinValueBytes[4] <> 0 then halt(12);

  {* test complex offset methods *}
  // ansistring
  HexInLen := Length(HexInputA) div 2;

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PChar(HexInputA), 2, BinValueBytes, 2, BinBufLen);
  if ret <> 0 then halt(13);
  if BinValueBytes[0] <> 0 then halt(13);
  if BinValueBytes[1] <> 0 then halt(13);
  if BinValueBytes[2] <> 0 then halt(13);

  HexValueBytes := TEncoding.ASCII.GetBytes(HexInputA);
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(HexValueBytes, 2, BinValueBytes, 2, BinBufLen);
  if ret <> 2 then halt(14);
  if BinValueBytes[0] <> 0 then halt(14);
  if BinValueBytes[1] <> 0 then halt(14);
  if BinValueBytes[2] <> 236 then halt(14);

  // widestring
  HexInLen := Length(HexInputW) div 2;

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PChar(HexInputW), 2, BinValueBytes, 2, BinBufLen);
  if ret <> 2 then halt(15);
  if BinValueBytes[0] <> 0 then halt(15);
  if BinValueBytes[1] <> 0 then halt(15);
  if BinValueBytes[2] <> 236 then halt(15);

  HexValueBytes := TEncoding.ASCII.GetBytes(HexInputW);
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(HexValueBytes, 2, BinValueBytes, 2, BinBufLen);
  if ret <> 2 then halt(16);
  if BinValueBytes[0] <> 0 then halt(16);
  if BinValueBytes[1] <> 0 then halt(16);
  if BinValueBytes[2] <> 236 then halt(16);

  // documentation offset example
  HexInLen := Length(HexOffsetInputW) * SizeOf(WideChar) div 4;

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PChar(HexOffsetInputW), 4, BinValueBytes, 0, BinBufLen);
  if ret <> 2 then halt(17);
  if BinValueBytes[0] <> 169 then halt(17);
  if BinValueBytes[1] <> 117 then halt(17);
  if BinValueBytes[2] <> 0 then halt(17);
  if BinValueBytes[3] <> 0 then halt(17);

  HexValueBytes := TEncoding.ASCII.GetBytes(HexOffsetInputW);
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(HexValueBytes, 4, BinValueBytes, 0, BinBufLen);
  if ret <> 2 then halt(18);
  if BinValueBytes[0] <> 169 then halt(18);
  if BinValueBytes[1] <> 117 then halt(18);
  if BinValueBytes[2] <> 0 then halt(18);
  if BinValueBytes[3] <> 0 then halt(18);

  writeln('testing of HexToBin methods ended');
  readln;
end.
HexToBin_tests.pas (8,461 bytes)   
01-HexToBin_overloads.patch (7,350 bytes)   
diff --git packages/rtl-objpas/src/inc/strutils.pp packages/rtl-objpas/src/inc/strutils.pp
index 4e4a08a71f..d1ec00831a 100644
--- packages/rtl-objpas/src/inc/strutils.pp
+++ packages/rtl-objpas/src/inc/strutils.pp
@@ -234,7 +234,14 @@ procedure BinToHex(BinValue: PAnsiChar; HexValue: PAnsiChar; BinBufSize: Integer
 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 HexToBin(const HexText: PWideChar; HexTextOffset: Integer; var BinBuffer: TBytes; BinBufOffset: Integer; Count: Integer): Integer; overload;
+function HexToBin(const HexText: TBytes; HexTextOffset: Integer; var BinBuffer: TBytes; BinBufOffset: Integer; Count: Integer): Integer; overload;
+function HexToBin(HexText: PWideChar; BinBuffer: Pointer; BinBufSize: Integer): Integer; overload;
+function HexToBin(const HexText: PWideChar; var BinBuffer; BinBufSize: Integer): Integer; overload;
+function HexToBin(HexText: PAnsiChar; BinBuffer: PAnsiChar; BinBufSize: Integer): Integer; overload;
+function HexToBin(HexText: PWideChar; BinBuffer: PAnsiChar; BinBufSize: Integer): Integer; overload;
+function HexToBin(HexText: PAnsiChar; var BinBuffer; BinBufSize: Integer): Integer; overload;
+function HexToBin(const HexText: PAnsiChar; BinBuffer: Pointer; BinBufSize: Integer): Integer; overload;
 
 const
   DigitChars = ['0'..'9'];
@@ -3272,39 +3279,154 @@ begin
   BinToHex(PAnsiChar(BinValue), HexValue, BinBufSize);
 end;
 
+function HexToBin(const HexText: PWideChar; HexTextOffset: Integer; var BinBuffer: TBytes; BinBufOffset: Integer; Count: Integer): Integer;
+var
+  i : Integer;
+  PText : PWideChar;
+  PBinBuf : PAnsiChar;
+begin
+  PText:=HexText+HexTextOffset;
+  PBinBuf:=PAnsiChar(BinBuffer)+BinBufOffset;
+  i:=Count;
+  Result:=HexToBin(PText, PBinBuf, i);
+end;
+
+function HexToBin(const HexText: TBytes; HexTextOffset: Integer; var BinBuffer: TBytes; BinBufOffset: Integer; Count: Integer): Integer;
+var
+  i : Integer;
+  PText : PAnsiChar;
+  PBinBuf : PAnsiChar;
+begin
+  PText:=PAnsiChar(HexText)+HexTextOffset;
+  PBinBuf:=PAnsiChar(BinBuffer)+BinBufOffset;
+  i:=Count;
+  Result:=HexToBin(PText, PBinBuf, i);
+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
+function HexToBin(HexText: PWideChar; BinBuffer: Pointer; BinBufSize: Integer): Integer;
+begin
+  Result:=HexToBin(HexText, PAnsiChar(BinBuffer), BinBufSize);
+end;
 
-var i,j,h,l : integer;
+function HexToBin(const HexText: PWideChar; var BinBuffer; BinBufSize: Integer): Integer;
+begin
+  Result:=HexToBin(HexText, PAnsiChar(BinBuffer), BinBufSize);
+end;
 
+function HexToBin(HexText: PAnsiChar; BinBuffer: PAnsiChar; BinBufSize: Integer): Integer;
+const
+  LookUpTable1 : array ['0' .. '9'] of UInt8 = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9);
+  LookUpTable2 : array ['a' .. 'f'] of UInt8 = (10, 11, 12, 13, 14, 15);
+  LookUpTable3 : array ['A' .. 'F'] of UInt8 = (10, 11, 12, 13, 14, 15);
+var
+  i : integer;
+  num1,num2 : UInt8;
+  res : UInt8;
 begin
-  i:=binbufsize;
+  i:=BinBufSize;
   while (i>0) do
-    begin
-    if hexvalue^ IN ['A'..'F','a'..'f'] then
-      h:=((ord(hexvalue^)+9) and 15)
-    else if hexvalue^ IN ['0'..'9'] then
-      h:=((ord(hexvalue^)) and 15)
-    else
-      break;
-    inc(hexvalue);
-    if hexvalue^ IN ['A'..'F','a'..'f'] then
-      l:=(ord(hexvalue^)+9) and 15
-    else if hexvalue^ IN ['0'..'9'] then
-      l:=(ord(hexvalue^)) and 15
-    else
-      break;
-    j := l + (h shl 4);
-    inc(hexvalue);
-    binvalue^:=chr(j);
-    inc(binvalue);
+  begin
+    // get value of first character (1-byte)
+    case HexText^ of
+      '0'..'9':
+        num1:=LookUpTable1[HexText^];
+      'a'..'f':
+        num1:=LookUpTable2[HexText^];
+      'A'..'F':
+        num1:=LookUpTable3[HexText^];
+      else
+        break;
+    end;
+
+    inc(HexText);
+
+    // get value of second character (1-byte)
+    case HexText^ of
+      '0'..'9':
+        num2:=LookUpTable1[HexText^];
+      'a'..'f':
+        num2:=LookUpTable2[HexText^];
+      'A'..'F':
+        num2:=LookUpTable3[HexText^];
+      else
+        break;
+    end;
+
+    // map two byte values into one byte
+    res:=num2+(num1 shl 4);
+    BinBuffer^:=AnsiChar(res);
+    inc(BinBuffer);
+
+    inc(HexText);
     dec(i);
+  end;
+
+  Result:=BinBufSize-i;
+end;
+
+function HexToBin(HexText: PWideChar; BinBuffer: PAnsiChar; BinBufSize: Integer): Integer;
+const
+  LookUpTable1 : array ['0' .. '9'] of UInt8 = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9);
+  LookUpTable2 : array ['a' .. 'f'] of UInt8 = (10, 11, 12, 13, 14, 15);
+  LookUpTable3 : array ['A' .. 'F'] of UInt8 = (10, 11, 12, 13, 14, 15);
+var
+  i : integer;
+  num1,num2 : UInt8;
+  res : UInt8;
+begin
+  i:=BinBufSize;
+  while (i>0) do
+  begin
+    // 2-byte chars could use lower bits for another character
+    if (HexText^ > #255) then break;
+    // get value of first character (2-byte)
+    case HexText^ of
+      '0'..'9':
+        num1:=LookUpTable1[HexText^];
+      'a'..'f':
+        num1:=LookUpTable2[HexText^];
+      'A'..'F':
+        num1:=LookUpTable3[HexText^];
+      else
+        break;
     end;
-  result:=binbufsize-i;
+
+    inc(HexText);
+
+    // 2-byte chars could use lower bits for another character
+    if (HexText^ > #255) then break;
+    // get value of second character (2-byte)
+    case HexText^ of
+      '0'..'9':
+        num2:=LookUpTable1[HexText^];
+      'a'..'f':
+        num2:=LookUpTable2[HexText^];
+      'A'..'F':
+        num2:=LookUpTable3[HexText^];
+      else
+        break;
+    end;
+
+    // map four byte values into one byte
+    res:=num2+(num1 shl 4);
+    BinBuffer^:=AnsiChar(res);
+    inc(BinBuffer);
+
+    inc(HexText);
+    dec(i);
+  end;
+
+  Result:=BinBufSize-i;
+end;
+
+function HexToBin(HexText: PAnsiChar; var BinBuffer; BinBufSize: Integer): Integer;
+begin
+  Result:=HexToBin(HexText, PAnsiChar(BinBuffer), BinBufSize);
+end;
+
+function HexToBin(const HexText: PAnsiChar; BinBuffer: Pointer; BinBufSize: Integer): Integer;
+begin
+  Result:=HexToBin(HexText, PAnsiChar(BinBuffer), BinBufSize);
 end;
 
 function PosSetEx(const c: TSysCharSet; const s: ansistring; count: Integer): SizeInt;
diff --git rtl/objpas/classes/classesh.inc rtl/objpas/classes/classesh.inc
index b4df19c840..5f44d4cba4 100644
--- rtl/objpas/classes/classesh.inc
+++ rtl/objpas/classes/classesh.inc
@@ -2467,6 +2467,6 @@ procedure ObjectTextToResource(Input, Output: TStream);
 
 function LineStart(Buffer, BufPos: PChar): PChar;
 procedure BinToHex(BinValue, HexValue: PChar; BinBufSize: Integer); deprecated 'use procedures from unit StrUtils';
-function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer;
+function HexToBin(HexValue, BinValue: PChar; BinBufSize: Integer): Integer; deprecated 'use procedures from unit StrUtils';
 function ExtractStrings(Separators, WhiteSpace: TSysCharSet; Content: PChar; Strings: TStrings; AddEmptyStrings : Boolean = False): Integer;
 
01-HexToBin_overloads.patch (7,350 bytes)   

Thaddy de Koning

2021-04-08 21:06

reporter   ~0130182

Last edited: 2021-04-08 21:19

View 7 revisions

[quote] but in Delphi PChar is PWideChar[/quote]
This depends on the version and should only be valid in {$mode delphiunicode}
The Delphi modes are Delphi version dependend. {$mode Delphi} covers Ansi, {$mode delphiunicode} covers unicode delphi versions regarding the meaning of PChar.
BTW it is always better to specify what you mean. I always use PAnsiChar or PWideChar in my modern code, so I can compile for D7 like code and also for D2009+ like code.

You should review your patch with this information in mind.

Reason: D7 is still the most used Delphi version....

And in {$mode delphiunicode} PChar is already PWideChar, so the patch is superfluous.

Thaddy de Koning

2021-04-09 11:51

reporter   ~0130191

Last edited: 2021-04-09 11:56

View 2 revisions

Example:
{$mode DelphiUnicode}
var
  p:PChar = 'A';
begin
  writeln(sizeof(p^));
  readln;
end.

Results a size of 2, proof PChar is PWideChar in delphiunicode mode
Now if you change it to mode objfpc or mode delphi, the output is 1.

Bi0T1N

2021-04-09 13:43

reporter   ~0130194

@Thaddy
Thanks for telling me what I already knew and wrote above in the issue details. Seems you failed tremendous at testing my patch (obviously also at reading it) and playing around with the RTL. The StrUtls doesn't support Unicode yet and thus PChar is PAnsiChar (ask Michael, he can confirm it - I did) so you cannot simply use PChar in StrUtils if you don't want the behaviour of PChar=PAnsiChar.
Incredibly that anyone would consider Sven as toxic for the community, although the term suits you much better.

So please as you comment on a topic, keep the following in mind:
“If you can't say something nice, don't say nothing at all.”
- Thumper from Walt-Disney Bambi

Thaddy de Koning

2021-04-09 14:11

reporter   ~0130195

Last edited: 2021-04-09 14:12

View 2 revisions

You over estimate your capabilities. I was only explaining to you that your "proposed patch" is not applicable to the language. The bug is related only to the unit.
The language is fine. The unit is not. That goes for a lot more units that have no support yet.
(And I take offence to your reply. You should have rephrased the topic)

Thaddy de Koning

2021-04-09 14:13

reporter   ~0130196

It is not a language issue, it is an rtl issue.

Bi0T1N

2021-04-10 21:36

reporter   ~0130248

Last edited: 2021-04-10 21:38

View 2 revisions

Attached the tests for non-unicode Delphi ($mode Delphi) even if I can't test because no way to get a legal copy of it nowadays nor do I care about installing ancient software on modern systems...
HexToBin_tests_non_unicode.pas (8,699 bytes)   
program HexToBin_tests_non_unicode;

{$IFDEF FPC}
  // PChar in Delphi < 2009 is PAnsiChar so make sure the tests behave the same but actually almost none of the functions are available...
  {$mode Delphi}
{$ENDIF}

uses
  SysUtils,
  {$IFDEF FPC}
    StrUtils
  {$ELSE}
    Classes
  {$ENDIF};

var
  BinValueBytes: TBytes;
  HexValueBytes: TBytes;
  HexInLen, BinBufLen: Integer;
  ret: Integer;

const
  HexInputA: AnsiString = '1decaf';
  HexInputW: WideString = '1decaf';
  HexCorruptInputW: WideString = '9abcdefg';
  HexOffsetInputW: WideString = '608da975';

begin
  writeln('start testing of HexToBin methods');

  {* test simple methods *}
  // ansistring
  // write 2 bytes into 1 byte
  HexInLen := Length(HexInputA) * SizeOf(AnsiChar) div 2;

(*
  // Delphi: E2251 Ambiguous overloaded call to 'HexToBin'
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(@HexInputA[1], @BinValueBytes[0], BinBufLen);
  if ret <> 3 then halt(1);
  if BinValueBytes[0] <> 29 then halt(1);
  if BinValueBytes[1] <> 236 then halt(1);
  if BinValueBytes[2] <> 175 then halt(1);
*)

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PChar(HexInputA), PChar(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(2);
  if BinValueBytes[0] <> 29 then halt(2);
  if BinValueBytes[1] <> 236 then halt(2);
  if BinValueBytes[2] <> 175 then halt(2);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PAnsiChar(HexInputA), PAnsiChar(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(3);
  if BinValueBytes[0] <> 29 then halt(3);
  if BinValueBytes[1] <> 236 then halt(3);
  if BinValueBytes[2] <> 175 then halt(3);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PAnsiChar(HexInputA), Pointer(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(4);
  if BinValueBytes[0] <> 29 then halt(4);
  if BinValueBytes[1] <> 236 then halt(4);
  if BinValueBytes[2] <> 175 then halt(4);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PAnsiChar(HexInputA), BinValueBytes, BinBufLen);
  if ret <> 3 then halt(5);
  if BinValueBytes[0] <> 29 then halt(5);
  if BinValueBytes[1] <> 236 then halt(5);
  if BinValueBytes[2] <> 175 then halt(5);

  // widestring
  // write 4 bytes into 1 byte
  HexInLen := Length(HexInputW) * SizeOf(WideChar) div 4;

(*
  // Delphi: E2251 Ambiguous overloaded call to 'HexToBin'
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(@HexInputW[1], @BinValueBytes[0], BinBufLen);
  if ret <> 3 then halt(6);
  if BinValueBytes[0] <> 29 then halt(6);
  if BinValueBytes[1] <> 236 then halt(6);
  if BinValueBytes[2] <> 175 then halt(6);
*)

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexInputW), PAnsiChar(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(7);
  if BinValueBytes[0] <> 29 then halt(7);
  if BinValueBytes[1] <> 236 then halt(7);
  if BinValueBytes[2] <> 175 then halt(7);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexInputW), Pointer(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(8);
  if BinValueBytes[0] <> 29 then halt(8);
  if BinValueBytes[1] <> 236 then halt(8);
  if BinValueBytes[2] <> 175 then halt(8);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexInputW), BinValueBytes, BinBufLen);
  if ret <> 3 then halt(9);
  if BinValueBytes[0] <> 29 then halt(9);
  if BinValueBytes[1] <> 236 then halt(9);
  if BinValueBytes[2] <> 175 then halt(9);

  // not fully valid widestring input
  HexInLen := Length(HexCorruptInputW) * SizeOf(WideChar) div 4;
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexCorruptInputW), PAnsiChar(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(10);
  if BinValueBytes[0] <> 154 then halt(10);
  if BinValueBytes[1] <> 188 then halt(10);
  if BinValueBytes[2] <> 222 then halt(10);
  if BinValueBytes[4] <> 0 then halt(10);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexCorruptInputW), Pointer(BinValueBytes), BinBufLen);
  if ret <> 3 then halt(11);
  if BinValueBytes[0] <> 154 then halt(11);
  if BinValueBytes[1] <> 188 then halt(11);
  if BinValueBytes[2] <> 222 then halt(11);
  if BinValueBytes[4] <> 0 then halt(11);

  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PWideChar(HexCorruptInputW), BinValueBytes, BinBufLen);
  if ret <> 3 then halt(12);
  if BinValueBytes[0] <> 154 then halt(12);
  if BinValueBytes[1] <> 188 then halt(12);
  if BinValueBytes[2] <> 222 then halt(12);
  if BinValueBytes[4] <> 0 then halt(12);

  {* test complex offset methods *}
  // ansistring
  HexInLen := Length(HexInputA) div 2;
(*
  // only available as PWideChar in newer Delphi
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PChar(HexInputA), 2, BinValueBytes, 2, BinBufLen);
  if ret <> 0 then halt(13);
  if BinValueBytes[0] <> 0 then halt(13);
  if BinValueBytes[1] <> 0 then halt(13);
  if BinValueBytes[2] <> 0 then halt(13);
*)
  HexValueBytes := TEncoding.ASCII.GetBytes(HexInputA);
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(HexValueBytes, 2, BinValueBytes, 2, BinBufLen);
  if ret <> 2 then halt(14);
  if BinValueBytes[0] <> 0 then halt(14);
  if BinValueBytes[1] <> 0 then halt(14);
  if BinValueBytes[2] <> 236 then halt(14);

  // widestring
  HexInLen := Length(HexInputW) div 2;
(*
  // only available as PWideChar in newer Delphi
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PChar(HexInputW), 2, BinValueBytes, 2, BinBufLen);
  if ret <> 2 then halt(15);
  if BinValueBytes[0] <> 0 then halt(15);
  if BinValueBytes[1] <> 0 then halt(15);
  if BinValueBytes[2] <> 236 then halt(15);
*)
  HexValueBytes := TEncoding.ASCII.GetBytes(HexInputW);
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(HexValueBytes, 2, BinValueBytes, 2, BinBufLen);
  if ret <> 2 then halt(16);
  if BinValueBytes[0] <> 0 then halt(16);
  if BinValueBytes[1] <> 0 then halt(16);
  if BinValueBytes[2] <> 236 then halt(16);

  // documentation offset example
  HexInLen := Length(HexOffsetInputW) * SizeOf(WideChar) div 4;
(*
  // only available as PWideChar in newer Delphi
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(PChar(HexOffsetInputW), 4, BinValueBytes, 0, BinBufLen);
  if ret <> 2 then halt(17);
  if BinValueBytes[0] <> 169 then halt(17);
  if BinValueBytes[1] <> 117 then halt(17);
  if BinValueBytes[2] <> 0 then halt(17);
  if BinValueBytes[3] <> 0 then halt(17);
*)
  HexValueBytes := TEncoding.ASCII.GetBytes(HexOffsetInputW);
  SetLength(BinValueBytes, HexInLen);
  FillChar(BinValueBytes[0], Length(BinValueBytes), 0);
  BinBufLen := Length(BinValueBytes);
  ret := HexToBin(HexValueBytes, 4, BinValueBytes, 0, BinBufLen);
  if ret <> 2 then halt(18);
  if BinValueBytes[0] <> 169 then halt(18);
  if BinValueBytes[1] <> 117 then halt(18);
  if BinValueBytes[2] <> 0 then halt(18);
  if BinValueBytes[3] <> 0 then halt(18);

  writeln('testing of HexToBin methods ended');
  readln;
end.
HexToBin_tests_non_unicode.pas (8,699 bytes)   

Issue History

Date Modified Username Field Change
2021-04-07 15:15 Bi0T1N New Issue
2021-04-07 15:15 Bi0T1N File Added: HexToBin_tests.pas
2021-04-07 15:15 Bi0T1N File Added: 01-HexToBin_overloads.patch
2021-04-08 21:06 Thaddy de Koning Note Added: 0130182
2021-04-08 21:09 Thaddy de Koning Note Edited: 0130182 View Revisions
2021-04-08 21:12 Thaddy de Koning Note Edited: 0130182 View Revisions
2021-04-08 21:14 Thaddy de Koning Note Edited: 0130182 View Revisions
2021-04-08 21:16 Thaddy de Koning Note Edited: 0130182 View Revisions
2021-04-08 21:18 Thaddy de Koning Note Edited: 0130182 View Revisions
2021-04-08 21:19 Thaddy de Koning Note Edited: 0130182 View Revisions
2021-04-09 11:51 Thaddy de Koning Note Added: 0130191
2021-04-09 11:56 Thaddy de Koning Note Edited: 0130191 View Revisions
2021-04-09 13:43 Bi0T1N Note Added: 0130194
2021-04-09 14:11 Thaddy de Koning Note Added: 0130195
2021-04-09 14:12 Thaddy de Koning Note Edited: 0130195 View Revisions
2021-04-09 14:13 Thaddy de Koning Note Added: 0130196
2021-04-10 21:36 Bi0T1N Note Added: 0130248
2021-04-10 21:36 Bi0T1N File Added: HexToBin_tests_non_unicode.pas
2021-04-10 21:38 Bi0T1N Note Edited: 0130248 View Revisions