(*#######################################################################################

UpdateLoader - Hilfsfunktionen & Datentypen

https://luani.de/

Copyright (C) 2012-2023 Leo-Andres Hofmann


This file is part of UpdateLoader.

UpdateLoader is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

UpdateLoader is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with UpdateLoader. If not, see <http://www.gnu.org/licenses/>.

#######################################################################################*)

unit tools;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
  Grids, ExtCtrls, Buttons, LCLType, LCLIntf, Registry, Windows;

resourcestring
  rsErrNoContent = 'Firmware-Datei enthält keine Einträge (%d Zeilen verarbeitet)';
  rsErrNoEOF = 'Firmware-Datei enthält keine Endmarkierung (%d Zeilen verarbeitet)';
  rsErrRecordDuplicate = 'Doppelter Eintrag, Speicherstelle $%.6x überschrieben (Zeile %d)';
  rsErrFileFormat = 'Ungültiges Dateiformat (kein Intel-Hex Record, Zeile %d)';
  rsErrRecordInvalid = 'Ungültiger oder nicht unterstützter Record-Typ "$%.2x" (Zeile %d)';
  rsErrRecordChecksum = 'Record-Prüfsumme üngültig (Zeile %d)';
  rsErrRecordLength = 'Datensatz-Länge abweichend von Record (%d <> %d) (Zeile %d)';
  rsErrTooLarge = 'Firmware größer als %s Pufferspeicher (Zeile %d)';

type
  TByteList = array of byte;
  TWireCount = (UNKNOWNWIRE, ONEWIRE, TWOWIRE);
  TFWKeyMode = (NOKEY, KEYONCE, KEYTENTH);
  TProgressbarStyle = (NOCHANGE, NORMAL, PAUSED, ERROR);

type
  TMemoryBuffer = class
    public
      const
        blankByte: byte = $FF;  //TODO: Als Parameter im Constructor?

    private
      var
        storage: array of byte;
        maxWrite: longint;
        dataValid: boolean;
        vclTag: integer;

      function getLocation(location: longint): byte;
      procedure setLocation(location: longint; data: byte);

      function getMin: longint;
      function getMax: longint;
      function getUsed: longint;

    public
      constructor Create(size: longint; clearOnCreate: boolean = true);
      destructor Destroy; override;

      procedure Clear;

      property Memory[location: longint]: byte read getLocation write setLocation;
      property Min: longint read getMin;
      property Max: longint read getMax;
      property TopWrite: longint read maxWrite;
      property Used: longint read getUsed;
      property Valid: boolean read dataValid write dataValid;
      property Tag: PtrInt read vclTag write vclTag;
  end;

function getComportCount: integer;
procedure getComportNames(portNames: TStrings);
procedure getBaudRates(baudRates: TStrings);     //Baudraten-Liste in Funktion festgelegt
function getComportFriendlyName(regKey: string; port: string): string;

procedure setProgressbarStyle(progressBar: TProgressBar; style: TProgressbarStyle = NOCHANGE; marquee: boolean = false);

procedure loadFirmwareFile(fileFQN: string; buffer: TMemoryBuffer; strictSyntax: boolean = true);
procedure createMemoryView(viewGrid: TStringGrid; buffer: TMemoryBuffer; progressBar: TProgressBar = nil);

function convertByteList2String(data: TByteList; insertSpace: boolean = false): string;
function convertByteList2HexString(data: TByteList; insertSpace: boolean = false): string;
function convertKiB2String(kib: longint; appendUnit: boolean = true): string;
function parseHexString(hex: string): AnsiString;

procedure addWithOverflow(var sum1: byte; sum2: byte);
procedure invertByte(var data: byte);

//Konstanten für ProgressBar Färbung (Normal/Pause/Fehler)
const
  PBM_SETSTATE = WM_USER + 16;
  PBM_GETSTATE = WM_USER + 17;
  PBST_NORMAL = $0001;
  PBST_ERROR = $0002;
  PBST_PAUSED = $0003;

////////////////////////////////////////////////////////////////////////////////
implementation

uses
  Protocol, RegExpr, i18n;

{$REGION 'TMemoryBuffer'}
constructor TMemoryBuffer.Create(size: longint; clearOnCreate: boolean = true);
begin
  inherited Create;

  SetLength(self.storage, size);
  self.maxWrite := 0;
  self.Valid := false;
  self.Tag := 0;

  if clearOnCreate then
    self.Clear;
end;

destructor TMemoryBuffer.Destroy;
begin
  self.Clear;

  inherited;
end;

function TMemoryBuffer.getLocation(location: longint): byte;
begin
  if (location < self.Min) or (location > self.Max) then
     raise Exception.CreateFmt('Index out of bounds (%d< %d < %d)', [self.Min, location, self.Max]);

  Result := self.storage[location];
end;

procedure TMemoryBuffer.setLocation(location: longint; data: byte);
begin
  if (location < self.Min) or (location > self.Max) then
     raise Exception.CreateFmt('Index out of bounds (%d< %d < %d)', [self.Min, location, self.Max]);

  self.storage[location] := data;

  if self.maxWrite < location then
     self.maxWrite := location;
end;

function TMemoryBuffer.getMin: longint;
begin
  Result := low(storage);
end;

function TMemoryBuffer.getMax: longint;
begin
  Result := high(storage);
end;

function TMemoryBuffer.getUsed: longint;
begin
  Result := succ(topWrite);
end;

procedure TMemoryBuffer.Clear;
var
  location: longint;
begin
  for location := self.Min to self.Max do
    self.storage[location] := blankByte;

  self.maxWrite := 0;
  self.dataValid := false;
end;
{$ENDREGION}

{$REGION 'Com-Ports & Baudraten auflisten'}
function portIndexCompare(List: TStringList; Index1, Index2: Integer): Integer;
begin
  if integer(List.Objects[Index1]) < integer(List.Objects[Index2]) then
    Result := -1
  else if integer(List.Objects[Index1]) > integer(List.Objects[Index2]) then
    Result := 1
  else
    Result := 0;
end;

function getComportCount: integer;
var
  registry: TRegistry;
  keyInfo: TRegKeyInfo;
begin
  Result := -1;
  registry := TRegistry.Create;

  try
    registry.RootKey := HKEY_LOCAL_MACHINE;
    if registry.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM') then
    begin
      registry.GetKeyInfo(keyInfo);
      Result := keyInfo.NumValues;
    end;
  finally
    registry.CloseKey;
    registry.Free;
  end;
end;

procedure getComportNames(portNames: TStrings);
var
  registry: TRegistry;
  regKeyList, portNameList: TStringList;
  portKey: string;
  portName, nameString:string;
  nameLength: integer;
  friendlyName: string;
  portIndex: integer;
  indexRegex: TRegExpr;
begin
  assert(assigned(portNames), 'portNames not assigned');

  registry := TRegistry.Create(KEY_READ or $0100);
  regKeyList := TStringList.Create;
  portNameList := TStringList.Create;
  indexRegex := TRegExpr.Create;

  indexRegex.Expression := 'COM\s*?(0*[1-9][0-9]*)'; //Portnummer "1" aus "COM1" lesen

  regKeyList.Clear;
  portNameList.Clear;

  portNames.BeginUpdate;
  try
    portNames.Clear;

    registry.Access := KEY_READ;
    registry.RootKey := HKEY_LOCAL_MACHINE;
    if registry.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM') then
    begin
      registry.GetValueNames(regKeyList);

      for portKey in regKeyList do
      begin
        nameLength := registry.GetDataSize(portKey);
        nameString := registry.ReadString(portKey);

        //Nicht terminierte Strings abfangen
        setlength(portName, nameLength + 1);
        fillChar(portName[1], nameLength + 1, #0);
        move(nameString[1], portName[1], nameLength);
        portName := trim(portName);

        friendlyName := getComportFriendlyName('\SYSTEM\CurrentControlSet\Enum\', portName);
        indexRegex.Exec(portName);

        if not TryStrToInt(indexRegex.Match[1], portIndex) then
           Continue;

        if friendlyName <> '' then
          portNameList.AddObject(Format('COM %d: %s', [portIndex, friendlyName]), TObject(portIndex))
        else
          portNameList.AddObject(Format('COM %d', [portIndex]), TObject(portIndex));
      end;

      portNameList.CustomSort(@portIndexCompare);
      portNames.Assign(portNameList);
    end;
  finally
    registry.CloseKey;

    registry.Free;
    regKeyList.Free;
    portNameList.Free;
    indexRegex.Free;

    portNames.EndUpdate;
  end;
end;

function getComportFriendlyName(regKey: string; port: string): string;
var
  registry: TRegistry;
  keyNameList: TStringList;
  keyName, currentKey: string;
  friendlyName: string;
  foundKeyIn: string;
begin
  assert((regKey <> '') and (port <> ''), 'invalid/empty parameter');

  Result := '';
  registry := TRegistry.Create;
  keyNameList := TStringList.Create;

  keyNameList.Clear;

  registry.RootKey := HKEY_LOCAL_MACHINE;
  registry.OpenKeyReadOnly(regKey);
  registry.GetKeyNames(keyNameList);
  registry.CloseKey;

  try
    for keyName in keyNameList do
    begin
      currentKey := regKey + keyName + '\';

      if registry.OpenKeyReadOnly(currentKey + 'Device Parameters') then
      begin
        if registry.ReadString('PortName') = port then
        begin
          registry.CloseKey;
          registry.OpenKeyReadOnly(currentKey);
          friendlyName := SysToUTF8(registry.ReadString('FriendlyName'));
          registry.CloseKey;

          foundKeyIn := copy(currentKey, 32, length(currentKey) - 32);
          foundKeyIn := copy(foundKeyIn, 0, pos('\', foundKeyIn) - 1);

          if foundKeyIn <> '' then
            friendlyName := friendlyName + ' - (' + foundKeyIn + ')';

          Break;
        end;
      end
      else
      begin
        if registry.OpenKeyReadOnly(currentKey) and registry.HasSubKeys then
        begin
          friendlyName := getComportFriendlyName(currentKey, port);
          registry.CloseKey;
          if friendlyName <> '' then
            Break;
        end;
      end;
    end;

    Result := friendlyName;
  finally
    registry.CloseKey;

    registry.Free;
    keyNameList.Free;
  end;
end;

procedure getBaudrates(baudrates: TStrings);
const
  availableBaudrates: array[0..8] of integer = (4800, 9600, 14400, 19200, 28800, 38400, 57600, 115200, 128000);
var
  baudrateList: TStringList;
  value: integer;
begin
  assert(assigned(baudrates), 'baudrates not assigned');

  baudrateList := TStringList.Create;
  baudrateList.Clear;

  baudrates.BeginUpdate;
  try
    baudrates.Clear;

    for value in availableBaudrates do
      baudrateList.AddObject(IntToStr(value), TObject(value));

    baudrates.Assign(baudrateList);
  finally
    baudrateList.Free;

    baudrates.EndUpdate;
  end;
end;
{$ENDREGION}

{$REGION 'GUI Hilfsfunktionen'}
procedure setProgressbarStyle(progressBar: TProgressBar; style: TProgressbarStyle = NOCHANGE; marquee: boolean = false);
begin
  assert(assigned(progressBar), 'progressBar not assigned');

  if marquee then
    progressBar.Style := pbstMarquee
  else
    progressBar.Style := pbstNormal;

  case style of
    NORMAL:
      progressBar.Perform(PBM_SETSTATE, PBST_NORMAL, 0);
    PAUSED:
      progressBar.Perform(PBM_SETSTATE, PBST_PAUSED, 0);
    ERROR:
      progressBar.Perform(PBM_SETSTATE, PBST_ERROR, 0);
    else;
  end;
end;
{$ENDREGION}

{$REGION 'Hex-Datei anzeigen und auslesen'}
procedure loadFirmwareFile(fileFQN: string; buffer: TMemoryBuffer; strictSyntax: boolean = true);
var
  fwFile: TStringList;           //Hex-Datei (zeilenweise)
  fwFileEnum: TStringsEnumerator;
  fwEOF: boolean;
  lineNum: integer;              //Zeilennummer Hex-Datei
  lineParser: TRegExpr;          //Regulärer Ausdruck zum Zerlegen der Records

  recordType: byte;              //Record-Typ 00-05
  address, segmentAddress: word; //Record- und Segment-Adresse (siehe Record-Typ 02)
  byteCount, checksum: byte;     //Nutzdaten-Länge und Zeilenprüfsumme

  memoryLocation: longint;       //Berechnete Speicherstelle im internen Puffer
  data, offset: byte;            //Datenbyte aus Hex-Datei, Offset in Zeile
  dataSum: byte;                 //Quersumme über alle Bytes im Record (überlaufend)
begin
  assert(fileFQN <> '', 'fileFQN empty');
  assert(assigned(buffer), 'buffer not assigned');

  if not FileExistsUTF8(fileFQN) then
    raise Exception.Create(rsErrFileMissing);

  buffer.Clear;
  fwFile := TStringList.Create;

  fwEOF := false;
  lineNum := 1;
  lineParser := TRegExpr.Create;
  lineParser.Expression := '^:([\dA-F]{2})([\dA-F]{4})(0[0-5])(([\dA-F]{2})*)([\dA-F]{2})$';

  segmentAddress := 0;

  try
    fwFile.LoadFromFile(UTF8toAnsi(fileFQN));
    fwFileEnum := fwFile.GetEnumerator;

    while (fwFileEnum.MoveNext) and (not fwEOF) do
    begin
      if not lineParser.Exec(AnsiUpperCase(fwFileEnum.GetCurrent)) then
        raise Exception.CreateFmt(rsErrFileFormat, [lineNum]);

      //Datensatz-Länge, Adresse, Record-Typ & Prüfsumme umwandeln
      byteCount := StrToInt('$' + lineParser.Match[1]);
      address := StrToInt('$' + lineParser.Match[2]);
      recordType := StrToInt('$' + lineParser.Match[3]);
      checksum := StrToInt('$' + lineParser.Match[6]);

      if (Length(lineParser.Match[4]) <> byteCount * 2) and strictSyntax then
        raise Exception.CreateFmt(rsErrRecordLength, [Length(lineParser.Match[4]), byteCount * 2, lineNum]);

      memoryLocation := address + (segmentAddress * 16);
      dataSum := 0;

      //Inhalt des Records verarbeiten
      case recordType of
        $00: //Datenblock
          begin
            if (memoryLocation + byteCount) > buffer.Max then
              raise Exception.CreateFmt(rsErrTooLarge, [convertKiB2String(buffer.Max), lineNum]);

            for offset := 0 to pred(byteCount) do
            begin
              data := StrToInt('$' + Copy(lineParser.Match[4], 1 + 2 * offset, 2));
              addWithOverflow(dataSum, data);   //Quersumme über alle Daten

              //Doppelte Einträge abfangen
              if (buffer.Memory[memoryLocation + offset] <> buffer.blankByte) and strictSyntax then
                raise Exception.CreateFmt(rsErrRecordDuplicate, [memoryLocation + offset, lineNum]);

              buffer.Memory[memoryLocation + offset] := data;
            end;
          end;

        $01: //Dateiende
          fwEOF := true;

        $02: //Erweiterte Segment-Adresse
          begin
            segmentAddress := StrToIntDef('$' + lineParser.Match[4], 0);
            addWithOverflow(dataSum, lo(segmentAddress)); //Quersumme, LSB zuerst
            addWithOverflow(dataSum, hi(segmentAddress));
          end;

        else
          raise Exception.CreateFmt(rsErrRecordInvalid, [recordType, lineNum]);
      end;

      //Quersumme über alle Steuerbytes im Record
      addWithOverflow(dataSum, byteCount);
      addWithOverflow(dataSum, lo(address)); //LSB zuerst
      addWithOverflow(dataSum, hi(address));
      addWithOverflow(dataSum, recordType);
      addWithOverflow(dataSum, checksum);

      //Quersumme eines gültigen Records ist '0'
      if dataSum <> 0 then
        raise Exception.CreateFmt(rsErrRecordChecksum, [lineNum]);

      inc(lineNum);
    end; //while ! EOF

    if not fwEOF then
      raise Exception.CreateFmt(rsErrNoEOF, [lineNum]);

    if buffer.Used <= 0 then
      raise Exception.CreateFmt(rsErrNoContent, [lineNum]);
  finally
    fwFile.Free;
    fwFileEnum.Free;

    lineParser.Free;
  end;

  buffer.Valid := true;
end;

procedure createMemoryView(viewGrid: TStringGrid; buffer: TMemoryBuffer; progressBar: TProgressBar = nil);
var
  location, lineAddress: longint;
  viewHex, viewAnsi: string;
begin
  assert(assigned(viewGrid), 'viewGrid not assigned');
  assert(assigned(buffer), 'buffer not assigned');
  assert(buffer.valid, 'Buffer is marked invalid');

  if assigned(progressBar) then
  begin
    progressBar.Position := 0;
    progressBar.Max := buffer.TopWrite div 100;
    progressBar.Step := 1;
  end;

  //Darstellung aufbauen
  viewGrid.Hide;
  viewGrid.RowCount := 2;

  viewGrid.ColWidths[0] := 55;
  viewGrid.ColWidths[1] := 170;
  viewGrid.ColWidths[2] := 15;
  viewGrid.ColWidths[3] := 175;
  viewGrid.ColWidths[4] := 120;

  viewGrid.Cells[0, 0] := rsAddress;
  viewGrid.Cells[1, 0] := rsLowBytes;
  viewGrid.Cells[3, 0] := rsHighBytes;
  viewGrid.Cells[4, 0] := rsData;

  //Puffer konvertieren & ausgeben
  viewHex := '';
  viewAnsi := '';
  lineAddress := 0;

  for location := buffer.Min to buffer.TopWrite do
  begin
    viewHex := viewHex + IntToHex(buffer.Memory[location], 2) + ' ';
    if buffer.Memory[location] <> 0 then
      viewAnsi := viewAnsi + AnsiChar(buffer.Memory[location])
    else
      viewAnsi := viewAnsi + ' ';

    //Vollständige Zeile (16 Bytes) oder letzte Zeile (siehe Schleifenkopf)
    if (Length(viewAnsi) >= 16) or (location >= buffer.TopWrite) then
    begin
      //Adresse & ASCII-Ansicht
      viewGrid.Cells[0, pred(viewGrid.RowCount)] := IntToHex(lineAddress, 6);
      viewGrid.Cells[4, pred(viewGrid.RowCount)] := viewAnsi;

      //Hex-Ansicht in zwei Spalten, letztes Leerzeichen abschneiden
      if Length(viewHex) >= 24 then
      begin
        viewGrid.Cells[1, pred(viewGrid.RowCount)] := copy(viewHex, 1, 24);
        viewGrid.Cells[3, pred(viewGrid.RowCount)] := copy(viewHex, 25, Length(viewHex) - 1);
        viewGrid.Cells[2, pred(viewGrid.RowCount)] := '-';
      end
      else
        viewGrid.Cells[1, pred(viewGrid.RowCount)] := copy(viewHex, 1, Length(viewHex) - 1);

      viewGrid.RowHeights[pred(viewGrid.RowCount)] := 18;
      viewGrid.RowCount := viewGrid.RowCount + 1;

      viewHex := '';
      viewAnsi := '';
      Inc(lineAddress, $10);
    end;

    if Assigned(progressBar) and ((location mod 15) = 0) then
       progressBar.StepIt;
  end;

  viewGrid.RowCount := viewGrid.RowCount - 1;
  viewGrid.Show;

  if Assigned(progressBar) then
    progressBar.Position := 0;
end;
{$ENDREGION}

{$REGION 'Formatumwandlungen'}
function convertByteList2String(data: TByteList; insertSpace: boolean = false): string;
var
  count: integer;
  res: string;
begin
  res := '';

  for count := low(data) to high(data) do
  begin
    res := res + IntToStr(data[count]);
    if insertSpace then
      res := res + ' ';
  end;

  //Überschüssiges Leerzeichen am Ende entfernen
  if insertSpace and (res <> '') then
    res := leftStr(res, length(res) - 1);

  Result := res;
end;

function convertByteList2HexString(data: TByteList; insertSpace: boolean = false): string;
var
  count: integer;
  res: string;
begin
  res := '';

  for count := low(data) to high(data) do
  begin
    res := res + IntToHex(data[count], 2);
    if insertSpace then
      res := res + ' ';
  end;

  //Überschüssiges Leerzeichen am Ende entfernen
  if insertSpace and (res <> '') then
    res := leftStr(res, length(res) - 1);

  Result := res;
end;

function convertKiB2String(kib: longint; appendUnit: boolean = true): string;
var
  res: string;
begin
  res := '';

  if kib >= 1024 then
  begin
    res := IntToStr(Round(kib / 1024));
    if appendUnit then
      res := res + 'kiB';
  end
  else
  begin
    res := IntToStr(kib);
    if appendUnit then
      res := res + ' Byte';
  end;

  Result := res;
end;

function parseHexString(hex: string): AnsiString;
var
  hexParser: TStringList;
  res: AnsiString;
  convert: integer;
  hexNum: string;
begin
  hexParser := TStringList.Create;
  hexParser.Clear;
  hexParser.Delimiter := '$';

  res := '';

  try
    hexParser.DelimitedText := hex;

    for hexNum in hexParser do
    begin
      if TryStrToInt('$' + hexNum, convert) then
      begin
        if convert <= high(Byte) then
          res := res + chr(convert)
        else
          raise Exception.CreateFmt(rsErrRangeByte, [hexNum]);
      end
      else if hexNum <> '' then
        raise Exception.CreateFmt(rsErrNotNumber, [hexNum]);
    end;
  finally
    hexParser.Free;
  end;

  Result := res;
end;

procedure addWithOverflow(var sum1: byte; sum2: byte);
begin
  {$R-}   //TODO: Bessere Möglichkeit als Overflow-Checks abzustellen?!
  sum1 := sum1 + sum2;
  {$R+}
end;

procedure invertByte(var data: byte);
begin
  data := not data;
end;
{$ENDREGION}

end.

