Автор: Delirium
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Перегонка бинарного потока в строку с HEX-текстом и обратно

В модуле Classes существует базовая процедура BinToHex для преобразования
бинарного буфера в набор HEX-кодов (PChar to PChar), однако применительно
к потокам, работа с этой процедура требует дополнительных действий.
Я заточил эту задачу под потоки, попросту немного переработав классический код.

Зависимости: Classes
Автор:       Delirium, Master_BRAIN@beep.ru, ICQ:118395746, Москва
Copyright:   Master BARIN (Delirium)
Дата:        31 января 2003 г.
***************************************************** }

// Перегонка бинарного потока в строку с HEX-текстом

function StreamToHex(Buf: TStream): string;
const
  Convert: array[0..15] of Char = '0123456789ABCDEF';
var
  i, p: integer;
  B: byte;
begin
  SetLength(Result, Buf.Size * 2);
  p := Buf.Position;
  Buf.Position := 0;
  for i := 1 to Buf.Size do
  begin
    Buf.Read(B, 1);
    Result[(i * 2) - 1] := Convert[B shr $4];
    Result[(i * 2)] := Convert[B and $F];
  end;
  Buf.Position := p;
end;

// Перегонка строки с HEX-текстом в бинарный поток

procedure HexToStream(Hex: string; Buf: TStream);
const
  Convert: array['0'..'f'] of SmallInt =
  (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, -1, -1, -1, -1, -1, -1,
    -1, 10, 11, 12, 13, 14, 15, -1, -1, -1, -1, -1, -1, -1, -1, -1,
    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
    -1, 10, 11, 12, 13, 14, 15);
var
  i, p: integer;
  B: Byte;
begin
  if Buf.Size < Length(Hex) div 2 then
    Buf.Size := Length(Hex) div 2;
  p := Buf.Position;
  Buf.Position := 0;
  i := 1;
  while i <= Length(Hex) do
  begin
    if not (Hex[i] in ['0'..'f'])
      or not (Hex[i + 1] in ['0'..'f']) then
      Break;
    B := Byte((Convert[Hex[i]] shl 4) + Convert[Hex[i + 1]]);
    Buf.Write(B, 1);
    Inc(i, 2);
  end;
  Buf.Position := p;
end;

// Пример использования:
var
  St: TStream;
begin
  St := TMemoryStream.Create;
  Memo1.Lines.SaveToStream(St);
  Memo1.Text := StreamToHex(St);
  St.Destroy;
end;