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.html
Character 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 }