Forum > Third party

BitHelpers - bit manipulation for standard pascal types

<< < (2/7) > >>

AlexTP:
New page:
http://wiki.freepascal.org/BitHelpers

avra:

--- Quote from: garlar27 on September 27, 2018, 05:02:33 pm ---Good job!!!
--- End quote ---
Thank you. You are very kind!  :D


--- Quote from: garlar27 on September 27, 2018, 05:02:33 pm ---The only cons I see from the examples (...) is the lack of configurable separators for nibbles and bytes in the ToBooleanString function...
--- End quote ---
Nice idea which will improve formatting customization. I don't promise nibbles separator, but I will put bytes separator on my TODO list.


--- Quote from: garlar27 on September 27, 2018, 05:02:33 pm ---...and configurable separators for each byte and "n" bytes in the ToHexString function.
--- End quote ---
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.


--- Quote from: garlar27 on September 27, 2018, 05:02:33 pm ---Other thing I needed back then was encoding numbers in a BCD string with a predetermined "endianness"
--- End quote ---
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.


--- Quote from: garlar27 on September 27, 2018, 05:02:33 pm ---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)
--- End quote ---
Use type casting to character. I do not feel that something like ByteToChar belongs to BitHelpers so I will not add it.


--- Quote from: lucamar 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?
--- End quote ---
You are probably right. Only booleans should have ToBooleanString, while other types should have ToBinaryString. If others agree, I will correct this.


--- Quote from: Alextp on September 27, 2018, 08:30:20 pm ---New page:
http://wiki.freepascal.org/BitHelpers
--- End quote ---
Thank you for the effort!  :)

440bx:

--- Quote from: avra on September 28, 2018, 03:17:07 pm ---You are probably right. Only booleans should have ToBooleanString, while other types should have ToBinaryString. If others agree, I will correct this.

--- End quote ---
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:
@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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---   function StrToHex(const S, Prefijo, Sufijo: string): string;   function StrToHex(S: string): string; {$IFnDEF D_BUG}inline;{$ENDIF}   function HexToStr(H: string): string;   function HexToBinStr(H: string): string; {$IFnDEF D_BUG}inline;{$ENDIF}   function ReplaceSpecialChars(const Buffer: string; const AStart, Prefix, Sufix, AnEnd: string; const ChangeEOL, ChangeTAB: Boolean;      const CharChangeOption: TCharChangeOption): string;   function ReplaceSpecialChars(const Buffer: string; const Prefix, Sufix: string; const ChangeEOLandTAB, ToHexa: Boolean): string;    function BufferToHexa_ASCII(const Buffer: string; const HexPrefix, HexSufix: string; const SpaceAsPoint: Boolean = FALSE; const LinesOffset: Integer = 0): string;   function BuffToH_A(const ABuff: string; const LinesOffset: Integer = 0): string; {$IFnDEF D_BUG}inline;{$ENDIF}   function SniffBuffer(const ABuffer: string; const HexPrefix, HexSufix: string; const SpaceAsPoint: Boolean = FALSE; const WithTitle: Boolean = TRUE; const LineOffset: Integer = 0): string;   function SniffBuffer(const ABuffer: string): string; implementation {________________________________________________________________________________________________________________________________ StrToHex }function StrToHex(const S, Prefijo, Sufijo: string): string;var   i: Integer;begin   Result := '';   for i := 1 to Length(S) do begin      Result := Result + Prefijo + hexStr(Ord(S[i]), 2) + Sufijo;   end; {<--- del for i }end; {<--- StrToHex }  {________________________________________________________________________________________________________________________________ StrToHex }function StrToHex(S: string): string;begin   Result := StrToHex(S, '', '');end; {<--- StrToHex }  {________________________________________________________________________________________________________________________________ HexToStr }function HexToStr(H: string): string;var   i: Integer;begin   Result := '';   if odd(Length(H)) then begin      Exit;   end;   for i := 1 to Length(H) div 2 do begin      Result := Result + Chr(Hex2Dec(H[(i * 2) -1] + H[i * 2]));   end; {<--- del for i }end; {<--- HexToStr }   {_____________________________________________________________________________________________________________________________ HexToBinStr }function HexToBinStr(H: string): string;begin   Result := StrToBin(HexToStr(H));end; {<--- HexToBinStr }   (* http://www.aivosto.com/vbtips/control-characters.htmlCharacter list*){_____________________________________________________________________________________________________________________ ReplaceSpecialChars }function ReplaceSpecialChars(const Buffer: string; const AStart, Prefix, Sufix, AnEnd: string; const ChangeEOL, ChangeTAB: Boolean;   const CharChangeOption: TCharChangeOption): string;var   i: Integer;   CambiarLF, CambiarCR: Boolean;    function ToH(const s: Char): string;   begin      case s of          #9 : if ChangeTAB then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;         #10 : if CambiarLF  then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;         #13 : if CambiarCR  then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;         //#32..#126: Result := s;         #127: Result := StrToHex(s, AStart + Prefix, Sufix + AnEnd);      else         Result := s;         //Result := StrToHex(s, AStart + Prefix, Sufix + AnEnd);      end;   end;   function ToD(const s: Char): string;   begin      case s of          #9 : if ChangeTAB then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;         #10 : if CambiarLF  then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;         #13 : if CambiarCR  then Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd else Result:= s;         //#32..#126: Result := s;         #127: Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd;      else         Result := s;         //Result := AStart + Prefix + IntToStr(Byte(s)) + Sufix + AnEnd;      end;   end;   function ToRS232(const s: Char): string;   begin      case s of          #0 : Result := AStart + '<NUL>'  + AnEnd;          #1 : Result := AStart + '<SOH>'  + AnEnd;          #2 : Result := AStart + '<STX>'  + AnEnd;          #3 : Result := AStart + '<ETX>'  + AnEnd;          #4 : Result := AStart + '<EOT>'  + AnEnd;          #5 : Result := AStart + '<ENQ>'  + AnEnd;          #6 : Result := AStart + '<ACK>'  + AnEnd;          #7 : Result := AStart + '<BEL>'  + AnEnd;          #8 : Result := AStart + '<BS>'   + AnEnd;          #9 : if ChangeTAB then Result := AStart + '<HT>' + AnEnd else Result:= s;         #10 : if CambiarLF  then Result := AStart + '<LF>' + AnEnd else Result:= s;         #11 : Result := AStart + '<VT>'   + AnEnd;         #12 : Result := AStart + '<FF>'   + AnEnd;         #13 : if CambiarCR  then Result := AStart + '<CR>' + AnEnd else Result:= s;         #14 : Result := AStart + '<SO>'   + AnEnd;         #15 : Result := AStart + '<SI>'   + AnEnd;         #16 : Result := AStart + '<DLE>'  + AnEnd;         #17 : Result := AStart + '<DC1>'  + AnEnd;         #18 : Result := AStart + '<DC2>'  + AnEnd;         #19 : Result := AStart + '<CD3>'  + AnEnd;         #20 : Result := AStart + '<DC4>'  + AnEnd;         #21 : Result := AStart + '<NAK>'  + AnEnd;         #22 : Result := AStart + '<SYN>'  + AnEnd;         #23 : Result := AStart + '<ETB>'  + AnEnd;         #24 : Result := AStart + '<CAN>'  + AnEnd;         #25 : Result := AStart + '<EM>'   + AnEnd;         #26 : Result := AStart + '<SUB>'  + AnEnd;         #27 : Result := AStart + '<ESC>'  + AnEnd;         #28 : Result := AStart + '<FS>'   + AnEnd;         #29 : Result := AStart + '<GS>'   + AnEnd;         #30 : Result := AStart + '<RS>'   + AnEnd;         #31 : Result := AStart + '<US>'   + AnEnd;         //#32..#126: Result := s;         #127: Result := AStart + '<DEL>'  + AnEnd;         #128..         #255: Result := AStart + '<$'+StrToHex(s)+'>'  + AnEnd;         //#128: Result := AStart + '<PAD>'  + AnEnd;         //#129: Result := AStart + '<HOP>'  + AnEnd;         //#130: Result := AStart + '<BPH>'  + AnEnd;         //#131: Result := AStart + '<NBH>'  + AnEnd;      else         //Result := AStart + Prefix + IntToStr(Byte(s){, 2}) + Sufix + AnEnd;         Result := s;      end;   end;begin   Result := '';   {$IFDEF UNIX}   CambiarLF := CambiarEOL and TRUE;   CambiarCR := CambiarEOL and TRUE;   {$ELSE}   CambiarLF := ChangeEOL and TRUE;   CambiarCR := ChangeEOL and TRUE;   {$ENDIF}   case CharChangeOption of      ccoHex      : begin for i := 1 to Length(Buffer) do begin Result := Result + ToH(Buffer[i])    ; end; end;      ccoDec      : begin for i := 1 to Length(Buffer) do begin Result := Result + ToD(Buffer[i])    ; end; end;      ccoRS232Name: begin for i := 1 to Length(Buffer) do begin Result := Result + ToRS232(Buffer[i]); end; end;      ccoASCIIName: begin for i := 1 to Length(Buffer) do begin Result := Result + ToRS232(Buffer[i]); end; end;   else      raise Exception.Create('Error inesperado al cambiar cadena en ReplaceSpecialChars.');   end;end; {<--- ReplaceSpecialChars }  {_____________________________________________________________________________________________________________________ ReplaceSpecialChars }function ReplaceSpecialChars(const Buffer: string; const Prefix, Sufix: string; const ChangeEOLandTAB, ToHexa: Boolean): string;   function ToH(const s: Char): string;   begin      Result := StrToHex(s, Prefix, Sufix);   end;   function ToD(const s: Char): string;   begin      Result := Prefix + IntToStr(Byte(s)) + Sufix;   end;begin   if ToHexa then begin      if ChangeEOLandTAB then begin         Result := StringsReplace(Buffer,            [#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],            [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),             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)],            [rfReplaceAll]);         end      else begin         Result := StringsReplace(Buffer,            [#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],            [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),             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)],            [rfReplaceAll]);      end;      end   else begin      if ChangeEOLandTAB then begin         Result := StringsReplace(Buffer,            [#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],            [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),             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)],            [rfReplaceAll]);         end      else begin         Result := StringsReplace(Buffer,            [#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],            [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),             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)],            [rfReplaceAll]);      end;   end;end; {<--- ReplaceSpecialChars }  {______________________________________________________________________________________________________________________ BufferToHexa_ASCII }function BufferToHexa_ASCII(const Buffer: string; const HexPrefix, HexSufix: string; const SpaceAsPoint: Boolean; const LinesOffset: Integer): string;var   AsccStr, HexaStr, ln: string;   a: Char;   b: Byte;   i, os_i: Integer;   NonPrintable: set of Byte;begin   Result  := '';   AsccStr := '';   HexaStr := '';   ln      := '';   a       := #0;   os_i    := 0;   NonPrintable      := [0..31,127..255];   if SpaceAsPoint then begin      NonPrintable := NonPrintable + [32];   end;   for i := 1 to Length(Buffer) do begin      a := Buffer[i];      b := Byte(a);      if b in NonPrintable then begin         AsccStr := AsccStr + '.';         end      else begin         AsccStr := AsccStr + a;      end;      HexaStr := HexaStr + HexPrefix + IntToHex(b, 2) + HexSufix;//' ';      case Length(AsccStr) of         8: begin            HexaStr := HexaStr + ' ';            AsccStr := AsccStr + ' ';         end;         17: begin            Result := Result + ln + PadLeft(IntToHex(os_i, 8), 8) + '| |' + HexaStr + '| |' + AsccStr + '|';            ln := LineEnding + PadLeft('|', LinesOffset);            os_i := os_i +16;            HexaStr := '';            AsccStr := '';         end;      end;   end;//} {<--- del for i }   if HexaStr <> ''  then begin      Result := Result + ln + PadLeft(IntToHex(os_i, 8), 8) + '| |' + PadRight(HexaStr, 49) + '| |' + PadRight(AsccStr, 17) + '|';   end;end; {<--- BufferToHexa_ASCII }  {_______________________________________________________________________________________________________________________________ BuffToH_A }function BuffToH_A(const ABuff: string; const LinesOffset: Integer): string;begin   Result := BufferToHexa_ASCII(ABuff, '', ' ', TRUE, LinesOffset);end; {<--- BuffToH_A }  {_____________________________________________________________________________________________________________________________ SniffBuffer }function SniffBuffer(const ABuffer: string; const HexPrefix, HexSufix: string; const SpaceAsPoint: Boolean; const WithTitle: Boolean;   const LineOffset: Integer): string;var   t : Integer;begin   t := (2 + Length(HexPrefix) + Length(HexSufix)) * 8;   Result := BufferToHexa_ASCII(ABuffer, HexPrefix, HexSufix);   if (Result <> '') and WithTitle then begin       Result := PadLeft('' , LineOffset) + PadRight(Format('| Buffer''s Length = %D', [Length(ABuffer)]), 81) + '|'+LineEnding              + PadLeft('' , LineOffset) + '| Offset | |0  .  .  .  4  .  .  .   8  .  .  .  C  .  .  F  | |0...4... 8...C..F|'+LineEnding              +                              '|--------| |'+ StringOfChar('-', t -1) + '||' + StringOfChar('-', t) + '| |-------- --------|'+LineEnding              + PadLeft('|', LineOffset) + Result + LineEnding              + '|=================================' + StringOfChar('=', t * 2 -1) + '|'+LineEnding;   end;end; {<--- SniffBuffer }  {_____________________________________________________________________________________________________________________________ SniffBuffer }function SniffBuffer(const ABuffer: string): string;begin   if Pos('<?xml', ABuffer) = 1 then begin      Result := ABuffer;      end   else begin      Result := SniffBuffer(ABuffer, '', ' ', TRUE, TRUE, 0);   end;end; {<--- SniffBuffer } 

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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---   function IntToBCDStr(const TheValue, TheDigits: QWord; const NonSignifficantZeros: Boolean = TRUE): string;   function BCDStrToBCD(const AValue: string): tBCD; {$IFnDEF D_BUG}inline;{$ENDIF}   function BCDStrToInt64(const AValue: string): Int64; {$IFnDEF D_BUG}inline;{$ENDIF}   function BCDStrToQWord(const AValue: string): QWord; {$IFnDEF D_BUG}inline;{$ENDIF}    function StrToBCDStr(const AValue: string): string;   function BCDDigitLengthToByteLength(const Ln: Integer): Integer; {$IFnDEF D_BUG}inline;{$ENDIF} implementation {_____________________________________________________________________________________________________________________________ IntToBCDStr }function IntToBCDStr(const TheValue, TheDigits: QWord; const NonSignifficantZeros: Boolean = TRUE): string;var   ABcd: tBCD;   a{scii}: Byte;   i, d{igits}, b{ytes}, p{recision}, o{ffset}: Integer;   s: shortstring;   e: Int64;begin   Result := '';   ABcd := TheValue;   s := '';   o := 0;   b := 0;    d := BCDDigitLengthToByteLength(TheDigits);   p := BCDDigitLengthToByteLength(ABcd.Precision);    if odd(ABcd.Precision) then begin      o := 2;      b := 1;      e := trunc(power(10, ABcd.Precision + o));      ABcd := e + TheValue;      end   else begin      e := 0;   end;// del if odd(ABcd.Precision)    s := '';    for i := Low(ABcd.Fraction) +b{} to p -1 +b do begin      a := ABcd.Fraction[i];      s := s + Char(a);   end; {<--- del for i }     case CompareValue(d, p) of      -1: begin         Result := RightStr(s, d);      end;      00: begin         Result := s;      end;      01: begin         if NonSignifficantZeros then begin            Result := StringOfChar(#0, d - p) + s;            end         else begin            Result := s;         end;      end;   end;end; {<--- IntToBCDStr }  {_____________________________________________________________________________________________________________________________ BCDStrToBCD }function BCDStrToBCD(const AValue: string): tBCD;//var i: Integer;begin   Result := BCDStrToInt64(AValue);//0;//   {for i := 1 to Length(AValue) do begin      Result.Fraction[i] := Byte(AValue[i]);   end;//}end; {<--- BCDStrToBCD }  {___________________________________________________________________________________________________________________________ BCDStrToInt64 }function BCDStrToInt64(const AValue: string): Int64;begin   Result := 0;   Result := StrToInt64(StrToHex(AValue));end; {<--- BCDStrToInt64 }  {___________________________________________________________________________________________________________________________ BCDStrToQWord }function BCDStrToQWord(const AValue: string): QWord;begin   Result := 0;   Result := StrToQWord(StrToHex(AValue));end; {<--- BCDStrToQWord }  {_____________________________________________________________________________________________________________________________ StrToBCDStr }function StrToBCDStr(const AValue: string): string;var   i: Integer;begin   Result := '';   for i := 1 to Length(AValue) do begin      Result := Result + IntToBCDStr(Byte(AValue[i]), 2);   end; {<--- del for i }end; {<--- StrToBCDStr }  {_________________________________________________________________________________________________________________ BCDDigitLengthToByteLength }function BCDDigitLengthToByteLength(const Ln: Integer): Integer;begin   if odd(Ln) then begin      Result := (Ln + 1) div 2;      end   else begin      Result := Ln div 2;   end;end; {<--- BCDDigitLengthToByteLength } 

VTwin:
Very nice, thanks! I had not considered such options for basic type helpers, good to know they are available.

Navigation

[0] Message Index

[#] Next page

[*] Previous page

Go to full version