'livius' liviusliv...@poczta.onet.pl [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
------------------------------------
------------------------------------
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Visit http://www.firebirdsql.org and click the Documentation item
on the main (top) menu. Try FAQ and other links from the left-side menu there.
Also search the knowledgebases at http://www.ibphoenix.com/resources/documents/
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
------------------------------------
Yahoo Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/firebird-support/
<*> Your email settings:
Individual Email | Traditional
<*> To change settings online go to:
http://groups.yahoo.com/group/firebird-support/join
(Yahoo! ID required)
<*> To change settings via email:
firebird-support-dig...@yahoogroups.com
firebird-support-fullfeatu...@yahoogroups.com
<*> To unsubscribe from this group, send an email to:
firebird-support-unsubscr...@yahoogroups.com
<*> Your use of Yahoo Groups is subject to:
https://info.yahoo.com/legal/us/yahoo/utos/terms/
