欢迎访问 Forcal程序设计

用Delphi设计Forcal扩展动态库的简单例子

1 本例子是用Delphi7实现的，动态库工程名为DelphiFcDll。

2 DelphiFcDll.dll中注册了两个实数函数和实数常量，用Forcal代码演示如下：

> delphi::aaa; //常量delphi::aaa
> delphi::bbb; //常量delphi::bbb
> delphi::add[2,3]; //函数delphi::add用于计算两个数的和
> f(x,y)=x+y+2;
> delphi::CalRFor[HFor("f"),5,6]; //函数delphi::CalRFor接受一个实数函数句柄和参数，计算该函数的值；本例相当于执行f(5,6)

计算结果：

> 111.
> 222.
> 5.
> 13.

使用命名空间delphi可简化代码的书写，如下所示：

> !using["delphi"];
> aaa+bbb+add[2,3];
> f(x,y)=x+y+2;
> CalRFor[HFor("f"),5,6];

计算结果：

> 338.
> 13.

3 Delphi源代码

library DelphiFcDll;
{ 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;
type
//Forcal函数类型声明，有些声明没有使用
fcGetRunErr=procedure(var ErrType:integer; var FunName:PWideChar; var FunCode:integer; var ForType:integer; var ForHandle:Pointer); stdcall; //获得FORCAL运行错误
fcTestRunErr=function:integer; stdcall; //测试FORCAL运行错误
fcSetRunErr=procedure(ErrType:integer; FunName:PWideChar; FunCode:integer; ForType:integer; ForHandle:Pointer); stdcall; //设置FORCAL运行错误
fcRealCom=function(ForStr:PWideChar; nModule:integer; var hFor:Pointer; var nPara:integer; var Para:Pdouble; var ErrBegin:integer; var ErrEnd:integer):integer; stdcall; //编译实数表达式
fcRealCal=function(hFor:Pointer; Para:Pdouble):double; stdcall; //计算实数表达式的值
fcIntCom=function(ForStr:PWideChar; nModule:integer; var hFor:Pointer; var nPara:integer; var Para:PInt64; var ErrBegin:integer; var ErrEnd:integer):integer; stdcall; //编译整数表达式
fcIntCal=function(hFor:Pointer; Para:PInt64):Int64; stdcall; //计算整数表达式的值
fcSetFunction=function(FunType:integer; FunName:PWideChar; Fun:Pointer; ParaNum:integer):integer; stdcall; //设置外部二级函数
fcSetConst=function(ConstType:integer; ConstName:PWideChar; ConstValue:Pointer):integer; stdcall; //设置常量
fcDeleteConstOrFunction=function(iType:integer; Name:PWideChar):boolean; stdcall; //删除常量或二级函数
fcGetFor=function(ForName:PWideChar; ForType:integer; hFor:Pointer; var nModule:integer; var myFor:Pointer; var Para:Pinteger; var PareNum:integer):boolean; stdcall; //获得表达式信息
fcParaModify=function(ForType:integer; vFor:Pointer):boolean; stdcall; //判断表达式的自变量是否重新赋值
fcGetForStr=procedure(hFor:Pointer; var ForStr:PWideChar; var StrMin:integer; var StrMax:integer); stdcall; //获得表达式中的字符串
fcSearchKey=function(a:Pchar; len:Longint; k:Longint):Pointer; stdcall; //用户查找一个键
fcDelete=procedure(p:Pointer); stdcall; //删除键值函数
fcInsertKey=function(a:Pchar; len:Longint; k:Longint; p:Pointer; d:fcDelete; var v:Pointer):integer; stdcall;//用户插入一个键
var
TestRunErr:fcTestRunErr;
SetRunErr:fcSetRunErr;
SetFunction:fcSetFunction;
SetConst:fcSetConst;
DeleteConstOrFunction:fcDeleteConstOrFunction;
RealCal:fcRealCal;
GetFor:fcGetFor;
//一些变量
AddName:array[0..100] of WideChar;
CalRForName:array[0..100] of WideChar;
aaa_RealConstName:array[0..100] of WideChar;
bbb_RealConstName:array[0..100] of WideChar;
aaa_RealConst:double=111.0;
bbb_RealConst:double=222.0;
{$R *.res}
function Add(m: integer; x:Pdouble; rFor:Pointer): double; stdcall;
var
a,b:double;
begin
a:=x^;
inc(x);
b:=x^;
Result :=a+b;
end;
function CalRFor(m: integer; x:Pdouble; rFor:Pointer): double; stdcall;
var
ErrName:PWideChar;
hFor:Pointer;
nModule:integer;
vPara:Pinteger;
nPara:integer;
begin
Result := 0.0;
ErrName:=CalRForName;
if m<0 then //至少要1个参数
begin
if TestRunErr()=0 then
begin
SetRunErr(2,ErrName,1,0,rFor);
end;
Exit;
end;
hFor:=Pointer(Pinteger(x)^);
if GetFor(nil,2,hFor,nModule,hFor,vPara,nPara)=false then //指定的表达式不存在
begin
if TestRunErr()=0 then
begin
SetRunErr(2,ErrName,2,0,rFor);
end;
Exit;
end;
if nPara<>m-1 then //参数不匹配
begin
if TestRunErr()=0 then
begin
SetRunErr(2,ErrName,3,0,rFor);
end;
Exit;
end;
inc(x);
Result := RealCal(hFor,x);
end;
function FcDll32W(hForcal:THandle;bInit:boolean; me:Pointer):integer; stdcall;
begin
StringToWideChar('delphi::add',AddName,100);
StringToWideChar('delphi::CalRFor',CalRForName,100);
StringToWideChar('delphi::aaa',aaa_RealConstName,100);
StringToWideChar('delphi::bbb',bbb_RealConstName,100);
if bInit then
begin
@TestRunErr:=GetProcAddress(hForcal,'TestRunErr');
@SetRunErr:=GetProcAddress(hForcal,'SetRunErr');
@SetFunction:=GetProcAddress(hForcal,'SetFunction');
@SetConst:=GetProcAddress(hForcal,'SetConst');
@DeleteConstOrFunction:=GetProcAddress(hForcal,'DeleteConstOrFunction');
@RealCal:=GetProcAddress(hForcal,'RealCal');
@GetFor:=GetProcAddress(hForcal,'GetFor');
if ((@TestRunErr=nil) or (@SetRunErr=nil) or (@SetFunction=nil) or (@SetConst=nil) or (@DeleteConstOrFunction=nil) or (@RealCal=nil) or (@GetFor=nil)) then
begin
Result := 0;
exit;
end;
SetFunction(5,AddName,@Add,1); //注册实数函数
SetFunction(5,CalRForName,@CalRFor,-2); //注册实数函数
SetConst(8,aaa_RealConstName,@aaa_RealConst); //注册实数常量
SetConst(8,bbb_RealConstName,@bbb_RealConst); //注册实数常量
end
else
begin
DeleteConstOrFunction(5,AddName); //注销实数函数
DeleteConstOrFunction(5,CalRForName); //注销实数函数
DeleteConstOrFunction(8,aaa_RealConstName); //注销实数常量
DeleteConstOrFunction(8,bbb_RealConstName); //注销实数常量
end;
Result := 1;
end;
exports
FcDll32W;
begin
end.

版权所有© Forcal程序设计 2002-2011，保留所有权利
E-mail: forcal@sina.com QQ：630715621
最近更新: 2011年05月03日