Subject Re: [firebird-support] Re: Udr GenRows sample Pascal
Author livius
Hi,

i am delphi developer but i never hear about CodeTyphon!
I hear about lazarus but not this one.

But i need to do this under Delphi (Win64).
I tried many things but i always got empty string.
Only integer work and null flag.
I tried GetMem, ib_util_malloc but maybe this is wrong?
GenIntOutMessage = record
result: Integer;
resultNull: WordBool;
ss: PAnsiChar;
ssNull: WordBool;
end;

below full code


{
* The contents of this file are subject to the Mozilla Public License
Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Initial Developer of the Original Code is Adriano dos Santos
Fernandes.
* Portions created by the Initial Developer are Copyright (C) 2015 the
Initial Developer.
* All Rights Reserved.
*
* Contributor(s):
}

unit UdrGenInt;

interface

uses FbApi, System.Classes, System.SysUtils, System.Types;

{
recreate procedure gen_int_pascal (
nr Integer not null
) returns (
result Integer,
ss Char(5)
)
external name 'udr!gen_int'
engine udr;
}

type
GenIntInMessage = record
nr: Integer;
nrNull: WordBool;
end;

GenIntInMessagePtr = ^GenIntInMessage;

GenIntOutMessage = record
result: Integer;
resultNull: WordBool;
ss: PAnsiChar;
ssNull: WordBool;
end;

GenIntOutMessagePtr = ^GenIntOutMessage;

GenIntResultSet = class(ExternalResultSetImpl)
procedure dispose(); override;
function fetch(status: Status): Boolean; override;
public
currPoz: Integer;
inMessage: GenIntInMessagePtr;
outMessage: GenIntOutMessagePtr;
end;

GenIntProcedure = class(ExternalProcedureImpl)
procedure dispose(); override;

procedure getCharSet(status: Status; context: ExternalContext; name:
PAnsiChar;
nameSize: Cardinal); override;

function open(status: Status; context: ExternalContext; inMsg:
Pointer;
outMsg: Pointer): ExternalResultSet; override;
end;

GenIntFactory = class(UdrProcedureFactoryImpl)
procedure dispose(); override;

procedure setup(status: Status; context: ExternalContext; metadata:
RoutineMetadata;
inBuilder: MetadataBuilder; outBuilder: MetadataBuilder);
override;

function newItem(status: Status; context: ExternalContext;
metadata: RoutineMetadata): ExternalProcedure; override;
end;

implementation
uses System.StrUtils;

function ib_util_malloc(l: integer): pointer; cdecl; external 'ib_util.dll';

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

function GenIntResultSet.fetch(status: Status): Boolean;
Var s: String;
begin
if (currPoz > 5) then
Result := false
else
begin
outMessage.result:= currPoz;
outMessage.resultNull:= false;

s:= currPoz.ToString;
//GetMem(outMessage.ss, 3+1);
//outMessage.ss:= 'ABC' + #0;
outMessage.ss:= ib_util_malloc(3 + 1);
StrPCopy(outMessage.ss, 'ABC');

outMessage.ssNull:= false;

inc(currPoz);

Result := true;
end;
end;


procedure GenIntProcedure.dispose();
begin

destroy;
end;

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

function GenIntProcedure.open(status: Status; context: ExternalContext;
inMsg: Pointer;
outMsg: Pointer): ExternalResultSet;
var
Ret: GenIntResultSet;
begin
Ret:= GenIntResultSet.create();

Ret.inMessage := inMsg;
Ret.outMessage := outMsg;

Ret.currPoz:= Ret.inMessage.nr;

Ret.outMessage.resultNull := false;
Ret.outMessage.result := 0;

Result := Ret;
end;


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

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

end;

function GenIntFactory.newItem(status: Status; context: ExternalContext;
metadata: RoutineMetadata): ExternalProcedure;
begin
Result := GenIntProcedure.create;
end;


end.