BSOne.SFC/Tocsg.Lib/VCL/Tocsg.Hex.pas

{*******************************************************}
{                                                       }
{       Tocsg.Hex                                       }
{                                                       }
{       Copyright (C) 2022 Sunk                         }
{                                                       }
{*******************************************************}

unit Tocsg.Hex;

interface

uses
  System.Classes, System.SysUtils, Winapi.Windows;

function ConvBinToStr(pBuf: PAnsiChar; dwSize: DWORD): AnsiString;
function ConvBinToDelphiStr(pBuf: PAnsiChar; dwSize: DWORD): AnsiString;
function ConvStrToBin(str: String; var pBuf: TBytes): Integer;
function ConvStrToBinStream(const sBinStr: String; aStream: TStream): Boolean;
function ConvStrToBinStreamForce(sBinStr: String; aStream: TStream): Boolean;

procedure hexDump_to_list(pBuf: PBYTE; dwLen: DWORD; var lstDump: TStringList);

function PosBin(const pFind, pDestBuf: TBytes; nBeginOffset: Integer = 0): Integer;

implementation

uses
  Tocsg.Safe, Tocsg.Strings;

function ConvBinToStr(pBuf: PAnsiChar; dwSize: DWORD): AnsiString;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to dwSize - 1 do
    Result := Result + Format('%.2x', [Integer(pBuf[i])]);
end;

function ConvBinToDelphiStr(pBuf: PAnsiChar; dwSize: DWORD): AnsiString;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to dwSize - 1 do
    Result := Result + Format('$%.2x', [Integer(pBuf[i])]);
end;

// $뒤에 2자리까지 짤라서 리스트에 넣어준다.
function SplitHexToStringList(sText: String; var lstString: TStringList; bDelphiHex: Boolean): Integer;
var
  nPos  : Integer;
  sTemp : String;
begin
  lstString.Clear;

  Result := 0;

  if bDelphiHex then
  begin
    while sText <> '' do
      if sText[1] = '$' then
      begin
        sTemp := Copy(sText, 1, 3);
        lstString.Add(sTemp);
        Delete(sText, 1, 3);
        Inc(Result);
      end else begin
        nPos := Pos('$', sText);
        if nPos <> 0 then
        begin
          sTemp := Copy(sText, 1, nPos-1);
          lstString.Add(sTemp);
          Delete(sText, 1, Length(sTemp));
          Inc(Result, Length(sTemp));
        end else begin
          lstString.Add(sText);
          Inc(Result, Length(sText));
          break;
        end;
      end;
  end else begin
    while sText <> '' do
    begin
      sTemp := Copy(sText, 1, 2);
      lstString.Add(sTemp);
      Delete(sText, 1, 2);
      Inc(Result);
    end;
  end;
end;

function ConvStrToBin(str: String; var pBuf: TBytes): Integer;
var
  lstStr: TStringList;
  i: Integer;
begin
// c 스타일의 16진수 표시 문자 바꾸기
//  str := StringReplace(str, '\x', '$', [rfReplaceAll]);

// 길이가 짝수가 아니라면 맨앞에 0을 붙혀준다 14_1222 14:25:10 sunk
  if (Length(str) mod 2) <> 0 then
    str := '0' + str;

  Guard(lstStr, TStringList.Create);
  Result := SplitHexToStringList(str, lstStr, false);

  if Result <= 0 then
    exit;

//  pBuf := AllocMem(Result);
  SetLength(pBuf, Result);

  for i := 0 to lstStr.Count - 1 do
    pBuf[i] := StrToIntDef('$'+lstStr[i], 0);
end;

function ConvStrToBinStream(const sBinStr: String; aStream: TStream): Boolean;
var
  lstTemp: TStringList;
  i: Integer;
  arrBin: array of Byte;
begin
  Result := false;

  aStream.Size := 0;
  aStream.Position := 0;

  Guard(lstTemp, TStringList.Create);
  lstTemp.CommaText := sBinStr;
  SetLength(arrBin, lstTemp.Count);

  for i := 0 to lstTemp.Count - 1 do
    try
      arrBin[i] := StrToInt('$'+lstTemp[i]);
    except
      exit;
    end;

  aStream.Write(arrBin[0], Length(arrBin));

  Result := true;
end;

function ConvStrToBinStreamForce(sBinStr: String; aStream: TStream): Boolean;
var
  lstTemp: TStringList;
  i: Integer;
  pBuf: TBytes;
begin
  aStream.Size := 0;
  aStream.Position := 0;

  sBinStr := StringReplace(sBinStr, ' ', '', [rfReplaceAll]);
  sBinStr := InsertPointString(',', sBinStr, 2);

  Guard(lstTemp, TStringList.Create);
  lstTemp.CommaText := sBinStr;
  SetLength(pBuf, lstTemp.Count);

  for i := 0 to lstTemp.Count - 1 do
    pBuf[i] := StrToIntDef('$'+lstTemp[i], 0);

  aStream.Write(pBuf[0], Length(pBuf));

  Result := true;
end;

procedure hexDump_to_list(pBuf: PBYTE; dwLen: DWORD; var lstDump: TStringList);
var
  pStart,
  pEnd           : PBYTE;
  i, dwRemainder : DWORD;
  sLine          : String;
  b              : BYTE;
begin
// 시작과 끝을 잡아주고..
  pStart := pBuf;
  pEnd := PBYTE(LongInt(pBuf)+dwLen);

  dwRemainder := dwLen mod 16;

// 16Byte씩 보여주기
  while LongInt(pStart)+16 <= LongInt(pEnd) do
  begin
  // offset 출력
    sLine := Format('0x%.8x   ', [LongInt(pStart)-LongInt(pBuf)]);

  // 16Byte 단위로 내용출력
    for i := 0 to 15 do
    begin
      CopyMemory(@b, PBYTE(LongInt(pStart)+i), SizeOf(BYTE));
      sLine := sLine + Format('%.2x ', [Integer(b)]);
    end;

    sLine := sLine + '  ';

    for i := 0 to 15 do
    begin
      CopyMemory(@b, PBYTE(LongInt(pStart)+i), SizeOf(BYTE));
      if (Integer(b) >= 32) and (Integer(b) <= 125 )then
        sLine := sLine + Format('%s', [Char(b)])
      else
        sLine := sLine + '.';
    end;

    pStart := PBYTE(LongInt(pStart)+16);
    lstDump.Add(sLine);
  end;

// 나머지
  if dwRemainder > 0 then
  begin
  // offset 출력
    sLine := Format('0x%.8x  ', [LongInt(pStart)-LongInt(pBuf)]);

  // 16Byte 단위로 출력하고 남은 것 출력
    for i := 0 to 15 do
    begin
      CopyMemory(@b, PBYTE(LongInt(pStart)+i), SizeOf(BYTE));
      sLine := sLine + Format('%.2x ', [LongInt(pStart)+i]);
    end;

    for i := 0 to 155 - dwRemainder do
      sLine := sLine + '   ';

    sLine := sLine + ' ';
    for i := 0 to 15 do
    begin
      CopyMemory(@b, PBYTE(LongInt(pStart)+i), SizeOf(BYTE));
      if (Integer(b) >= 32) and (Integer(b) <= 125 )then
        sLine := sLine + Format('%s', [Char(b)])
      else
        sLine := sLine + '.';
    end;

    for i := 0 to 15 - dwRemainder do
      sLine := sLine + ' ';

    lstDump.Add(sLine)
  end;
end;

function PosBin(const pFind, pDestBuf: TBytes; nBeginOffset: Integer = 0): Integer;
var
  i, j, lp, ld: integer;
begin
  lp := Length(pFind);
  ld := Length(pDestBuf);
  Result := -1;
  if (lp > ld) or (nBeginOffset >= ld) then
    Exit;

  for i := nBeginOffset to ld-lp-1 do
  begin
    for j := 0 to lp -1 do
    begin
      if pFind[j] <> pDestBuf[i + j] then
        Break;

      if j = lp-1 then
        Result := i;
    end;

    if Result <> -1 then
      Break;
  end;
end;

end.