Subject | RE: [firebird-support] Re: Firebird 64 bit and UDF write in Delphi (32 bit) |
---|---|
Author | Slavomir Skopalik |
Post date | 2008-12-14T11:45:59Z |
Hi, there is short example:
Also IBX, JCL components are not familiar with Win64.
Any ASM code have to be replaced by pure pascal code.
It is recomended to start with some trivial task like RandG or Sleep
function.
Slavek.
compiler call:
SET fpc=C:\FPC\2.2.2\bin\i386-win32\ppcrossx64.exe -Mdelphi -B -FE"win64"
%fpc%
-Fu"D:\dokumenty\libext;D:\dokumenty\libext\fpc;C:\FPC\2.2.2\units\x86_64-wi
n64\fcl-base" masaudf.dpr
{
$Id: masaudf.dpr,v 1.11 2008/12/14 01:52:23 skopalik Exp $
Slavomir Skopalik Elekt Labs s.r.o. (c) 2004-2008
skopalik@...
Win32 build:
Compiler Delphi2007
Win64 build:
Compiler: FPC 2.2.2 for Win64 (cross compiler from Win32)
instaled into C:\fpc
}
library masaudf;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
windows,
SysUtils,
Classes,
math,
IB_Util, ibcrypt,
data_integrity,
P10Build in 'P10Build.pas',
Parser10 in 'Parser10.pas';
//
{$IFDEF WINDOWS}
{$IFNDEF FPC}
{$R *.RES}
{$ENDIF FPC}
{$ENDIF WINDOWS}
type
PInt = ^Longint;
// Encode BHD id into BHD code (add prefix and CRC)
{
DECLARE EXTERNAL FUNCTION BHDEncode
INTEGER
RETURNS CSTRING(31) FREE_IT
ENTRY_POINT 'BHDEncode' MODULE_NAME 'masaudf';
}
function BHDEncode(id: PInt): PChar; cdecl;
var
s: string;
begin
s := 'P' + Mod11NumberEncode(id^);
Result := ib_util_malloc(Length(s)+1);
StrCopy(Result,PChar(s));
end;
function BHDCheck(BHDCode: PChar): Longint; cdecl;
begin
Result := 0; // false
if Length(BHDCode) < 3 then Exit; // Prefix + Number + CRC
if BHDCode[0] <> 'P' then Exit; // Prefix must be 'P'
Result := Ord(Mod11NumberCheck(Copy(BHDCode, 2, MaxInt)));
end;
function BHDDecode(BHDCode: PChar): Longint; cdecl;
begin
Result := BHDCheck(BHDCode);
if Result = 0 then Exit;
Result := Mod11NumberDecode(Copy(BHDCode, 2, MaxInt));
end;
function CustomFormat(CustomFormule, CustomFormat: PChar; Value: PDouble):
PChar; cdecl;
var
s: string; x: Double;
Evaluator: TParser;
begin
Evaluator := TParser.Create(nil);
try
x := Value^;
if CustomFormule <> '' then begin
Evaluator.X:=x;
Evaluator.Expression:=CustomFormule;
x := Evaluator.Value;
end;
s := FormatFloat(CustomFormat, x);
except
on E: Exception do s := E.ClassName + ':' + E.Message;
end;
Evaluator.Free;
Result := ib_util_malloc(Length(s)+1);
StrCopy(Result, PChar(s));
end;
// Compute fast hash code from string (is not regular hash function)
function StringHash(s: PChar): Longint; cdecl;
var i:integer;
begin
result:=0;
if s=nil then exit;
i:=0;
while s[i]<>#0 do begin
Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor
Ord(s[i]);
inc(i);
end;
end;
{
DECLARE EXTERNAL FUNCTION Sleep
INTEGER
RETURNS INTEGER BY VALUE
ENTRY_POINT 'Sleep' MODULE_NAME 'masaudf';
}
function Sleep(time:PINT):integer; cdecl;
begin
result:=0;
if time=nil then exit;
windows.Sleep(time^);
end;
function RandG(Mean, StdDev:PDouble ):double; cdecl;
begin
result:=math.RandG(Mean^,StdDev^);
end;
{
/* This function generate random value 0 <= x < range */
DECLARE EXTERNAL FUNCTION RandRange
INTEGER
RETURNS DOUBLE PRECISION BY VALUE
ENTRY_POINT 'RandRange' MODULE_NAME 'del_udf';
}
function RandRange(Range:PInteger):double; cdecl;
begin
result:=Random()*Range^;
end;
{
/* This function setup random generator */
DECLARE EXTERNAL FUNCTION RandSeed
RETURNS INTEGER BY VALUE
ENTRY_POINT 'RandSeed' MODULE_NAME 'del_udf';
}
function RandSeed:integer;cdecl;
begin
Randomize;
result:=0;
end;
function IBPassword(Password:PChar):PChar; cdecl;
var s:string;
begin
s:=CryptPassword(Password);
result:=ib_util_malloc(Length(s)+1);
StrCopy(result,PChar(s));
end;
function IBCreateUser(User,Password,FirstName,LastName:PChar):integer;
cdecl;
begin
result:=0;
end;
function IBDeleteUser(User:PChar):integer; cdecl;
begin
result:=0;
end;
exports
BHDEncode, BHDDecode, BHDCheck,
CustomFormat,
StringHash,
Sleep,
RandG, RandRange, RandSeed,
IBPassword, IBCreateUser, IBDeleteUser;
begin
end.
-----Original Message-----
From: firebird-support@yahoogroups.com
[mailto:firebird-support@yahoogroups.com] On Behalf Of mohamed.banaouas
Sent: Sunday, December 14, 2008 6:36 AM
To: firebird-support@yahoogroups.com
Subject: [firebird-support] Re: Firebird 64 bit and UDF write in Delphi (32
bit)
Hi Slavek,
I'm trying to compile a firebird udf library with freepascal, but I
get many warnings and errors. I'm not sure to have all necessary units
(udf_glob.pas, ibase.pas) nor setting the right compilation switches.
I already build it with delphi5 and it works fine in fb v1...v2.1.
My goal is to get a 64bit version.
Please, can you tell me which units to use? in other words, can you
give me a sample project with a (very) simple udf ?
thank you
--- In firebird-support@ <mailto:firebird-support%40yahoogroups.com>
yahoogroups.com, "Slavomir Skopalik"
<skopalik@...> wrote:
<http://geo.yahoo.com/serv?s=97359714/grpId=2442406/grpspId=1705115386/msgId
=99061/stime=1229232967/nc1=1/nc2=2/nc3=3>
[Non-text portions of this message have been removed]
Also IBX, JCL components are not familiar with Win64.
Any ASM code have to be replaced by pure pascal code.
It is recomended to start with some trivial task like RandG or Sleep
function.
Slavek.
compiler call:
SET fpc=C:\FPC\2.2.2\bin\i386-win32\ppcrossx64.exe -Mdelphi -B -FE"win64"
%fpc%
-Fu"D:\dokumenty\libext;D:\dokumenty\libext\fpc;C:\FPC\2.2.2\units\x86_64-wi
n64\fcl-base" masaudf.dpr
{
$Id: masaudf.dpr,v 1.11 2008/12/14 01:52:23 skopalik Exp $
Slavomir Skopalik Elekt Labs s.r.o. (c) 2004-2008
skopalik@...
Win32 build:
Compiler Delphi2007
Win64 build:
Compiler: FPC 2.2.2 for Win64 (cross compiler from Win32)
instaled into C:\fpc
}
library masaudf;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
windows,
SysUtils,
Classes,
math,
IB_Util, ibcrypt,
data_integrity,
P10Build in 'P10Build.pas',
Parser10 in 'Parser10.pas';
//
{$IFDEF WINDOWS}
{$IFNDEF FPC}
{$R *.RES}
{$ENDIF FPC}
{$ENDIF WINDOWS}
type
PInt = ^Longint;
// Encode BHD id into BHD code (add prefix and CRC)
{
DECLARE EXTERNAL FUNCTION BHDEncode
INTEGER
RETURNS CSTRING(31) FREE_IT
ENTRY_POINT 'BHDEncode' MODULE_NAME 'masaudf';
}
function BHDEncode(id: PInt): PChar; cdecl;
var
s: string;
begin
s := 'P' + Mod11NumberEncode(id^);
Result := ib_util_malloc(Length(s)+1);
StrCopy(Result,PChar(s));
end;
function BHDCheck(BHDCode: PChar): Longint; cdecl;
begin
Result := 0; // false
if Length(BHDCode) < 3 then Exit; // Prefix + Number + CRC
if BHDCode[0] <> 'P' then Exit; // Prefix must be 'P'
Result := Ord(Mod11NumberCheck(Copy(BHDCode, 2, MaxInt)));
end;
function BHDDecode(BHDCode: PChar): Longint; cdecl;
begin
Result := BHDCheck(BHDCode);
if Result = 0 then Exit;
Result := Mod11NumberDecode(Copy(BHDCode, 2, MaxInt));
end;
function CustomFormat(CustomFormule, CustomFormat: PChar; Value: PDouble):
PChar; cdecl;
var
s: string; x: Double;
Evaluator: TParser;
begin
Evaluator := TParser.Create(nil);
try
x := Value^;
if CustomFormule <> '' then begin
Evaluator.X:=x;
Evaluator.Expression:=CustomFormule;
x := Evaluator.Value;
end;
s := FormatFloat(CustomFormat, x);
except
on E: Exception do s := E.ClassName + ':' + E.Message;
end;
Evaluator.Free;
Result := ib_util_malloc(Length(s)+1);
StrCopy(Result, PChar(s));
end;
// Compute fast hash code from string (is not regular hash function)
function StringHash(s: PChar): Longint; cdecl;
var i:integer;
begin
result:=0;
if s=nil then exit;
i:=0;
while s[i]<>#0 do begin
Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor
Ord(s[i]);
inc(i);
end;
end;
{
DECLARE EXTERNAL FUNCTION Sleep
INTEGER
RETURNS INTEGER BY VALUE
ENTRY_POINT 'Sleep' MODULE_NAME 'masaudf';
}
function Sleep(time:PINT):integer; cdecl;
begin
result:=0;
if time=nil then exit;
windows.Sleep(time^);
end;
function RandG(Mean, StdDev:PDouble ):double; cdecl;
begin
result:=math.RandG(Mean^,StdDev^);
end;
{
/* This function generate random value 0 <= x < range */
DECLARE EXTERNAL FUNCTION RandRange
INTEGER
RETURNS DOUBLE PRECISION BY VALUE
ENTRY_POINT 'RandRange' MODULE_NAME 'del_udf';
}
function RandRange(Range:PInteger):double; cdecl;
begin
result:=Random()*Range^;
end;
{
/* This function setup random generator */
DECLARE EXTERNAL FUNCTION RandSeed
RETURNS INTEGER BY VALUE
ENTRY_POINT 'RandSeed' MODULE_NAME 'del_udf';
}
function RandSeed:integer;cdecl;
begin
Randomize;
result:=0;
end;
function IBPassword(Password:PChar):PChar; cdecl;
var s:string;
begin
s:=CryptPassword(Password);
result:=ib_util_malloc(Length(s)+1);
StrCopy(result,PChar(s));
end;
function IBCreateUser(User,Password,FirstName,LastName:PChar):integer;
cdecl;
begin
result:=0;
end;
function IBDeleteUser(User:PChar):integer; cdecl;
begin
result:=0;
end;
exports
BHDEncode, BHDDecode, BHDCheck,
CustomFormat,
StringHash,
Sleep,
RandG, RandRange, RandSeed,
IBPassword, IBCreateUser, IBDeleteUser;
begin
end.
-----Original Message-----
From: firebird-support@yahoogroups.com
[mailto:firebird-support@yahoogroups.com] On Behalf Of mohamed.banaouas
Sent: Sunday, December 14, 2008 6:36 AM
To: firebird-support@yahoogroups.com
Subject: [firebird-support] Re: Firebird 64 bit and UDF write in Delphi (32
bit)
Hi Slavek,
I'm trying to compile a firebird udf library with freepascal, but I
get many warnings and errors. I'm not sure to have all necessary units
(udf_glob.pas, ibase.pas) nor setting the right compilation switches.
I already build it with delphi5 and it works fine in fb v1...v2.1.
My goal is to get a 64bit version.
Please, can you tell me which units to use? in other words, can you
give me a sample project with a (very) simple udf ?
thank you
--- In firebird-support@ <mailto:firebird-support%40yahoogroups.com>
yahoogroups.com, "Slavomir Skopalik"
<skopalik@...> wrote:
>.
> Hi,
> I was test FPC for Win64 UDF and works fine :).
>
> Just try it.
>
> http://www.freepasc <http://www.freepascal.org/> al.org/
>
> Slavek
>
>
<http://geo.yahoo.com/serv?s=97359714/grpId=2442406/grpspId=1705115386/msgId
=99061/stime=1229232967/nc1=1/nc2=2/nc3=3>
[Non-text portions of this message have been removed]