Recent

Author Topic: BitHelpers - bit manipulation for standard pascal types  (Read 1924 times)

avra

  • Hero Member
  • *****
  • Posts: 1376
    • Additional info
BitHelpers - bit manipulation for standard pascal types
« on: June 25, 2018, 10:20:17 am »
BitHelpers

BitHelpers enable additional bit manipulation for qword, longword, word, byte and boolean types which will make your life much easier if you need such a feature.

History

FreePascal type helpers TBooleanHelper, TByteHelper, TWordHelper, TCardinalHelper and TQWordHelper do not offer much when bit manipulation and presentation are needed. That's where BitHelpers package jumps in, nicely extending mentioned type helpers.

Installation

While you can simply copy bithelpers unit to your project directory and start using it, the recommended way would be to open bithelpers_pkg.lpk package and compile it. That would add BitHelpers source directory to Lazarus and make it available to all your projects.

Usage
  • TBooleanBitHelper example code and it's output: 
Code: [Select]
  uses
    bithelpers;
  ...
  procedure TForm1.BooleanBitTestBtnClick(Sender: TObject);
  var
    MyBool: boolean;
  begin
    MyBool := true;
    Memo1.Append(MyBool.ToOneZeroString);
    Memo1.Append(MyBool.ToOnOffString); // default is scfUnchangedCase and can be ommited
    Memo1.Append(MyBool.ToOnOffString(scfLowerCase));
    Memo1.Append(MyBool.ToTrueFalseString(scfUpperCase));
    Memo1.Append(MyBool.ToString('OnState', 'OffState')); // true/false custom strings
    Memo1.Append(MyBool.ToString('Укључено', 'Искључено', scfUpperCase)); // when case and unicode matter
  end;
Code: [Select]
  1
  On
  on
  TRUE
  OnState
  УКЉУЧЕНО

  • TByteBitHelper example code and it's output: 
Code: [Select]
  procedure TForm1.ByteBitTestBtnClick(Sender: TObject);
  var
    MyByte: byte;
  begin
    MyByte.Clear;                                  // %00000000 MyByte equals 0
    MyByte.Bit[0] := true;                         // %00000001 MyByte equals 1
    MyByte.Bit[2] := true;                         // %00000101 MyByte equals 5
    Memo1.Append(MyByte.ToString);
    Memo1.Append('$' + MyByte.ToHexString);
    Memo1.Append(MyByte.ToBooleanString(lzHideLeadingZeros));   // hide leading zeros
    Memo1.Append(MyByte.ToBooleanString);                       // show leading zeros   
  end;
Code: [Select]
  5
  $05
  101
  00000101

  • TWordBitHelper example code and it's output:
Code: [Select]
  procedure TForm1.WordBitTestBtnClick(Sender: TObject);
  var
    MyWord: word;
  begin
    MyWord.Clear;                  // %0000000000000000 MyWord equals 0
    MyWord.Byte[0] := 2;           // %0000000000000010 MyWord equals 2
    MyWord.Byte[1] := 1;           // %0000000100000010 MyWord equals 258 (2 + 256)
    MyWord.Byte[1].Bit[7] := true; // %0000000100000010 MyWord equals 258 (Beware!!! This DOES NOT set a bit in MyWord !!!)
    MyWord.Bit[10] := true;        // %0000010100000010 MyWord equals 1282 (258 + 2^10)
    Memo1.Append(MyWord.ToString);
    Memo1.Append('$' + MyWord.ToHexString);
    Memo1.Append(MyWord.ToBooleanString(lzHideLeadingZeros)); // hide leading zeros
    Memo1.Append(MyWord.ToBooleanString);                     // show leading zeros
  end;
Code: [Select]
  1282
  $0502
  10100000010
  0000010100000010

  • TLongwordBitHelper example code and it's output:
Code: [Select]
  procedure TForm1.LongwordBitTestBtnClick(Sender: TObject);
  var
    MyLongword: longword;
  begin
    MyLongword.Clear;                  // %00000000000000000000000000000000 MyLongword equals 0
    MyLongword.Word[0] := 250;         // %00000000000000000000000011111010 MyLongword equals 250
    MyLongword.Word[1].Byte[0] := 100; // %00000000000000000000000011111010 MyLongword equals 250 (Beware!!! This DOES NOT set a byte in MyLongword !!!)
    MyLongword.Byte[1] := 4;           // %00000000000000000000010011111010 MyLongword equals 1274 (250 + 2^(8 + 2), 2^2 = 4)
    MyLongword.Bit[26] := true;        // %00000100000000000000010011111010 MyLongword equals 67110138 (1274 + 2^26)
    Memo1.Append(MyLongword.ToString);
    Memo1.Append('$' + MyLongword.ToHexString);
    Memo1.Append(MyLongword.ToBooleanString(lzHideLeadingZeros)); // hide leading zeros
    Memo1.Append(MyLongword.ToBooleanString);                     // show leading zeros
    Memo1.Append('');
  end;
Code: [Select]
  67110138
  $040004FA
  100000000000000010011111010
  00000100000000000000010011111010

  • TQuadwordBitHelper example code and it's output:
Code: [Select]
  procedure TForm1.QuadwordBitTestBtnClick(Sender: TObject);
  var
    MyQuadword: qword;
  begin
    MyQuadword.Clear;                      // %0000000000000000000000000000000000000000000000000000000000000000 MyQuadword equals 0
    MyQuadword.Longword[0] := 12345;       // %0000000000000000000000000000000000000000000000000011000000111001 MyQuadword equals 12345
    MyQuadword.Longword[1].Word[0] := 100; // %0000000000000000000000000000000000000000000000000011000000111001 MyQuadword equals 12345 (Beware!!! This DOES NOT set a word in MyQuadword !!!)
    MyQuadword.Byte[3] := 2;               // %0000000000000000000000000000000000000010000000000011000000111001 MyQuadword equals 33566777 (12345 + 2^(8 + 8 + 8 + 2), 2^1 = 2)
    MyQuadword.Bit[50] := true;            // %0000000000000100000000000000000000000010000000000011000000111001  MyQuadword equals 1125899940409401 (33566777 + 2^50)
    Memo1.Append(MyQuadword.ToString);
    Memo1.Append('$' + MyQuadword.ToHexString);
    Memo1.Append(MyQuadword.ToBooleanString(lzHideLeadingZeros)); // hide leading zeros
    Memo1.Append(MyQuadword.ToBooleanString);                     // show leading zeros
  end;
Code: [Select]
  1125899940409401
  $0004000002003039
  100000000000000000000000010000000000011000000111001
  0000000000000100000000000000000000000010000000000011000000111001

  • TQuadwordOverlay, TLongwordOverlay, TWordOverlay and TByteOverlay variant records are also provided for qword, longword, word and byte. Sometimes they are more convenient to use then type helpers, and nothing stops you to mix them when needed. Here is an example code and it's output:
Code: [Select]
  procedure TForm1.OverlaysTestBtnClick(Sender: TObject);
  var
    MyQuadOverlay: TQuadwordOverlay;
  begin
    MyQuadOverlay.AsQuadword.Clear;
    MyQuadOverlay.AsByte[0] := 100;
    Memo1.Append(MyQuadOverlay.AsQuadword.ToBooleanString);
    MyQuadOverlay.AsLongword[1] := 1;
    Memo1.Append(MyQuadOverlay.AsQuadword.ToBooleanString);
    MyQuadOverlay.AsQuadword.Bit[32] := false;
    Memo1.Append(MyQuadOverlay.AsQuadword.ToBooleanString);
    MyQuadOverlay.AsWordOverlay[3].AsByte[1] := $FF; // recursive overlays are allowed
    Memo1.Append(MyQuadOverlay.AsQuadword.ToBooleanString);
    MyQuadOverlay.AsWord[3].Byte[1].Bit[5] := false; // NO CHANGE !!! Bit is set in a result byte, not in a byte that belongs to MyQuadOverlay
    Memo1.Append(MyQuadOverlay.AsQuadword.ToBooleanString);
    MyQuadOverlay.AsBit[63] := false;
    Memo1.Append(MyQuadOverlay.AsQuadword.ToBooleanString);
  end;
Code: [Select]
  0000000000000000000000000000000000000000000000000000000001100100
  0000000000000000000000000000000100000000000000000000000001100100
  0000000000000000000000000000000000000000000000000000000001100100
  1111111100000000000000000000000000000000000000000000000001100100
  1111111100000000000000000000000000000000000000000000000001100100
  0111111100000000000000000000000000000000000000000000000001100100


Download

https://bitbucket.org/avra/bithelpers


License

BitHelpers package is released under triple license:
« Last Edit: June 25, 2018, 03:52:44 pm by avra »
ct2laz - Conversion between Lazarus and CodeTyphon
bithelpers - Bit manipulation for standard types
pasettimino - Siemens S7 PLC lib

garlar27

  • Hero Member
  • *****
  • Posts: 540
Re: BitHelpers - bit manipulation for standard pascal types
« Reply #1 on: September 27, 2018, 05:02:33 pm »
Hi Avra!!
        Good job!!!

It's a shame not knowing about it 5-7 years ago, it would saved me a lot of time and I would be using it for sure!!!

The only cons I see from the examples (I haven't downloaded the package and didn't checked the full capacity either) is the lack of configurable separators for nibbles and bytes in the ToBooleanString function; and configurable separators for each byte and "n" bytes in the ToHexString function. I need those to ease the logs readability. For instance:
Code: Pascal  [Select]
  1. 11.24.03.019 - Rx-<STX><$97><NUL><NUL><FS><$C0><$81><FS>
  2. 11.24.03.028 - Rx-<FS><NUL><NUL><FS><ETX>024
  3. 11.24.03.037 - Rx-D
  4. 11.24.03.046 - Tx-<ACK>
  5. 11.24.03.055 -  //   ###   Received:  02 97 00 00 1C C0 81 1C 1C 00 00 1C 03 30 32 34 44
  6. 11.24.03.083 -  //   ###   Status 1: hex( 00 00); bin( 00000000 00000000)
  7. 11.24.03.091 -  //   ###   Status 2: hex( C0 81); bin( 11000000 10000001)
  8. 11.24.03.268 -  //   ###   command PrnTK_TKNC_Item() // Extension [ bin: 00000000 00110000;  Hex: 00 30]:
  9. 11.24.03.287 -  //   ###   string to send:  02 98 0A 1B 02 1C 00 30 1C 1C 1C 1C 1C 53 61 6C 61 6D 65 20 4D 69 6C 61 6E 20 70 69 65 7A 61 1C 31 30 30 30 30 1C 39 30 30 30 30 30 1C 32 31 30 30 1C 1C 1C 1C 1C 37 39 30 31 1C 30 30 1C 37 03 30 44 39 36
  10. 11.24.03.300 - Tx-<STX><$98><LF><ESC><STX><FS><NUL>0<FS><FS><FS><FS><FS>Salame Milan pieza<FS>10000<FS>900000<FS>2100<FS><FS><FS><FS><FS>7901<FS>00<FS>7<ETX>0D96
  11.  

Other thing I needed back then was encoding numbers in a BCD string with a predetermined "endianness" (which could be the same or different from the host PC) and send them to a server. What I did was not optimal but it worked  :-[ .
I also had problem to get the raw value of a number as i t is in memory to a string (for instance: a Byte = 65 converted to string should be "A" if I need it in LE).

It is not a formal feature request since I think I'm not going to use such features in the near future. And I don't know if such things are already implemented.
I used such things to communicate with hardware such like VeriFone PINPads and fiscal printers like Hasar and Epson. Also to communicate with VISA servers (that project was halted or in stand by just before try to comply with IPC standard).-


Thaddy

  • Hero Member
  • *****
  • Posts: 7178
Re: BitHelpers - bit manipulation for standard pascal types
« Reply #2 on: September 27, 2018, 05:18:30 pm »
Hi Avra!!
        Good job!!!

It's a shame not knowing about it 5-7 years ago, it would saved me a lot of time and I would be using it for sure!!!
Five to seven years ago this would not be possible with this syntax..
inline variables like in D10.3 are a bit like Brexit: if you are given the wrong information it sounds like a good idea. Every kid loves candy, but it makes you fat and your teeth will disappear.

lucamar

  • Sr. Member
  • ****
  • Posts: 491
Re: BitHelpers - bit manipulation for standard pascal types
« Reply #3 on: September 27, 2018, 05:57:48 pm »
Very nice. But ... something of a misname, ToBooleanString, isn't it? Shouldn't have been p.e. ToBinaryString? Or I may be missing something, of course  :D
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus 1.8.4/FPC 3.0.4 on:
(K)Ubuntu 11..16, Windows XP SP3 (Home/Prof.) and various DOS incarnations.

garlar27

  • Hero Member
  • *****
  • Posts: 540
Re: BitHelpers - bit manipulation for standard pascal types
« Reply #4 on: September 27, 2018, 07:58:48 pm »
Very nice. But ... something of a misname, ToBooleanString, isn't it? Shouldn't have been p.e. ToBinaryString? Or I may be missing something, of course  :D
I agree, but I think people who knows or usually work with assembler might not think the same.

Alextp

  • Hero Member
  • *****
  • Posts: 718
    • UVviewsoft

avra

  • Hero Member
  • *****
  • Posts: 1376
    • Additional info
Re: BitHelpers - bit manipulation for standard pascal types
« Reply #6 on: September 28, 2018, 03:17:07 pm »
Good job!!!
Thank you. You are very kind!  :D

The only cons I see from the examples (...) is the lack of configurable separators for nibbles and bytes in the ToBooleanString function...
Nice idea which will improve formatting customization. I don't promise nibbles separator, but I will put bytes separator on my TODO list.

...and configurable separators for each byte and "n" bytes in the ToHexString function.
I like the separator idea for each byte, but I am not sure that "n" bytes separator should end up in BitHelpers. My end goal is that BitHelpers become part of FreePascal. I do not know yet if more preferred way would be to include them as they are - or to embed them deeper with original root helpers for native types (then BitHelpers would not need to be included in unit's uses list at all). If BitHelpers get embedded more into FreePascal, then "n" bytes idea would be an overkill for that use. So, I will put only byte separator idea on my TODO list.

Other thing I needed back then was encoding numbers in a BCD string with a predetermined "endianness"
I feel that BCD conversion should not be part of BitHelpers, and that it should be done externally. I have also put quite an effort to keep "endianness" irrelevant for BitHelpers, and I would like to keep it that way: bits order is always with bit0 being least significant (look at Getbit method), and bytes/words/longwords are the same with bit0/word0/longword0 being least significant (look at type TByteOverlay, TWordOverlay, TLongwordOverlay and TQuadwordOverlay used by GetByte, GetWord and GetLongWord methods). Therefore I believe that BitHelpers should stay clean and endianess needs should be solved externally.

I also had problem to get the raw value of a number as i t is in memory to a string (for instance: a Byte = 65 converted to string should be "A" if I need it in LE)
Use type casting to character. I do not feel that something like ByteToChar belongs to BitHelpers so I will not add it.

Very nice. But ... something of a misname, ToBooleanString, isn't it? Shouldn't have been p.e. ToBinaryString?
You are probably right. Only booleans should have ToBooleanString, while other types should have ToBinaryString. If others agree, I will correct this.

New page:
http://wiki.freepascal.org/BitHelpers
Thank you for the effort!  :)
ct2laz - Conversion between Lazarus and CodeTyphon
bithelpers - Bit manipulation for standard types
pasettimino - Siemens S7 PLC lib

440bx

  • Sr. Member
  • ****
  • Posts: 386
Re: BitHelpers - bit manipulation for standard pascal types
« Reply #7 on: September 28, 2018, 04:16:30 pm »
You are probably right. Only booleans should have ToBooleanString, while other types should have ToBinaryString. If others agree, I will correct this.
Avra, I concur with everyone else, very nice job.   Thank you for your efforts and hard work.

I am also of the opinion that ToBinaryString would be more appropriate since it makes it clear there is no "logical" characteristic associated with the resulting string.


garlar27

  • Hero Member
  • *****
  • Posts: 540
Re: BitHelpers - bit manipulation for standard pascal types
« Reply #8 on: September 28, 2018, 05:40:03 pm »
@avra, I agree on your observations. Specially with keeping a clean code since a clean code is more maintainable.

I want to share some of my code. Hope someone find it useful. If some find a way to make it better or more flexible or fix something wrong, I'll be glad to know.  :D

The SniffBuffer (hex editor style) I use it log during development, mainly when I receive a long formatted string with fixed sized fields. I can count positions sizes and where the encoding is wrong and where de decoding didn't work as expected.
Code: Pascal  [Select]
  1.    function StrToHex(const S, Prefijo, Sufijo: string): string;
  2.    function StrToHex(S: string): string; {$IFnDEF D_BUG}inline;{$ENDIF}
  3.    function HexToStr(H: string): string;
  4.    function HexToBinStr(H: string): string; {$IFnDEF D_BUG}inline;{$ENDIF}
  5.    function ReplaceSpecialChars(const Buffer: string; const AStart, Prefix, Sufix, AnEnd: string; const ChangeEOL, ChangeTAB: Boolean;
  6.       const CharChangeOption: TCharChangeOption): string;
  7.    function ReplaceSpecialChars(const Buffer: string; const Prefix, Sufix: string; const ChangeEOLandTAB, ToHexa: Boolean): string;
  8.  
  9.    function BufferToHexa_ASCII(const Buffer: string; const HexPrefix, HexSufix: string; const SpaceAsPoint: Boolean = FALSE; const LinesOffset: Integer = 0): string;
  10.    function BuffToH_A(const ABuff: string; const LinesOffset: Integer = 0): string; {$IFnDEF D_BUG}inline;{$ENDIF}
  11.    function SniffBuffer(const ABuffer: string; const HexPrefix, HexSufix: string; const SpaceAsPoint: Boolean = FALSE; const WithTitle: Boolean = TRUE; const LineOffset: Integer = 0): string;
  12.    function SniffBuffer(const ABuffer: string): string;
  13.  
  14. implementation
  15.  
  16. {________________________________________________________________________________________________________________________________ StrToHex }
  17. function StrToHex(const S, Prefijo, Sufijo: string): string;
  18. var
  19.    i: Integer;
  20. begin
  21.    Result := '';
  22.    for i := 1 to Length(S) do begin
  23.       Result := Result + Prefijo + hexStr(Ord(S[i]), 2) + Sufijo;
  24.    end; {<--- del for i }
  25. end; {<--- StrToHex }
  26.  
  27.  
  28. {________________________________________________________________________________________________________________________________ StrToHex }
  29. function StrToHex(S: string): string;
  30. begin
  31.    Result := StrToHex(S, '', '');
  32. end; {<--- StrToHex }
  33.  
  34.  
  35. {________________________________________________________________________________________________________________________________ HexToStr }
  36. function HexToStr(H: string): string;
  37. var
  38.    i: Integer;
  39. begin
  40.    Result := '';
  41.    if odd(Length(H)) then begin
  42.       Exit;
  43.    end;
  44.    for i := 1 to Length(H) div 2 do begin
  45.       Result := Result + Chr(Hex2Dec(H[(i * 2) -1] + H[i * 2]));
  46.    end; {<--- del for i }
  47. end; {<--- HexToStr }
  48.  
  49.  
  50.  
  51. {_____________________________________________________________________________________________________________________________ HexToBinStr }
  52. function HexToBinStr(H: string): string;
  53. begin
  54.    Result := StrToBin(HexToStr(H));
  55. end; {<--- HexToBinStr }
  56.  
  57.  
  58.  
  59. (* http://www.aivosto.com/vbtips/control-characters.html
  60. Character list
  61. *)
  62. {_____________________________________________________________________________________________________________________ ReplaceSpecialChars }
  63. function ReplaceSpecialChars(const Buffer: string; const AStart, Prefix, Sufix, AnEnd: string; const ChangeEOL, ChangeTAB: Boolean;
  64.    const CharChangeOption: TCharChangeOption): string;
  65. var
  66.    i: Integer;
  67.    CambiarLF, CambiarCR: Boolean;
  68.  
  69.    function ToH(const s: Char): string;
  70.    begin
  71.       case s of
  72.           #9 : if ChangeTAB then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;
  73.          #10 : if CambiarLF  then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;
  74.          #13 : if CambiarCR  then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;
  75.          //#32..#126: Result := s;
  76.          #127: Result := StrToHex(s, AStart + Prefix, Sufix + AnEnd);
  77.       else
  78.          Result := s;
  79.          //Result := StrToHex(s, AStart + Prefix, Sufix + AnEnd);
  80.       end;
  81.    end;
  82.    function ToD(const s: Char): string;
  83.    begin
  84.       case s of
  85.           #9 : if ChangeTAB then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;
  86.          #10 : if CambiarLF  then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;
  87.          #13 : if CambiarCR  then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;
  88.          //#32..#126: Result := s;
  89.          #127: Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd;
  90.       else
  91.          Result := s;
  92.          //Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd;
  93.       end;
  94.    end;
  95.    function ToRS232(const s: Char): string;
  96.    begin
  97.       case s of
  98.           #0 : Result := AStart + '<NUL>'  + AnEnd;
  99.           #1 : Result := AStart + '<SOH>'  + AnEnd;
  100.           #2 : Result := AStart + '<STX>'  + AnEnd;
  101.           #3 : Result := AStart + '<ETX>'  + AnEnd;
  102.           #4 : Result := AStart + '<EOT>'  + AnEnd;
  103.           #5 : Result := AStart + '<ENQ>'  + AnEnd;
  104.           #6 : Result := AStart + '<ACK>'  + AnEnd;
  105.           #7 : Result := AStart + '<BEL>'  + AnEnd;
  106.           #8 : Result := AStart + '<BS>'   + AnEnd;
  107.           #9 : if ChangeTAB then Result := AStart + '<HT>' + AnEnd else Result:= s;
  108.          #10 : if CambiarLF  then Result := AStart + '<LF>' + AnEnd else Result:= s;
  109.          #11 : Result := AStart + '<VT>'   + AnEnd;
  110.          #12 : Result := AStart + '<FF>'   + AnEnd;
  111.          #13 : if CambiarCR  then Result := AStart + '<CR>' + AnEnd else Result:= s;
  112.          #14 : Result := AStart + '<SO>'   + AnEnd;
  113.          #15 : Result := AStart + '<SI>'   + AnEnd;
  114.          #16 : Result := AStart + '<DLE>'  + AnEnd;
  115.          #17 : Result := AStart + '<DC1>'  + AnEnd;
  116.          #18 : Result := AStart + '<DC2>'  + AnEnd;
  117.          #19 : Result := AStart + '<CD3>'  + AnEnd;
  118.          #20 : Result := AStart + '<DC4>'  + AnEnd;
  119.          #21 : Result := AStart + '<NAK>'  + AnEnd;
  120.          #22 : Result := AStart + '<SYN>'  + AnEnd;
  121.          #23 : Result := AStart + '<ETB>'  + AnEnd;
  122.          #24 : Result := AStart + '<CAN>'  + AnEnd;
  123.          #25 : Result := AStart + '<EM>'   + AnEnd;
  124.          #26 : Result := AStart + '<SUB>'  + AnEnd;
  125.          #27 : Result := AStart + '<ESC>'  + AnEnd;
  126.          #28 : Result := AStart + '<FS>'   + AnEnd;
  127.          #29 : Result := AStart + '<GS>'   + AnEnd;
  128.          #30 : Result := AStart + '<RS>'   + AnEnd;
  129.          #31 : Result := AStart + '<US>'   + AnEnd;
  130.          //#32..#126: Result := s;
  131.          #127: Result := AStart + '<DEL>'  + AnEnd;
  132.          #128..
  133.          #255: Result := AStart + '<$'+StrToHex(s)+'>'  + AnEnd;
  134.          //#128: Result := AStart + '<PAD>'  + AnEnd;
  135.          //#129: Result := AStart + '<HOP>'  + AnEnd;
  136.          //#130: Result := AStart + '<BPH>'  + AnEnd;
  137.          //#131: Result := AStart + '<NBH>'  + AnEnd;
  138.       else
  139.          //Result := AStart + Prefix + IntToStr(Byte(s){, 2}) + Sufix + AnEnd;
  140.          Result := s;
  141.       end;
  142.    end;
  143. begin
  144.    Result := '';
  145.    {$IFDEF UNIX}
  146.    CambiarLF := CambiarEOL and TRUE;
  147.    CambiarCR := CambiarEOL and TRUE;
  148.    {$ELSE}
  149.    CambiarLF := ChangeEOL and TRUE;
  150.    CambiarCR := ChangeEOL and TRUE;
  151.    {$ENDIF}
  152.    case CharChangeOption of
  153.       ccoHex      : begin for i := 1 to Length(Buffer) do begin Result := Result + ToH(Buffer[i])    ; end; end;
  154.       ccoDec      : begin for i := 1 to Length(Buffer) do begin Result := Result + ToD(Buffer[i])    ; end; end;
  155.       ccoRS232Name: begin for i := 1 to Length(Buffer) do begin Result := Result + ToRS232(Buffer[i]); end; end;
  156.       ccoASCIIName: begin for i := 1 to Length(Buffer) do begin Result := Result + ToRS232(Buffer[i]); end; end;
  157.    else
  158.       raise Exception.Create('Error inesperado al cambiar cadena en ReplaceSpecialChars.');
  159.    end;
  160. end; {<--- ReplaceSpecialChars }
  161.  
  162.  
  163. {_____________________________________________________________________________________________________________________ ReplaceSpecialChars }
  164. function ReplaceSpecialChars(const Buffer: string; const Prefix, Sufix: string; const ChangeEOLandTAB, ToHexa: Boolean): string;
  165.    function ToH(const s: Char): string;
  166.    begin
  167.       Result := StrToHex(s, Prefix, Sufix);
  168.    end;
  169.    function ToD(const s: Char): string;
  170.    begin
  171.       Result := Prefix + IntToStr(Byte(s)) + Sufix;
  172.    end;
  173. begin
  174.    if ToHexa then begin
  175.       if ChangeEOLandTAB then begin
  176.          Result := StringsReplace(Buffer,
  177.             [#0,#1,#2,#3,#4,#5,#6,#7,#8,#9,#10,#11,#12,#13,#14,#15,#16,#17,#18,#19,#20,#21,#22,#23,#24,#25,#26,#27,#28,#29,#30,#31,#127],
  178.             [ToH(#0),ToH(#1),ToH(#2),ToH(#3),ToH(#4),ToH(#5),ToH(#6),ToH(#7),ToH(#8),ToH(#9),ToH(#10),ToH(#11),ToH(#12),ToH(#13),ToH(#14),
  179.              ToH(#15),ToH(#16),ToH(#17),ToH(#18),ToH(#19),ToH(#20),ToH(#21),ToH(#22),ToH(#23),ToH(#24),ToH(#25),ToH(#26),ToH(#27),ToH(#28),ToH(#29),ToH(#30),ToH(#31),ToH(#127)],
  180.             [rfReplaceAll]);
  181.          end
  182.       else begin
  183.          Result := StringsReplace(Buffer,
  184.             [#0,#1,#2,#3,#4,#5,#6,#7,#8,#11,#12,#14,#15,#16,#17,#18,#19,#20,#21,#22,#23,#24,#25,#26,#27,#28,#29,#30,#31,#127],
  185.             [ToH(#0),ToH(#1),ToH(#2),ToH(#3),ToH(#4),ToH(#5),ToH(#6),ToH(#7),ToH(#8),ToH(#11),ToH(#12),ToH(#14),ToH(#15),ToH(#16),
  186.              ToH(#17),ToH(#18),ToH(#19),ToH(#20),ToH(#21),ToH(#22),ToH(#23),ToH(#24),ToH(#25),ToH(#26),ToH(#27),ToH(#28),ToH(#29),ToH(#30),ToH(#31),ToH(#127)],
  187.             [rfReplaceAll]);
  188.       end;
  189.       end
  190.    else begin
  191.       if ChangeEOLandTAB then begin
  192.          Result := StringsReplace(Buffer,
  193.             [#0,#1,#2,#3,#4,#5,#6,#7,#8,#9,#10,#11,#12,#13,#14,#15,#16,#17,#18,#19,#20,#21,#22,#23,#24,#25,#26,#27,#28,#29,#30,#31,#127],
  194.             [ToD(#0),ToD(#1),ToD(#2),ToD(#3),ToD(#4),ToD(#5),ToD(#6),ToD(#7),ToD(#8),ToD(#9),ToD(#10),ToD(#11),ToD(#12),ToD(#13),ToD(#14),
  195.              ToD(#15),ToD(#16),ToD(#17),ToD(#18),ToD(#19),ToD(#20),ToD(#21),ToD(#22),ToD(#23),ToD(#24),ToD(#25),ToD(#26),ToD(#27),ToD(#28),ToD(#29),ToD(#30),ToD(#31),ToD(#127)],
  196.             [rfReplaceAll]);
  197.          end
  198.       else begin
  199.          Result := StringsReplace(Buffer,
  200.             [#0,#1,#2,#3,#4,#5,#6,#7,#8,#11,#12,#14,#15,#16,#17,#18,#19,#20,#21,#22,#23,#24,#25,#26,#27,#28,#29,#30,#31,#127],
  201.             [ToD(#0),ToD(#1),ToD(#2),ToD(#3),ToD(#4),ToD(#5),ToD(#6),ToD(#7),ToD(#8),ToD(#11),ToD(#12),ToD(#14),ToD(#15),ToD(#16),
  202.              ToD(#17),ToD(#18),ToD(#19),ToD(#20),ToD(#21),ToD(#22),ToD(#23),ToD(#24),ToD(#25),ToD(#26),ToD(#27),ToD(#28),ToD(#29),ToD(#30),ToD(#31),ToD(#127)],
  203.             [rfReplaceAll]);
  204.       end;
  205.    end;
  206. end; {<--- ReplaceSpecialChars }
  207.  
  208.  
  209. {______________________________________________________________________________________________________________________ BufferToHexa_ASCII }
  210. function BufferToHexa_ASCII(const Buffer: string; const HexPrefix, HexSufix: string; const SpaceAsPoint: Boolean; const LinesOffset: Integer): string;
  211. var
  212.    AsccStr, HexaStr, ln: string;
  213.    a: Char;
  214.    b: Byte;
  215.    i, os_i: Integer;
  216.    NonPrintable: set of Byte;
  217. begin
  218.    Result  := '';
  219.    AsccStr := '';
  220.    HexaStr := '';
  221.    ln      := '';
  222.    a       := #0;
  223.    os_i    := 0;
  224.    NonPrintable      := [0..31,127..255];
  225.    if SpaceAsPoint then begin
  226.       NonPrintable := NonPrintable + [32];
  227.    end;
  228.    for i := 1 to Length(Buffer) do begin
  229.       a := Buffer[i];
  230.       b := Byte(a);
  231.       if b in NonPrintable then begin
  232.          AsccStr := AsccStr + '.';
  233.          end
  234.       else begin
  235.          AsccStr := AsccStr + a;
  236.       end;
  237.       HexaStr := HexaStr + HexPrefix + IntToHex(b, 2) + HexSufix;//' ';
  238.       case Length(AsccStr) of
  239.          8: begin
  240.             HexaStr := HexaStr + ' ';
  241.             AsccStr := AsccStr + ' ';
  242.          end;
  243.          17: begin
  244.             Result := Result + ln + PadLeft(IntToHex(os_i, 8), 8) + '| |' + HexaStr + '| |' + AsccStr + '|';
  245.             ln := LineEnding + PadLeft('|', LinesOffset);
  246.             os_i := os_i +16;
  247.             HexaStr := '';
  248.             AsccStr := '';
  249.          end;
  250.       end;
  251.    end;//} {<--- del for i }
  252.    if HexaStr <> ''  then begin
  253.       Result := Result + ln + PadLeft(IntToHex(os_i, 8), 8) + '| |' + PadRight(HexaStr, 49) + '| |' + PadRight(AsccStr, 17) + '|';
  254.    end;
  255. end; {<--- BufferToHexa_ASCII }
  256.  
  257.  
  258. {_______________________________________________________________________________________________________________________________ BuffToH_A }
  259. function BuffToH_A(const ABuff: string; const LinesOffset: Integer): string;
  260. begin
  261.    Result := BufferToHexa_ASCII(ABuff, '', ' ', TRUE, LinesOffset);
  262. end; {<--- BuffToH_A }
  263.  
  264.  
  265. {_____________________________________________________________________________________________________________________________ SniffBuffer }
  266. function SniffBuffer(const ABuffer: string; const HexPrefix, HexSufix: string; const SpaceAsPoint: Boolean; const WithTitle: Boolean;
  267.    const LineOffset: Integer): string;
  268. var
  269.    t : Integer;
  270. begin
  271.    t := (2 + Length(HexPrefix) + Length(HexSufix)) * 8;
  272.    Result := BufferToHexa_ASCII(ABuffer, HexPrefix, HexSufix);
  273.    if (Result <> '') and WithTitle then begin
  274.  
  275.       Result := PadLeft('' , LineOffset) + PadRight(Format('| Buffer''s Length = %D', [Length(ABuffer)]), 81) + '|'+LineEnding
  276.               + PadLeft('' , LineOffset) + '| Offset | |0  .  .  .  4  .  .  .   8  .  .  .  C  .  .  F  | |0...4... 8...C..F|'+LineEnding
  277.               +                              '|--------| |'+ StringOfChar('-', t -1) + '||' + StringOfChar('-', t) + '| |-------- --------|'+LineEnding
  278.               + PadLeft('|', LineOffset) + Result + LineEnding
  279.               + '|=================================' + StringOfChar('=', t * 2 -1) + '|'+LineEnding;
  280.    end;
  281. end; {<--- SniffBuffer }
  282.  
  283.  
  284. {_____________________________________________________________________________________________________________________________ SniffBuffer }
  285. function SniffBuffer(const ABuffer: string): string;
  286. begin
  287.    if Pos('<?xml', ABuffer) = 1 then begin
  288.       Result := ABuffer;
  289.       end
  290.    else begin
  291.       Result := SniffBuffer(ABuffer, '', ' ', TRUE, TRUE, 0);
  292.    end;
  293. end; {<--- SniffBuffer }
  294.  


Here some routines I use to read/write BCD strings (IMPORTANT: This might not work well on every case, it just worked well with what I needed back then. It is not prepared to work with floats nor negative values and who knows what else is missing)

Code: Pascal  [Select]
  1.    function IntToBCDStr(const TheValue, TheDigits: QWord; const NonSignifficantZeros: Boolean = TRUE): string;
  2.    function BCDStrToBCD(const AValue: string): tBCD; {$IFnDEF D_BUG}inline;{$ENDIF}
  3.    function BCDStrToInt64(const AValue: string): Int64; {$IFnDEF D_BUG}inline;{$ENDIF}
  4.    function BCDStrToQWord(const AValue: string): QWord; {$IFnDEF D_BUG}inline;{$ENDIF}
  5.  
  6.    function StrToBCDStr(const AValue: string): string;
  7.    function BCDDigitLengthToByteLength(const Ln: Integer): Integer; {$IFnDEF D_BUG}inline;{$ENDIF}
  8.  
  9. implementation
  10.  
  11. {_____________________________________________________________________________________________________________________________ IntToBCDStr }
  12. function IntToBCDStr(const TheValue, TheDigits: QWord; const NonSignifficantZeros: Boolean = TRUE): string;
  13. var
  14.    ABcd: tBCD;
  15.    a{scii}: Byte;
  16.    i, d{igits}, b{ytes}, p{recision}, o{ffset}: Integer;
  17.    s: shortstring;
  18.    e: Int64;
  19. begin
  20.    Result := '';
  21.    ABcd := TheValue;
  22.    s := '';
  23.    o := 0;
  24.    b := 0;
  25.  
  26.    d := BCDDigitLengthToByteLength(TheDigits);
  27.    p := BCDDigitLengthToByteLength(ABcd.Precision);
  28.  
  29.    if odd(ABcd.Precision) then begin
  30.       o := 2;
  31.       b := 1;
  32.       e := trunc(power(10, ABcd.Precision + o));
  33.       ABcd := e + TheValue;
  34.       end
  35.    else begin
  36.       e := 0;
  37.    end;// del if odd(ABcd.Precision)
  38.  
  39.    s := '';
  40.  
  41.    for i := Low(ABcd.Fraction) +b{} to p -1 +b do begin
  42.       a := ABcd.Fraction[i];
  43.       s := s + Char(a);
  44.    end; {<--- del for i }
  45.  
  46.  
  47.    case CompareValue(d, p) of
  48.       -1: begin
  49.          Result := RightStr(s, d);
  50.       end;
  51.       00: begin
  52.          Result := s;
  53.       end;
  54.       01: begin
  55.          if NonSignifficantZeros then begin
  56.             Result := StringOfChar(#0, d - p) + s;
  57.             end
  58.          else begin
  59.             Result := s;
  60.          end;
  61.       end;
  62.    end;
  63. end; {<--- IntToBCDStr }
  64.  
  65.  
  66. {_____________________________________________________________________________________________________________________________ BCDStrToBCD }
  67. function BCDStrToBCD(const AValue: string): tBCD;
  68. //var i: Integer;
  69. begin
  70.    Result := BCDStrToInt64(AValue);//0;//
  71.    {for i := 1 to Length(AValue) do begin
  72.       Result.Fraction[i] := Byte(AValue[i]);
  73.    end;//}
  74. end; {<--- BCDStrToBCD }
  75.  
  76.  
  77. {___________________________________________________________________________________________________________________________ BCDStrToInt64 }
  78. function BCDStrToInt64(const AValue: string): Int64;
  79. begin
  80.    Result := 0;
  81.    Result := StrToInt64(StrToHex(AValue));
  82. end; {<--- BCDStrToInt64 }
  83.  
  84.  
  85. {___________________________________________________________________________________________________________________________ BCDStrToQWord }
  86. function BCDStrToQWord(const AValue: string): QWord;
  87. begin
  88.    Result := 0;
  89.    Result := StrToQWord(StrToHex(AValue));
  90. end; {<--- BCDStrToQWord }
  91.  
  92.  
  93. {_____________________________________________________________________________________________________________________________ StrToBCDStr }
  94. function StrToBCDStr(const AValue: string): string;
  95. var
  96.    i: Integer;
  97. begin
  98.    Result := '';
  99.    for i := 1 to Length(AValue) do begin
  100.       Result := Result + IntToBCDStr(Byte(AValue[i]), 2);
  101.    end; {<--- del for i }
  102. end; {<--- StrToBCDStr }
  103.  
  104.  
  105. {_________________________________________________________________________________________________________________ BCDDigitLengthToByteLength }
  106. function BCDDigitLengthToByteLength(const Ln: Integer): Integer;
  107. begin
  108.    if odd(Ln) then begin
  109.       Result := (Ln + 1) div 2;
  110.       end
  111.    else begin
  112.       Result := Ln div 2;
  113.    end;
  114. end; {<--- BCDDigitLengthToByteLength }
  115.  


VTwin

  • Sr. Member
  • ****
  • Posts: 499
  • Former Turbo Pascal 3 user
Re: BitHelpers - bit manipulation for standard pascal types
« Reply #9 on: September 29, 2018, 02:34:27 am »
Very nice, thanks! I had not considered such options for basic type helpers, good to know they are available.
“Talk is cheap. Show me the code.” Linus Torvalds

Lazarus 2.1 svn trunk 59794: macOS 10.11.6 (64 bit Cocoa)
Lazarus 1.8.4: Win 7 (64 bit) & Ubuntu 16.04.3 (64 bit) on VBox

Alextp

  • Hero Member
  • *****
  • Posts: 718
    • UVviewsoft
Re: BitHelpers - bit manipulation for standard pascal types
« Reply #10 on: September 30, 2018, 09:16:44 am »
@author
feel free to edit Wiki text with new examples.

avra

  • Hero Member
  • *****
  • Posts: 1376
    • Additional info
Re: BitHelpers - bit manipulation for standard pascal types
« Reply #11 on: October 01, 2018, 09:41:36 am »
Very nice, thanks! I had not considered such options for basic type helpers, good to know they are available.
I am glad you like BitHelpers. It all started with a need to present the state of a boolean in my language, and to manipulate some bits inside of a word.

feel free to edit Wiki text with new examples.
After BitHelpers update I will. Thanks again!
« Last Edit: October 01, 2018, 09:44:16 am by avra »
ct2laz - Conversion between Lazarus and CodeTyphon
bithelpers - Bit manipulation for standard types
pasettimino - Siemens S7 PLC lib

avra

  • Hero Member
  • *****
  • Posts: 1376
    • Additional info
Re: BitHelpers - bit manipulation for standard pascal types
« Reply #12 on: November 19, 2018, 12:15:47 pm »
BitHelpers updated to 1.1.0.7

New feature:
Binary string format capability as promissed.

History:
1.0.0.0 First public version.
1.1.0.7 Renamed ToBooleanString() method into ToBinString(). It is more correct and more consistent naming in line with ToHexString() in SysUtils. Added DefaultHelperFormatSettings record, used by ToBinString() to put prefix, suffix, and separator strings for nibbles, bytes, words and longwords in result binary string (idea was borrowed from DefaultFormatSettings in SysUtils date and time format settings). Added optional THelperFormatSettings record parameter for ToBinString(), when temporary sufix/prefix/separators are preferred over changing global DefaultHelperFormatSettings. Expanded demo project with demonstration of using both default and temporary format settings in ToBinString().

Example for temporary format:
Code: Pascal  [Select]
  1.   procedure TForm1.TmpFormatBtnClick(Sender: TObject);
  2.   var
  3.     MyQuadWord: qword;
  4.     MyTmpFormat: THelperFormatSettings;
  5.   begin
  6.     MyQuadWord := 1125899940409401;
  7.  
  8.     MyTmpFormat.PrefixString      := '< ';
  9.     MyTmpFormat.SufixString       := ' >';
  10.     MyTmpFormat.ByteSeparator     := ' - ';
  11.     MyTmpFormat.WordSeparator     := ' = ';
  12.     MyTmpFormat.LongwordSeparator := '   ';
  13.     MyTmpFormat.NibbleSeparator   := '.';
  14.  
  15.     Memo1.Append('MyQuadword.ToBinString(MyTmpFormat, true);');
  16.     Memo1.Append(LineEnding + MyQuadword.ToBinString(MyTmpFormat, true)); // true is default so it can be ommited and leading zeros will still be shown
  17.     Memo1.Append('MyQuadword.Longword[1].ToBinString(MyTmpFormat);');
  18.     Memo1.Append(LineEnding + MyQuadword.Longword[1].ToBinString(MyTmpFormat)); // default true is ommited, show higher longword with leading zeros
  19.     Memo1.Append('MyQuadword.Word[3].ToBinString(MyTmpFormat, false);');
  20.     Memo1.Append(LineEnding + MyQuadword.Word[3].ToBinString(MyTmpFormat, false)); // show highest word without leading zeros
  21. end;
gives this output:
Quote
  MyQuadword.ToBinString(MyTmpFormat, true);
  < 0000.0000 - 0000.0100 = 0000.0000 - 0000.0000   0000.0010 - 0000.0000 = 0011.0000 - 0011.1001 >

  MyQuadword.Longword[1].ToBinString(MyTmpFormat);
  < 0000.0000 - 0000.0100 = 0000.0000 - 0000.0000 >

  MyQuadword.Word[3].ToBinString(MyTmpFormat, false);
  < 100 >

and example for permanent format:
Code: Pascal  [Select]
  1.   procedure TForm1.ChangeFormatBtnClick(Sender: TObject);
  2.   var
  3.     MyQuadWord: qword;
  4.   begin
  5.     MyQuadWord := 1125899940409401;
  6.  
  7.     // all DefaultHelperFormatSettings fields are empty strings by default, so we change them here:
  8.     DefaultHelperFormatSettings.PrefixString      := '{';
  9.     DefaultHelperFormatSettings.SufixString       := '}';
  10.     DefaultHelperFormatSettings.NibbleSeparator   := '_';
  11.     DefaultHelperFormatSettings.ByteSeparator     := '  ';
  12.     DefaultHelperFormatSettings.WordSeparator     := '  ' + Chr(39) + '  '; // single quote
  13.     DefaultHelperFormatSettings.LongwordSeparator := '  "  ';
  14.  
  15.     Memo1.Append(LineEnding + MyQuadword.ToBinString(true));
  16.     Memo1.Append(LineEnding + MyQuadword.Longword[1].ToBinString);
  17.     Memo1.Append(LineEnding + MyQuadword.Word[3].ToBinString(false));
  18.   end;
gives this output:
Quote
  {0000_0000  0000_0100  '  0000_0000  0000_0000  "  0000_0010  0000_0000  '  0011_0000  0011_1001}

  {0000_0000  0000_0100  '  0000_0000  0000_0000}

  {100}

Idea for DefaultHelperFormatSettings and THelperFormatSettings was borrowed from DefaultFormatSettings and TFormatSettings in SysUtils, something you should already be familiar with. Also, if BitHelpers get embedded into FPC then the same settings could be used for ToHexString() which would then be expanded to also support custom formatting.

EDIT: Just updated Wiki page.
« Last Edit: November 19, 2018, 12:42:07 pm by avra »
ct2laz - Conversion between Lazarus and CodeTyphon
bithelpers - Bit manipulation for standard types
pasettimino - Siemens S7 PLC lib