Subject | Re: [firebird-support] Re: Udr GenRows sample Pascal |
---|---|
Author | livius |
Post date | 2018-05-14T20:18:39Z |
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.
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.