260 lines
8.9 KiB
Plaintext
260 lines
8.9 KiB
Plaintext
unit utssvr_api_c;
|
||
interface
|
||
function get_tssvr_api_c();
|
||
function get_func_finder_register();
|
||
implementation
|
||
function get_tssvr_api_c();
|
||
begin
|
||
return static new t_tssvr_api_c();
|
||
end
|
||
function get_func_finder_register();
|
||
begin
|
||
return static new t_func_finder_register();
|
||
end
|
||
type tsl_c_api_const = class()
|
||
{$ifdef linux}
|
||
static const C_TSSVRAPI="libTSSVRAPI.so";
|
||
static const C_PLUGIN="libTSLPlugin.so";
|
||
static const C_TSLInterp="libTSLInterp.so";
|
||
{$else}
|
||
static const C_TSSVRAPI="TSSVRAPI.dll";
|
||
static const C_PLUGIN="TSLPlugin.dll";
|
||
static const C_TSLInterp="TSLInterp.dll";
|
||
{$endif}
|
||
end
|
||
type t_func_finder_register = class(tsl_c_api_const) //º¯Êý×¢²áÀàÐÍ
|
||
function create();
|
||
begin
|
||
t := C_TSSVRAPI;
|
||
fhookseted := false;
|
||
fhooks := array();
|
||
end
|
||
function add_hook(f);
|
||
begin
|
||
for i,v in fhooks do
|
||
begin
|
||
if v=f then return 0;
|
||
end
|
||
fhooks[length(fhooks)] := f;
|
||
if not fhookptr then fhookptr := makeinstance(thisfunction(find_HOOK));
|
||
if not fhookseted then TSL_InterpSetFindFunctionHook(fhookptr);
|
||
end
|
||
function del_hook(f);
|
||
begin
|
||
len := length(fhooks)-1;
|
||
for i:= 0 to len do
|
||
begin
|
||
if f=fhooks[i] then
|
||
begin
|
||
if len=0 then
|
||
begin
|
||
TSL_InterpSetFindFunctionHook(0);
|
||
fhookseted := false;
|
||
end
|
||
return 1;
|
||
end
|
||
end
|
||
end
|
||
function find_HOOK(L:pointer;iUser:string;iName:string; oResult:object):integer;cdecl;
|
||
begin
|
||
for i,_f_ in fhooks do
|
||
begin
|
||
r := ##_f_(L,iUser,iName);
|
||
if ifstring(r) and r then
|
||
begin
|
||
oResult := array("body":r);
|
||
return 1;
|
||
end
|
||
end
|
||
end
|
||
function destroy();
|
||
begin
|
||
if fhookptr then deleteinstance(fhookptr);
|
||
fhookptr := 0;
|
||
end
|
||
private
|
||
function TSL_InterpSetFindFunctionHook(hook);
|
||
begin
|
||
c := static function(hook:pointer);cdecl;external getdlsymaddress(C_TSLInterp,functionname(1)) ;
|
||
return call(c,hook) ;
|
||
end
|
||
private
|
||
fhookseted;
|
||
fhookptr;
|
||
fhooks;
|
||
end
|
||
type t_tssvr_api_c = class(tsl_c_api_const)
|
||
function create();
|
||
begin
|
||
t := C_TSSVRAPI;
|
||
isok := 0;
|
||
if not getglobalcache("@@tsl_c_api@@",isok) then
|
||
begin
|
||
setglobalcache("@@tsl_c_api@@","tsl_c_api");
|
||
reg_libpath_funcs();
|
||
end
|
||
end
|
||
class function TSL_ObjToStr(L:pointer;v:pointer):string;
|
||
begin
|
||
_f_ := static function(L:pointer;v:pointer;Topest:integer):string;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,v,1);
|
||
end
|
||
class function TSL_DelStrm(d:pointer);
|
||
begin
|
||
_f_ := static procedure(d:pointer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(d);
|
||
end
|
||
class function TSL_ObjToStrm(L:pointer;v:pointer);
|
||
begin
|
||
_f_ := static function(L:pointer;v:pointer;PackedTable:integer;precision:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,v,0,-1);
|
||
end
|
||
class function TSL_StrmToObj(L:pointer;v:pointer;ot:pointer);
|
||
begin
|
||
_f_ := static function(L:pointer;v:pointer;ot:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,v,ot);
|
||
end
|
||
class function TS_GetGlobalL();
|
||
begin
|
||
_f_ := static function():pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_();
|
||
end
|
||
//×¢²áº¯ÊýÏà¹Ø
|
||
class function TSL_SetIntPtr(l:pointer;o:pointer;i:pointer);
|
||
begin
|
||
_f_ := static procedure(l:pointer;o:pointer;i:pointer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(l,o,i);
|
||
end
|
||
class function TSL_StringCheck(O:pointer):integer;
|
||
begin
|
||
_f_ := static function(o:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(o);
|
||
end
|
||
|
||
class function TSL_SetInt(l:pointer;o:pointer;i:integer);
|
||
begin
|
||
_f_ := static procedure(l:pointer;o:pointer;i:integer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(l,o,i);
|
||
end
|
||
class function get_self_l_i(L:pointer; iArgs:pointer;iNum:integer; oResult:pointer):integer;cdecl;
|
||
begin
|
||
TSL_SetIntPtr(L,oResult,L);
|
||
return 1;
|
||
end
|
||
class function set_self_libpath(L:pointer; iArgs:pointer;iNum:integer; oResult:pointer):integer;cdecl;
|
||
begin
|
||
IF iNum=1 and TSL_StringCheck(iArgs) then
|
||
begin
|
||
s := TSL_AsString(iArgs);
|
||
p := TSL_Strdup(s);
|
||
TSL_SetString(L,oResult,TSL_SetLibPath(L, p));
|
||
return 1;
|
||
end
|
||
return 0;
|
||
end
|
||
class function get_self_libpath(L:pointer; iArgs:pointer;iNum:integer; oResult:pointer):integer;cdecl;
|
||
begin
|
||
TSL_SetString(L,oResult,TSL_GetLibPath(L));
|
||
return 1;
|
||
end
|
||
class function tslL_register(l:pointer;n:string;f:pointer);
|
||
begin
|
||
_f_ := static procedure(l:pointer;n:string;f:pointer);cdecl;external getdlsymaddress(C_PLUGIN,functionname(1));
|
||
return ##_f_(l,n,f);
|
||
end
|
||
class function TSL_SetString(L,O,S);
|
||
begin
|
||
_f_ := static function(l:pointer;o:pointer;s:string):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,O,S);
|
||
end
|
||
class function TSL_Strdup(s):string;
|
||
begin
|
||
_f_ := static function(s:string):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(s);
|
||
end
|
||
class function TSL_GetLibPath(L);
|
||
begin
|
||
_f_ := static function(L:pointer):string;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1));
|
||
return ##_f_(L);
|
||
end
|
||
class function TSL_SetLibPath(L,p);
|
||
begin
|
||
_f_ := static function(L:pointer;p:pointer):string;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1));
|
||
return ##_f_(L,p);
|
||
end
|
||
class function TSL_AsInt(O);
|
||
begin
|
||
_f_ := static function(O:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(o);
|
||
end
|
||
class function TSL_AsIntPtr(O);
|
||
begin
|
||
_f_ := static function(O:pointer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(o);
|
||
end
|
||
class function TSL_NumberCheck(O);
|
||
begin
|
||
_f_ := static function(O:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(o);
|
||
end
|
||
|
||
class function TSL_AsString(O);
|
||
begin
|
||
_f_ := static function(O:pointer):string;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(o);
|
||
end
|
||
class function TSL_SetType(L,O,t);
|
||
begin
|
||
{
|
||
#define TSL_TINT 0 //32λÕûÊý
|
||
#define TSL_TNUMBER 1 //64λ¸¡µã
|
||
#define TSL_TSZSTRING 2 //×Ö·û´®
|
||
#define TSL_TTABLE 5 //Êý×é
|
||
#define TSL_TSTRING 6 //×Ö·û´®Ï±ê,½ö×÷ΪÊý×éµÄϱê
|
||
#define TSL_TGRAPH 8 //ͼÐÎ
|
||
#define TSL_TGRAPHGROUP 9 //ͼÐÎ×é
|
||
#define TSL_TNIL 10 //NILÀàÐÍ
|
||
#define TSL_TBINARY 11 //¶þ½øÖÆÀàÐÍ
|
||
#define TSL_TUNKNOWN 14 //COMÀàÐÍIUNKNOWN
|
||
#define TSL_TDISPATCH 15 //COMÀàÐÍIDISPATCH
|
||
#define TSL_TANY 16 //TSLÃæÏò¶ÔÏóÀàÐÍ
|
||
#define TSL_TMatrix 17 //MatrixÀàÐÍ,MSelect·µ»Ø
|
||
#define TSL_TINT64 20 //64λÕûÊý
|
||
#define TSL_TClassFieldRef 22 //Àà³ÉÔ±ÒýÓÃ
|
||
#define TSL_TFUNCTIONSELF 23 //ÓÃSELF»ñµÃµÄ½á¹û
|
||
#define TSL_TWSTRING 24 //UnicodeString
|
||
#define TSL_TCFUNCTION 25 //¶þ½øÖƺ¯ÊýÖ¸Õë
|
||
#define TSL_TNONE (-1) //ÎÞÀàÐÍ£¬´ËÀàÐͲ»»á±»Ê¹Ó㬽ö×÷ΪÌØÊâÓÃ;
|
||
}
|
||
_f_ := static procedure(L:pointer;o:pointer;t:integer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,O,t);
|
||
end
|
||
class function TSL_GetParamRef(L,idx);
|
||
begin
|
||
_f_ := static function(L:pointer;idx:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,idx);
|
||
end
|
||
class function TSL_ReadINTPtrFromPtr(p,idx);
|
||
begin
|
||
_f_ := static function(p:pointer;idx:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(p,idx);
|
||
end
|
||
class function TSL_ReadTObjectFromPtr(p,idx);
|
||
begin
|
||
_f_ := static function(p:pointer;idx:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(p,idx);
|
||
end
|
||
private
|
||
class function reg_libpath_funcs();//×¢²áÐèÒªµÄº¯Êý
|
||
begin
|
||
tslL_register(0,"get_self_libpath",makeinstance(thisfunction(get_self_libpath),"cdecl",0));
|
||
tslL_register(0,"set_self_libpath",makeinstance(thisfunction(set_self_libpath),"cdecl",0));
|
||
end
|
||
//
|
||
end
|
||
|
||
initialization
|
||
|
||
|
||
|
||
end. |