'livius' liviuslivius@... [firebird-support] a écrit :

> Anybody?
>
> regards,
> Karol Bieniaszewski

HI,

little bit of functional code written with codetyphon.


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('+inttostr(_inlength-2)+') and
output('+inttostr(_outlength-2)+')');
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.

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