How to pass second string parameter in UDR with Pascal?

[martin....@it-syn.de]

Hello,

I need some support in the area of UDR / FreePascal. I would like to implement the Levenshtein algorithm as a UDR. Unfortunately, I am not the Pascal expert and I am stuck at one point.

This is the relevant excerpt of the UDR:
unit SynDeskLevenshtein; interface uses Firebird, SysUtils, Math; const vcFb = 32765; type IncInMessage = record v1: record // Erste Zeichenkette Length: Word; Value: array [0..vcFb - 1] of AnsiChar; Null: WordBool; end; v1Null: WordBool; v2: record // Zweite Zeichenkette Length: Word; Value: array [0..vcFb - 1] of AnsiChar; Null: WordBool; end; v2Null: WordBool; end; IncInMessagePtr = ^IncInMessage; IncOutMessage = record Result: integer; resultNull: wordbool; end; IncOutMessagePtr = ^IncOutMessage; IncFunction = class(IExternalFunctionImpl) procedure dispose(); override; procedure getCharSet(status: iStatus; context: iExternalContext; Name: pansichar; nameSize: cardinal); override; procedure Execute(status: iStatus; context: iExternalContext; inMsg: Pointer; outMsg: Pointer); override; end; IncFactory = class(IUdrFunctionFactoryImpl) procedure dispose(); override; procedure setup(status: iStatus; context: iExternalContext; metadata: iRoutineMetadata; inBuilder: iMetadataBuilder; outBuilder: iMetadataBuilder); override; function newItem(status: iStatus; context: iExternalContext; metadata: iRoutineMetadata): IExternalFunction; override; end; implementation procedure IncFunction.dispose(); begin Destroy; end; procedure IncFunction.getCharSet(status: iStatus; context: iExternalContext; Name: pansichar; nameSize: cardinal); begin end; procedure IncFunction.Execute(status: iStatus; context: iExternalContext; inMsg: Pointer; outMsg: Pointer); var xInput: IncInMessagePtr; xOutput: IncOutMessagePtr; s1: string; s2: string; begin xInput := IncInMessagePtr(inMsg); xOutput := IncOutMessagePtr(outMsg); s1 := xInput^.v1.Value; s2 := xInput^.v2.Value; xOutput^.resultNull := xInput^.v2.Null; xOutput^.Result := Length(s1) + Length(s2); // Länge von s2 ist immer 0 end; procedure IncFactory.dispose(); begin Destroy; end; procedure IncFactory.setup(status: iStatus; context: iExternalContext; metadata: iRoutineMetadata; inBuilder: iMetadataBuilder; outBuilder: iMetadataBuilder); begin end; function IncFactory.newItem(status: iStatus; context: iExternalContext; metadata: iRoutineMetadata): IExternalFunction; begin Result := IncFunction.Create; end; end.

In the DB I register and execute it:

create function Inc ( v1 varchar(100), v2 varchar(100) ) returns integer external name 'SynDeskUDR!syndesk_levenshtein' engine udr; select inc('bklm', 'test') from rdb$database;

The result always gives me only the number of characters for the first parameter. What am I doing wrong? I hope there is a Pascal guru around.

For the sake of completeness I have put the Lazarus project online.
https://github.com/MartinKoeditz/SynDeskUDR

Thanks for your efforts
Martin

[Dimitry Sibiryakov]

martin....@it-syn.de wrote 31.08.2023 11:55:
> The result always gives me only the number of characters for the first
> parameter. What am I doing wrong?

First of all your declaration of IncInMessage is wrong.
Then your SQL declaration doesn't match IncInMessage as well.

--
WBR, SD.

[Norbert Saint Georges]

it seems to me that it should be something like this ( not tested !! )


unit SynDeskLevenshtein;

{$mode delphi}

interface

uses Firebird, SysUtils, Math;

function LevenshteinDistance(const s1 : string; s2 : string) : integer;


type
FBMessage = record
FieldName : array[0..62] of AnsiChar;
RelationName : array[0..62] of AnsiChar;
OwnerName : array[0..62] of AnsiChar;
AliasName : array[0..62] of AnsiChar;
FBType : Cardinal;
isNullable : Boolean;
SubType : Integer;
Length : Cardinal;
Scale : Integer;
CharSet : Cardinal;
Offset : Cardinal;
NullOffset : Cardinal;
end;

InMessagePtr = ^inmetata;
inmetata = array of FBMessage;

OutMessagePtr = ^outmetata;
outmetata = array of FBMessage;


IncFunction = class(IExternalFunctionImpl)
private
_in, _out, _inlength, _outlength : cardinal;
_inMessage: inmetata;
_outMessage: outmetata;
_inBuffer , _OutBuffer : pchar;
str_1, str_2 : pchar;
public
constructor create(iin, iout, iinlength, ioutlength: cardinal;
var inMessage: inmetata; var outMessage: outmetata);overload;
procedure dispose(); override;
procedure getCharSet(status: IStatus; context: IExternalContext;
name: PChar; nameSize: Cardinal); override;
procedure execute(status: IStatus; context: IExternalContext;

inMsg: Pointer; outMsg: Pointer); override;
end;

IncFactory = class(IUdrFunctionFactoryImpl)

private
_in, _out, _inlength, _outlength : cardinal;
_outMessage: outmetata;
_inMessage: inMetata;
public
procedure dispose(); override;
procedure setup(status: IStatus; context: IExternalContext;
metadata: IRoutineMetadata; inBuilder: IMetadataBuilder; outBuilder:
IMetadataBuilder); override;
function newItem(status: IStatus; context: IExternalContext;
metadata: IRoutineMetadata): iExternalFunction; override;
end;

var
FBExcept : FbException;

implementation
constructor IncFunction.create( iin, iout, iinlength, ioutlength:
cardinal; var inMessage: inmetata; var outMessage:outmetata);
begin
_in := iin;
_out:= iout;
_inlength := iinlength;
_outlength := ioutlength;
_inMessage := inMessage;
_outMessage := outMessage;
getmem(_inBuffer , _inlength);
getmem(_outBuffer, _outlength);
getmem(str_1,100);
getmem(str_2,100);
inherited create;
end;

procedure IncFunction.dispose();
begin
freemem(_inBuffer);
freemem(_outBuffer);
freemem(_InMessage);
freemem(_OutMessage);
freemem(str_1);
freemem(str_2);
destroy;

end;

procedure IncFunction.getCharSet(status: iStatus; context:
iExternalContext;
Name: pansichar; nameSize: cardinal);
begin
end;

procedure IncFunction.Execute(status: iStatus; context:
iExternalContext;
inMsg: Pointer; outMsg: Pointer);
var

iResult : integer;
isnull : wordbool;
begin
_inbuffer := pchar(inMsg);
_outbuffer := pchar(outMsg);

if ((_inMessage[0].length<> 100) or (_inMessage[1].length<>100))
then
raise exception.Create('Length error between input');


move(_inbuffer[_inMessage[0].Offset],pchar(str_1)^,_inMessage[0].length);

move(_inbuffer[_inMessage[1].Offset],pchar(str_2)^,_inMessage[1].length);
iResult := LevenshteinDistance(str_1, str_2);
isnull := false;
move(integer(iResult),_outbuffer[0],sizeof(integer));
move(wordbool(isnull),_outbuffer[sizeof(integer)],2);
end;


procedure IncFactory.dispose();
begin
freemem(_InMessage);
freemem(_OutMessage);

Destroy;
end;

procedure IncFactory.setup(status: iStatus; context: iExternalContext;
metadata: iRoutineMetadata; inBuilder: iMetadataBuilder; outBuilder:
iMetadataBuilder);

var
inmeta, outmeta : IMessageMetadata;
i : integer;
begin
try
inMeta := inBuilder.getMetadata(status);
_in := inMeta.getCount(status) -1;
_inlength := inmeta.getMessageLength(status);
outmeta := outbuilder.getMetadata(status);
_out := outmeta.getCount(status)-1;
_outlength := outmeta.getMessageLength(status);

if (_in<> 2) then
raise exception.Create('Error in the number of input
variables');
except
on e:exception do begin
fbexcept := FbException.create(status);
e.message :='LevenshteinDistance, OutMessage : '+ e.message;
fbexcept.catchException(status,e);
end;
end;
try
setlength(_outMessage, sizeof(FBMessage)*_out+1);
for i:=0 to _out do begin
_OutMessage[i].FieldName := outmeta.getField(status, i);
_OutMessage[i].RelationName:= outmeta.getRelation(status, i);
_OutMessage[i].OwnerName := outmeta.getOwner(status, i);
_OutMessage[i].AliasName := outmeta.getAlias(status, i);
_OutMessage[i].FBType := outmeta.gettype(status, i);
_OutMessage[i].isNullable := outmeta.isNullable(status, i);
_OutMessage[i].SubType := outmeta.getSubType(status, i);
_OutMessage[i].Length := outmeta.getLength(status, i);
_OutMessage[i].Scale := outmeta.getScale(status, i);
_OutMessage[i].CharSet := outmeta.getCharSet(status, i);
_OutMessage[i].Offset := outmeta.getOffset(status, i);
_OutMessage[i].NullOffset := outmeta.getNullOffset(status,
i);
end;
outmeta := nil;
except
on e:exception do begin
fbexcept := FbException.create(status);
e.message :='LevenshteinDistance, Iout = '+inttostr(_out)+'
OutMessage : '+ e.message;
fbexcept.catchException(status,e);
end;
end;
try
setlength(_InMessage, sizeof(FBMessage)*_in+1);
for i:=0 to _in do begin
_InMessage[i].FieldName:= inmeta.getField(status, i);
_InMessage[i].RelationName:= inmeta.getRelation(status, i);
_InMessage[i].OwnerName:= inmeta.getOwner(status, i);
_InMessage[i].AliasName:= inmeta.getAlias(status, i);
_InMessage[i].FBType:= inmeta.gettype(status, i);
_InMessage[i].isNullable:= inmeta.isNullable(status, i);
_InMessage[i].SubType:= inmeta.getSubType(status, i);
_InMessage[i].Length:= inmeta.getLength(status, i);
_InMessage[i].Scale:= inmeta.getScale(status, i);
_InMessage[i].CharSet:= inmeta.getCharSet(status, i);
_InMessage[i].Offset:= inmeta.getOffset(status, i);
_InMessage[i].NullOffset:= inmeta.getNullOffset(status, i);
end;
inMeta := nil;
if ((_inMessage[0].length<> 100) or (_inMessage[1].length<>100))
then
raise exception.Create('Length error between input');
except
on e:exception do begin
fbexcept := FbException.create(status);
e.message :='LevenshteinDistance, InMessage : '+ e.message;
fbexcept.catchException(status,e);
end;
end;

end;

function IncFactory.newItem(status: iStatus; context: iExternalContext;
metadata: iRoutineMetadata): IExternalFunction;
begin

Result := IncFunction.Create(_in, _out, _inlength,
_outlength,_inMessage, _outMessage);
end;

{------------------------------------------------------------------------------
Name: LevenshteinDistance
Params: s1, s2 - UTF8 encoded strings
Returns: Minimum number of single-character edits.
Compare 2 UTF8 encoded strings, case sensitive.
Source: https://wiki.freepascal.org/Levenshtein_distance, 2023/08/31
------------------------------------------------------------------------------}
function LevenshteinDistance(const s1 : string; s2 : string) : integer;
var
length1, length2, i, j ,
value1, value2, value3 : integer;
matrix : array of array of integer;
begin
length1 := Length( s1 );
length2 := Length( s2 );
SetLength (matrix, length1 + 1, length2 + 1);
for i := 0 to length1 do matrix [i, 0] := i;
for j := 0 to length2 do matrix [0, j] := j;
for i := 1 to length1 do
for j := 1 to length2 do
begin
if Copy( s1, i, 1) = Copy( s2, j, 1 )
then matrix[i,j] := matrix[i-1,j-1]
else begin
value1 := matrix [i-1, j] + 1;
value2 := matrix [i, j-1] + 1;
value3 := matrix[i-1, j-1] + 1;
matrix [i, j] := min( value1, min( value2, value3 ));
end;
end;
result := matrix [length1, length2];
end;


end.

--
Norbert Saint Georges
http://tetrasys.fi

[martin....@it-syn.de]

Thanks to the article (https://www.ibase.ru/files/firebird/udr.pdf) I found the cause.

Instead of

IncInMessage = record v1: record // Erste Zeichenkette Length: Word; Value: array [0..vcFb - 1] of AnsiChar; Null: WordBool; end; v1Null: WordBool; v2: record // Zweite Zeichenkette Length: Word; Value: array [0..vcFb - 1] of AnsiChar; Null: WordBool; end; v2Null: WordBool; end;

I had to use

IncInMessage = record v1: record // Erste Zeichenkette Length: Word; Value: array [0..vcFb - 1] of AnsiChar; end; v1Null: WordBool; v2: record // Zweite Zeichenkette Length: Smallint; Value: array [0..vcFb - 1] of AnsiChar; end; v2Null: WordBool; end;

Thank you guys.