Udr return varchar (delphi implementation)

[Michael Desboeufs]

I dont know how to fill the return parameter. Any help is appreciated.

Here the example :

create FUNCTION PL_GetMacAdresse()  RETURNS   VARCHAR(100) CHARACTER SET UTF8

The parameter output : 

  TOutput = record
    Value: record
      len: Smallint;
      str: array [0 .. 799] of AnsiChar;
    end;
    ValueNull: WordBool;
  end;
  TOutputPtr = ^TOutput;

procedure TGetMacAddressFunc.execute(AStatus: IStatus;
  AContext: IExternalContext; AInMsg: Pointer; AOutMsg: Pointer);
var
  xOutput   : TOutputPtr;

   StrTemp  : String;
begin

   StrTemp   := 'Value filled by code';

    xOutput.Value.str := ?? StrTemp ;

    xOutput.Value.len := ??;
    xOutput.ValueNull := False;

end;

Already thank you, if someone can help me. Should I allocate the memory, then copy the string ? But how to copy from string to AnsiChar with the right encoding?

In udf library  I was using :

    Result := ib_util_malloc(Length(StrValue) + 1);
    StrPCopy(Result, AnsiString(StrValue));

Should I use something similar ?

[Norbert Saint Georges]

documentation on UDRs in Pascal can be found here

https://firebirdsql.org/file/documentation/html/en/firebirddocs/udr-pascal/udr-pascal.html

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

[Michael Desboeufs]

Hello,

Thank you for the link. I already read several times this great documentation, before posting this question.

It is just I didn't find an example, or a way to understand how I must fill the varchar as a return value (and with the right encoding).

I already implemented several other external functions who works great. But they had an easy Integer return parameter.

[Norbert Saint Georges]

Michael Desboeufs a écrit :

> Hello,
>
> Thank you for the link. I already read several times this great
> documentation, before posting this question.
>
> It is just I didn't find an example, or a way to understand how I must fill
> the varchar as a return value (and with the right encoding).
> I already implemented several other external functions who works great. But
> they had an easy Integer return parameter.

below, an old piece of code written in Code Typhon ( I haven't tested
it with FB4 or 5 :-) )


unit UdrCharToInet6;

{$mode delphi}

interface

uses Firebird, sysutils, sockets;

type

Char6Procedure = class(IExternalFunctionImpl)
private
_in, _out, _inlength, _outlength : cardinal;
_inMessage: inmetata;
_outMessage: outmetata;
_inBuffer , _OutBuffer : 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;


//-------------------------------------------------------------//

Char6Factory = 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 Char6Procedure.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);
inherited create;
end;

procedure Char6Procedure.dispose();
begin
freemem(_inBuffer);
freemem(_outBuffer);
freemem(_InMessage);
freemem(_OutMessage);
destroy;
end;

procedure Char6Procedure.getCharSet(status: IStatus; context:
IExternalContext; name: PChar; nameSize: Cardinal);
begin
end;

procedure Char6Procedure.execute(status: IStatus; context:
IExternalContext; inMsg: Pointer; outMsg: Pointer);
var
fint6 : ansistring;
Entry : TIn6_Addr;
wordlen : word;
begin
try
try
setlength(fint6,48);

_inbuffer := pchar(inMsg);
_outbuffer := pchar(outMsg);

move(_inbuffer[_inMessage[0].Offset],Entry.u6_addr16[0],_inMessage[0].length);
fint6 := lowercase(HostAddrToStr6(Entry));
wordlen := length(fint6);

move(word(wordlen),_outbuffer[_outmessage[0].Offset],2);

move(pchar(fint6)^,_outbuffer[_outmessage[0].Offset+2],_outmessage[0].length-2);

move(_inbuffer[_inMessage[0].NullOffset],_outbuffer[_outMessage[0].NullOffset],2);

finally
setlength(fint6,0);
end;
except
on e:exception do begin
fbexcept := FbException.create(status);
e.message :='Char to Inet6 Function.execute, '+ e.message;
fbexcept.catchException(status,e);
end;
end;
end;

//-------------------------------------------------------------//



procedure Char6Factory.dispose();
begin
freemem(_InMessage);
freemem(_OutMessage);
destroy;
end;

procedure Char6Factory.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 ((_inlength<> 18) or (_outlength<>52)) then
raise exception.Create('Length error between input(CHAR(16)
CHARACTER SET OCTETS NOT NULL) and output(CHAR(48) CHARACTER SET OCTETS
NOT NULL)');
except
on e:exception do begin
fbexcept := FbException.create(status);
e.message :='Char to Inet6 Factory.setup, 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 :='Char to Inet6 Factory.setup, 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;
except
on e:exception do begin
fbexcept := FbException.create(status);
e.message :='Char to Inet6 Factory.setup, InMessage : '+
e.message;
fbexcept.catchException(status,e);
end;
end;
end;

function Char6Factory.newItem(status: IStatus; context:
IExternalContext; metadata: IRoutineMetadata):iExternalFunction;//
int16Procedure;
begin
Result := Char6Procedure.create(_in, _out, _inlength,
_outlength,_inMessage, _outMessage);
end;

end.

[Michael Desboeufs]

Thanks for the help and the example!

In the end. I implemented like this, and it seems to work. I inspired myself from the example of Norbert Saint Georges.

Here is the example updated :

procedure TGetMacAddressFunc.execute(AStatus: IStatus;
  AContext: IExternalContext; AInMsg: Pointer; AOutMsg: Pointer);
var
  xOutput   : TOutputPtr;

   StrTemp  : String;

   StrAnsiValue  : AnsiString;
begin

   StrTemp   := 'Value filled by code';

   StrAnsiValue := AnsiString( StrTemp);

   AnsiStrings.StrPLCopy(xOutput.Value.str, StrAnsiValue, Length(StrAnsiValue));

    xOutput.Value.len := Length(StrAnsiValue);
    xOutput.ValueNull := False;

end;