unit UdrStrings;

interface

uses
  System.SysUtils, FbApi;

type
  PTestStrInMessage = ^TTestStrInMessage;

  TTestStrInMessage = record
    StrLen: Word;
    Str: array [0 .. 4 * 255 - 1] of AnsiChar;
    StrNull: WordBool;
  end;

  PTestStrOutMessage = ^TTestStrOutMessage;

  TTestStrOutMessage = record
    StrLen: Word;
    Str: array [0 .. 4 * 255 - 1] of AnsiChar;
    StrNull: WordBool;
  end;

  TTestStrFunction = class(ExternalFunctionImpl)
    procedure dispose(); override;
    procedure getCharSet(status: status; context: ExternalContext;
      name: PAnsiChar; nameSize: Cardinal); override;
    procedure execute(status: status; context: ExternalContext; inMsg: Pointer;
      outMsg: Pointer); override;
  end;

  TTestStrFactory = class(UdrFunctionFactoryImpl)
    procedure dispose(); override;
    procedure setup(status: status; context: ExternalContext;
      metadata: RoutineMetadata; inBuilder: MetadataBuilder;
      outBuilder: MetadataBuilder); override;
    function newItem(status: status; context: ExternalContext;
      metadata: RoutineMetadata): ExternalFunction; override;
  end;

implementation

uses
  System.AnsiStrings;

{ TTestStrFunction }

procedure TTestStrFunction.dispose();
begin
  destroy;
end;

procedure TTestStrFunction.getCharSet(status: status; context: ExternalContext;
  name: PAnsiChar; nameSize: Cardinal);
begin
end;

procedure TTestStrFunction.execute(status: status; context: ExternalContext;
  inMsg: Pointer; outMsg: Pointer);
var
  AInMsg: PTestStrInMessage;
  AOutMsg: PTestStrOutMessage;
  AStr: UTF8String;
begin
  try
    AInMsg := PTestStrInMessage(inMsg);
    AOutMsg := PTestStrOutMessage(outMsg);
    if AInMsg.StrNull then begin
      with AOutMsg^ do begin
        StrLen := 0;
        StrNull := StrLen = 0;
      end;
    end
    else begin
      AStr := UTF8Encode(System.AnsiStrings.AnsiReverseString(UTF8ToString(AInMsg.Str)));
      with AOutMsg^ do begin
        StrLen := Length(AStr);
        StrNull := StrLen = 0;
        if StrLen > 0 then
          Move(PAnsiChar(AStr)^, Str[0], StrLen * SizeOf(AnsiChar));
      end;
    end;
  except
    on E: Exception do
      FbException.catchException(status, E);
  end;
end;

{ TTestStrFactory }

procedure TTestStrFactory.dispose();
begin
  destroy;
end;

procedure TTestStrFactory.setup(status: status; context: ExternalContext;
  metadata: RoutineMetadata; inBuilder: MetadataBuilder;
  outBuilder: MetadataBuilder);
begin
end;

function TTestStrFactory.newItem(status: status; context: ExternalContext;
  metadata: RoutineMetadata): ExternalFunction;
begin
  Result := TTestStrFunction.create;
end;

end.