FP_USBasp/source/usbasp.pas

unit USBasp;

{

  This file is part of Nephelae's Object Pascal FPUSBasp.

  USBasp Class.

  Copyright (C) 2025 Dimitrios Chr. Ioannidis.
    Nephelae - https://www.nephelae.eu

  https://www.nephelae.eu/

  Licensed under the MIT License (MIT).
  See licence file in root directory.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF
  ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED
  TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
  PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT
  SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
  ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
  ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  OTHER DEALINGS IN THE SOFTWARE.

}

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, syncobjs, hidapi,
  SPSCRingBuffer;

const

  // USBasp UART Extension
  // https://github.com/dioannidis/usbasp/blob/master/firmware/usbasp.h

  USBASP_UART_PARITY_MASK = %11;
  USBASP_UART_PARITY_NONE = %00;
  USBASP_UART_PARITY_EVEN = %01;
  USBASP_UART_PARITY_ODD = %10;

  USBASP_UART_STOP_MASK = %100;
  USBASP_UART_STOP_1BIT = %000;
  USBASP_UART_STOP_2BIT = %100;

  USBASP_UART_BYTES_MASK = %111000;
  USBASP_UART_BYTES_5B = %000000;
  USBASP_UART_BYTES_6B = %001000;
  USBASP_UART_BYTES_7B = %010000;
  USBASP_UART_BYTES_8B = %011000;
  USBASP_UART_BYTES_9B = %100000;

  TUARTBaudRate: array[0..13] of integer =
    (300, 600, 1200, 2400, 4800, 9600, 14400, 19200, 28800, 31250,
    38400, 57600, 74880, 115200);

  TUARTDataBits: array[0..4] of integer =
    (USBASP_UART_BYTES_5B, USBASP_UART_BYTES_6B, USBASP_UART_BYTES_7B,
    USBASP_UART_BYTES_8B, USBASP_UART_BYTES_9B);

  TUARTParity: array[0..2] of integer =
    (USBASP_UART_PARITY_NONE, USBASP_UART_PARITY_EVEN, USBASP_UART_PARITY_ODD);

  TUARTStopBit: array[0..1] of integer = (USBASP_UART_STOP_1BIT, USBASP_UART_STOP_2BIT);

type

  TUARTReceive = procedure(Sender: TObject; ASerialData: TByteArray;
    ASerialDataLength: SizeInt) of object;

  TStatusChange = procedure(Sender: TObject) of object;

  { TUSBasp }

  TUSBasp = class(TObject)
  private
    FUART_HIDDevice, FSTATUS_HIDDevice: PHidDevice;

    FUART_HIDDevicePath, FSTATUS_HIDDevicePath, FSerial, FManufacturer,
    FProductName, FHidApiVersionString: unicodestring;

    FConnected, FHasHIDUart, FHasStatus, FHasPDI, FHasTPI, FHasSNWrite,
    FUARTOpened: boolean;
    FCrystalOSC: integer;

    FHIDError: string;

    FUART_RxBuffer, FUART_TxBuffer, FStatus_RxBuffer: TSPSCRingBuffer;

    FUART_RxEvent, FUART_StartRxEvent, FUART_TxEvent, FSTATUS_RxEvent,
    FSTATUS_StartRxEvent: TEvent;

    FUART_RxThread, FUART_TxThread, FSTATUS_RxThread, FThreadSync: TThread;

    FOnUARTReceive: TUARTReceive;
    FOnStatusChange: TStatusChange;

    function HIDEnumerate(const ASerialNumber: string = ''): boolean;
    procedure SetOnStatusChange(AValue: TStatusChange);
    procedure SetOnUARTReceive(AValue: TUARTReceive);
  protected
    procedure DoUARTReceive;
    procedure DoStatusChange;
  public
    constructor Create;
    destructor Destroy; override;

    function Connect(const ASerialNumber: string = ''): boolean;
    function Disconnect: boolean;
    function UARTOpen(const ABaudRate, ADataBits, AParity, AStopBits: integer): boolean;
    function UARTClose: boolean;
    function ChangeSerialNumber(const ASerialNumber: string): boolean;

    property Connected: boolean read FConnected;
    property UARTOpened: boolean read FUARTOpened;
    property HidApiVersion: unicodestring read FHidApiVersionString;

    property OnUARTReceive: TUARTReceive read FOnUARTReceive write SetOnUARTReceive;
    property OnStatusChange: TStatusChange read FOnStatusChange write SetOnStatusChange;
  end;

var
  UART_IO_Lock: TCriticalSection;
  STATUS_IO_Lock: TCriticalSection;

implementation

const
  USBASP_SHARED_VID = $16C0;
  USBASP_SHARED_PID = $05DC;

  USBASP_FUNC_GETCAPABILITIES = 127;

  USBASP_CAP_0_TPI = 1;
  USBASP_CAP_PDI = 16;
  USBASP_CAP_2_SNHIDUPDATE = 32;
  USBASP_CAP_6_UART = 64;
  USBASP_CAP_7_HID_UART = 128;

  USBASP_NO_CAPS = (-4);

  USBASP_CAP_12MHZ_CLOCK = 0;
  USBASP_CAP_16MHZ_CLOCK = 1;
  USBASP_CAP_18MHZ_CLOCK = 2;
  USBASP_CAP_20MHZ_CLOCK = 3;

  PROG_STATE_IDLE = 0;
  PROG_STATE_WRITEFLASH = 1;
  PROG_STATE_READFLASH = 2;
  PROG_STATE_READEEPROM = 3;
  PROG_STATE_WRITEEEPROM = 4;
  PROG_STATE_TPI_READ = 5;
  PROG_STATE_TPI_WRITE = 6;
  PROG_STATE_SET_REPORT = 7;

  UART_STATE_ENABLED = 16;
  UART_STATE_DISABLED = 0;

type
  THIDPacket_Rx = array[0..7] of byte;
  THIDPacket_Tx = array[0..8] of byte;

  { TThreadHID }

  TThreadHID = class(TThread)
  protected
    FUSBasp: TUSBasp;
    FHIDIOLock: TCriticalSection;
  public
    constructor Create(const AUSBasp: TUSBasp; const AHIDIOLock: TCriticalSection);
      reintroduce;
  end;

  { THIDStatus_Rx }

  THIDStatus_Rx = class(TThreadHID)
  protected
    procedure Execute; override;
  end;

  { THIDUART_Rx }

  THIDUART_Rx = class(TThreadHID)
    procedure Execute; override;
  end;

  { THIDUART_Tx }

  THIDUART_Tx = class(TThreadHID)
  protected
    procedure Execute; override;
  end;

{ TThreadHID }

constructor TThreadHID.Create(const AUSBasp: TUSBasp;
  const AHIDIOLock: TCriticalSection);
begin
  FUSBasp := AUSBasp;
  FHIDIOLock := AHIDIOLock;
  inherited Create(False);
end;

{ THIDStatus_Rx }

procedure THIDStatus_Rx.Execute;
var
  HidPacket, PrevHidPacket: THIDPacket_Rx;
  DataCount: SizeInt = 0;

  function HIDPacketEqual(constref AHIDPacket, APrevHIDPacket:
    THIDPacket_Rx): boolean;
  var
    Idx: byte;
  begin
    Result := True;
    for idx := Low(AHidPacket) to High(AHIDPacket) do
      if APrevHIDPacket[Idx] <> AHIDPacket[Idx] then
      begin
        Result := False;
        Break;
      end;
  end;

begin
  FillChar(HIDPacket, High(THIDPacket_Rx) + 1, 0);
  PrevHidPacket := HidPacket;

  repeat
    FUSBasp.FSTATUS_StartRxEvent.WaitFor(INFINITE);

    FHIDIOLock.Acquire;
    try
      if Assigned(FUSBasp.FSTATUS_HIDDevice) then
        DataCount := FUSBasp.FSTATUS_HIDDevice^.ReadTimeout(HIDPacket,
          High(HIDPacket) + 1, 5)
      else
        DataCount := 0;
    finally
      FHIDIOLock.Release;
    end;

    if (DataCount > 0) and (not HIDPacketEqual(HIDPacket, PrevHidPacket)) then
    begin
      PrevHidPacket := HidPacket;
      FUSBasp.FStatus_RxBuffer.Write(HIDPacket, DataCount);
      FUSBasp.FSTATUS_RxEvent.SetEvent;
    end;
  until Terminated;
end;

{ THIDUART_Rx }

procedure THIDUART_Rx.Execute;
var
  HIDPacket: THIDPacket_Rx;
  SerialDataCount, DataCount: byte;
begin
  FillChar(HIDPacket, High(THIDPacket_Rx) + 1, 0);

  repeat
    FUSBasp.FUART_StartRxEvent.WaitFor(INFINITE);

    FHIDIOLock.Acquire;
    try
      if Assigned(FUSBasp.FUART_HIDDevice) then
        DataCount := FUSBasp.FUART_HIDDevice^.ReadTimeout(HIDPacket,
          High(THIDPacket_Rx) + 1, 5)
      else
        DataCount := 0;
    finally
      FHIDIOLock.Release;
    end;

    if (DataCount > 0) and (HIDPacket[7] > 0) then
    begin
      if (HIDPacket[7] > 7) then
        SerialDataCount := 8
      else
        SerialDataCount := HIDPacket[7];
      if FUSBasp.FUART_RxBuffer.Write(HIDPacket, SerialDataCount) <>
        SerialDataCount then
        raise TExceptionClass.Create('Receive Buffer OverRun');
      FUSBasp.FUART_RxEvent.SetEvent;
    end;

  until Terminated;
end;

{ THIDUART_Tx }

procedure THIDUART_Tx.Execute;
var
  HIDPacket: THIDPacket_Tx;
  SerialCountOrDataByte, DataCount: byte;
begin
  FillChar(HIDPacket, High(HIDPacket) + 1, 0);
  repeat
    if FUSBAsp.FUART_TxBuffer.Empty then
      FUSBasp.FUART_TxEvent.ResetEvent;

    FUSBasp.FUART_TxEvent.WaitFor(INFINITE);

    DataCount := FUSBAsp.FUART_TxBuffer.Peek(HIDPacket[1], 8);
    SerialCountOrDataByte := DataCount;

    if (SerialCountOrDataByte = 8) and (HIDPacket[8] = 7) then
      SerialCountOrDataByte := 7
    else
    if SerialCountOrDataByte < 8 then
      HIDPacket[8] := SerialCountOrDataByte;

    if DataCount > 0 then
    begin
      FHIDIOLock.Acquire;
      try
        if Assigned(FUSBasp.FUART_HIDDevice) then
          SerialCountOrDataByte :=
            FUSBasp.FUART_HIDDevice^.Write(HIDPacket, High(HIDPacket) + 1);
      finally
        FHIDIOLock.Release;
      end;
      FUSBAsp.FUART_TxBuffer.AdvanceReadIdx(DataCount);
    end;

  until Terminated;
end;

type

  { TThreadSync }

  TThreadSync = class(TThread)
  private
    FUSBasp: TUSBasp;
  protected
    procedure Execute; override;
  public
    constructor Create(const AUSBasp: TUSBasp); reintroduce;
  end;

procedure TThreadSync.Execute;
begin
  repeat
    if FUSBasp.FUART_RxEvent.WaitFor(3) = wrSignaled then
      Synchronize(@FUSBasp.DoUARTReceive);
    if FUSBasp.FSTATUS_RxEvent.WaitFor(3) = wrSignaled then
      Synchronize(@FUSBasp.DoStatusChange);
  until Terminated;
end;

constructor TThreadSync.Create(const AUSBasp: TUSBasp);
begin
  FUSBasp := AUSBasp;
  inherited Create(False);
end;

{ TUSBasp }

constructor TUSBasp.Create;
begin
  FConnected := False;
  FUARTOpened := False;
  FSerial := '';

  FUART_RxBuffer := TSPSCRingBuffer.Create(8192);
  FUART_TxBuffer := TSPSCRingBuffer.Create(8192);
  FStatus_RxBuffer := TSPSCRingBuffer.Create(8);

  Randomize;

  FUART_StartRxEvent := TEvent.Create(nil, True, False, 'STARTUARTRX' +
    IntToStr(Random(999)));
  FUART_RxEvent := TEvent.Create(nil, False, False, 'UARTRX' + IntToStr(Random(999)));
  FUART_TxEvent := TEvent.Create(nil, True, False, 'UARTTX' + IntToStr(Random(999)));

  FSTATUS_RxEvent := TEvent.Create(nil, False, False, 'STATUSRX' +
    IntToStr(Random(999)));
  FSTATUS_StartRxEvent := TEvent.Create(nil, True, False, 'STARTSTATUSRX' +
    IntToStr(Random(999)));

  FThreadSync := TThreadSync.Create(Self);

  FUART_RxThread := THIDUART_Rx.Create(Self, UART_IO_Lock);
  FUART_TxThread := THIDUART_Tx.Create(Self, UART_IO_Lock);

  FSTATUS_RxThread := THIDStatus_Rx.Create(Self, STATUS_IO_Lock);

end;

destructor TUSBasp.Destroy;
begin
  Disconnect;

  FThreadSync.Terminate;
  FThreadSync.WaitFor;
  FreeAndNil(FThreadSync);

  FUART_RxThread.Terminate;
  FUART_StartRxEvent.SetEvent;
  FUART_RxThread.WaitFor;
  FreeAndNil(FUART_RxThread);

  FUART_TxThread.Terminate;
  FUART_TxEvent.SetEvent;
  FUART_TxThread.WaitFor;
  FreeAndNil(FUART_TxThread);

  FSTATUS_RxThread.Terminate;
  FSTATUS_StartRxEvent.SetEvent;
  FSTATUS_RxThread.WaitFor;
  FreeAndNil(FSTATUS_RxThread);

  FreeAndNil(FUART_RxBuffer);
  FreeAndNil(FUART_TxBuffer);
  FreeAndNil(FStatus_RxBuffer);

  FreeAndNil(FUART_RxEvent);
  FreeAndNil(FUART_TxEvent);
  FreeAndNil(FSTATUS_RxEvent);

  FreeAndNil(FUART_StartRxEvent);
  FreeAndNil(FSTATUS_StartRxEvent);

  inherited Destroy;
end;

function TUSBasp.Connect(const ASerialNumber: string = ''): boolean;
begin
  if not FConnected then
  begin

    HidInit();

    if not HIDEnumerate(ASerialNumber) then
      Exit;

    FUART_HIDDevice := THidDevice.OpenPath(FUART_HIDDevicePath);
    FHIDError := THIDDevice.GetNullError(FUART_HIDDevice);

    if (FHIDError <> 'Success') then
      Exit;

    FUART_HIDDevice^.SetNonBlocking(1);

    if FHasStatus then
    begin
      FSTATUS_HIDDevice := THidDevice.OpenPath(FSTATUS_HIDDevicePath);
      FHIDError := THIDDevice.GetNullError(FSTATUS_HIDDevice);

      if (FHIDError = 'Success') then
      begin
        FSTATUS_HIDDevice^.SetNonBlocking(1);
        FSTATUS_StartRxEvent.SetEvent;
      end;

    end;

    FConnected := True;
  end;

  Result := FConnected;
end;

function TUSBasp.Disconnect: boolean;
begin
  if FConnected then
  begin

    if FUARTOpened then
    begin
      UARTClose;
      Sleep(100);
    end;

    UART_IO_Lock.Acquire;
    try
      FUART_HIDDevice^.Close;
      FUART_HIDDevice := nil;
    finally
      UART_IO_Lock.Release;
    end;

    if FHasStatus then
    begin
      STATUS_IO_Lock.Acquire;
      try
        FSTATUS_HIDDevice^.Close;
        FSTATUS_HIDDevice := nil;
        FSTATUS_StartRxEvent.ResetEvent;
      finally
        STATUS_IO_Lock.Release;
      end;
    end;

    FConnected := False;

    HidExit;

  end;

  Result := not FConnected;
end;

function TUSBasp.UARTOpen(const ABaudRate, ADataBits, AParity,
  AStopBits: integer): boolean;
var
  HIDPacket: THIDPacket_Tx;
  Prescaler: word;
  Rslt: SizeInt;
begin
  if FConnected and not FUARTOpened then
  begin
    Prescaler := FCrystalOsc div 8 div ABaudRate - 1;

    Fillchar(HIDPacket, High(HIDPacket) + 1, 0);
    HIDPacket[0] := 0;
    HIDPacket[1] := lo(Prescaler);
    HIDPacket[2] := hi(Prescaler);
    HIDPacket[3] := ADataBits or AStopBits or AParity;

    UART_IO_Lock.Acquire;
    try
      Rslt := FUART_HIDDevice^.SendFeatureReport(HIDPacket, High(HIDPacket) + 1);
      FUART_StartRxEvent.SetEvent;
    finally
      UART_IO_Lock.Release;
    end;

    if Rslt > 0 then
      FUARTOpened := True;
  end;

  Result := FUARTOpened;
end;

function TUSBasp.UARTClose: boolean;
var
  HIDPacket: THIDPacket_Tx;
  Rslt: SizeInt;
begin
  if FConnected and FUARTOpened then
  begin
    Fillchar(HIDPacket, High(HIDPacket) + 1, 0);
    HIDPacket[0] := 0;
    HIDPacket[1] := 0;
    HIDPacket[2] := 0;
    HIDPacket[3] := 0;
    HIDPacket[4] := 0;

    UART_IO_Lock.Acquire;
    try
      Rslt := FUART_HIDDevice^.SendFeatureReport(HIDPacket, High(HIDPacket) + 1);
      FUART_StartRxEvent.ResetEvent;
    finally
      UART_IO_Lock.Release;
    end;

    if Rslt > 0 then
      FUARTOpened := False;
  end;

  Result := not FUARTOpened;
end;

function TUSBasp.HIDEnumerate(const ASerialNumber: string): boolean;
var
  HidItemRoot, HidItem: PHidDeviceInfo;
  HIDDevice: PHidDevice;
  HIDDeviceMatch: boolean;
  FeatureReportBuffer: THIDPacket_Rx;
begin
  Result := False;

  FUART_HIDDevice := nil;
  FSTATUS_HIDDevice := nil;

  FUART_HIDDevicePath := '';
  FSTATUS_HIDDevicePath := '';

  FHasStatus := False;

  try
    HidItemRoot := THidDeviceInfo.Enumerate(USBASP_SHARED_VID, USBASP_SHARED_PID);
    HidItem := HidItemRoot;

    while Assigned(HidItem) do
    begin
      HIDDeviceMatch := True;

      if ASerialNumber <> '' then
        if ASerialNumber <> PCWCharToUnicodeString(HidItem^.SerialNumber) then
          HIDDeviceMatch := False;

      if HIDDeviceMatch then
        case HidItem^.InterfaceNumber of
          1: begin
            FUART_HIDDevicePath := HidItem^.Path;
            Result := True;
          end;
          2: begin
            FSTATUS_HIDDevicePath := HidItem^.Path;
            FHasStatus := True;
          end;
        end;

      HidItem := HidItem^.Next;
    end;
  finally
    HidItemRoot^.Free;
  end;

  if Result then
  begin
    HIDDevice := THidDevice.OpenPath(FUART_HIDDevicePath);

    FSerial := HIDDevice^.GetSerialNumberString;
    FManufacturer := HIDDevice^.GetManufacturerString;
    FProductName := HIDDevice^.GetProductString;

    if HIDDevice^.GetFeatureReport(FeatureReportBuffer, 8 + 1) > 0 then
    begin

      case FeatureReportBuffer[6] of
        USBASP_CAP_12MHZ_CLOCK: FCrystalOsc := 12000000;
        USBASP_CAP_16MHZ_CLOCK: FCrystalOsc := 16000000;
        USBASP_CAP_18MHZ_CLOCK: FCrystalOsc := 18000000;
        USBASP_CAP_20MHZ_CLOCK: FCrystalOsc := 20000000;
      end;

      FHasHIDUart := (FeatureReportBuffer[5] and USBASP_CAP_7_HID_UART) =
        USBASP_CAP_7_HID_UART;
      FHasPDI := (FeatureReportBuffer[5] and USBASP_CAP_PDI) = USBASP_CAP_PDI;
      FHasTPI := (FeatureReportBuffer[5] and USBASP_CAP_0_TPI) = USBASP_CAP_0_TPI;
      FHasSNWrite := (FeatureReportBuffer[5] and USBASP_CAP_2_SNHIDUPDATE) =
        USBASP_CAP_2_SNHIDUPDATE;

    end;

    HIDDevice^.Close;
    HIDDevice := nil;

  end;
end;

procedure TUSBasp.DoUARTReceive;
var
  SerialData: TByteArray;
  SerialDataLength, CRIdx: SizeInt;
begin
  repeat
    SerialDataLength := FUART_RxBuffer.Peek(SerialData, FUART_RxBuffer.Size);

    CRIdx := IndexByte(SerialData, SerialDataLength, Ord(#10));
    if (CRIdx > 0) and (SerialData[CRIdx - 1] = Ord(#13)) then
      FUART_RxBuffer.AdvanceReadIdx(CRIdx + 1);

    if Assigned(FOnUARTReceive) and (CRIdx - 1 > 0) then
      FOnUARTReceive(Self, SerialData, CRIdx - 1);
  until CRIdx = -1;

  //SerialDataLength := FUART_RxBuffer.Read(SerialData, FUART_RxBuffer.Size);
  //if Assigned(FOnUARTReceive) then
  //  FOnUARTReceive(Self, SerialData, SerialDataLength);

end;

procedure TUSBasp.SetOnUARTReceive(AValue: TUARTReceive);
begin
  if FOnUARTReceive = AValue then Exit;
  FOnUARTReceive := AValue;
end;

procedure TUSBasp.DoStatusChange;
var
  StatusBuffer: TByteArray;
begin
  FStatus_RxBuffer.Read(StatusBuffer, FStatus_RxBuffer.Size);
  if Assigned(FOnStatusChange) then
    FOnStatusChange(Self);
end;

procedure TUSBasp.SetOnStatusChange(AValue: TStatusChange);
begin
  if FOnStatusChange = AValue then Exit;
  FOnStatusChange := AValue;
end;

function TUSBasp.ChangeSerialNumber(const ASerialNumber: string): boolean;
var
  Buffer: THIDPacket_Rx;
  ErrorCode: integer;
  SerNumValue: word;
begin
  Result := False;
  if FConnected and not FUARTOpened then
  begin
    Val(ASerialNumber, SerNumValue, ErrorCode);

    Buffer[0] := 0;

    Buffer[1] := lo(SerNumValue);
    Buffer[2] := Hi(SerNumValue);
    Buffer[4] := 1;

    FUART_HIDDevice^.SendFeatureReport(Buffer, 8 + 1);
    FHIDError := THidDevice.GetNullError();
    //Result := FUART_HIDDevice^.GetError = 'Success';
  end;
end;

initialization
  UART_IO_Lock := TCriticalSection.Create;
  STATUS_IO_Lock := TCriticalSection.Create;

finalization
  UART_IO_Lock.Free;
  STATUS_IO_Lock.Free;

end.