更新
This commit is contained in:
tslediter 2024-04-23 15:16:15 +08:00
parent d560c062d2
commit 8239223d05
23 changed files with 415 additions and 307 deletions

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -5241,7 +5241,7 @@ type tfincodemap = class(tcustomcontrol)
end else end else
FString := s; FString := s;
flistv := getblocktypes(); flistv := getblocktypes();
if s then r := unit(utssvr_tsltoken_c).get_tsl_tokenizeex(s,flistv);// tsl_tokenizeex_2_(s,flistv); if s then r := unit(utssvr_api_c).get_tsl_tokenizeex(s,flistv);// tsl_tokenizeex_2_(s,flistv);
else r := array(); else r := array();
fcaretya := -1; fcaretya := -1;
fcaretyb := -1; fcaretyb := -1;

View File

@ -339,7 +339,7 @@ type TTSLCompletion= class(TSynCompletion)
r[idx]["order"] := 0; r[idx]["order"] := 0;
idx++; idx++;
end end
gjz := unit(utssvr_tsltoken_c).get_sys_functions();//tslL_getfunctions_2_(); gjz := unit(utssvr_api_c).get_sys_functions();//tslL_getfunctions_2_();
for i,v in gjz do for i,v in gjz do
begin begin
c := v+" <sysfun>"; c := v+" <sysfun>";
@ -400,7 +400,7 @@ type TTslSynHighLighter = class(TSynHighLighter)
FKeyWords[v] := v; FKeyWords[v] := v;
end end
FBinFunc := array(); FBinFunc := array();
for i,v in unit(utssvr_tsltoken_c).get_sys_functions() do for i,v in unit(utssvr_api_c).get_sys_functions() do
begin begin
FBinFunc[v]:=v; FBinFunc[v]:=v;
end end
@ -1885,7 +1885,7 @@ type TTsfFileParser = class() //
s := d["value"]; s := d["value"];
if not(s and ifstring(s)) then return rt ; if not(s and ifstring(s)) then return rt ;
if errtslcode(s) then return rt; if errtslcode(s) then return rt;
r := unit(utssvr_tsltoken_c).get_tsl_tokenizeex(s,1);//tsl_tokenizeex_2_(s,1); r := unit(utssvr_api_c).get_tsl_tokenizeex(s,1);//tsl_tokenizeex_2_(s,1);
if not( r and ifarray(r)) then return rt; if not( r and ifarray(r)) then return rt;
cls := array(); cls := array();
ScriptDelBlocks(r["blcks"],str2array(s,"\n"),cls); ScriptDelBlocks(r["blcks"],str2array(s,"\n"),cls);
@ -2176,7 +2176,7 @@ type TTsfFileParser = class() //
r := array(); r := array();
rdd := ""; rdd := "";
end else end else
r := unit(utssvr_tsltoken_c).get_tsl_tokenizeex(rdd,1);//tsl_tokenizeex_2_(rdd,1); r := unit(utssvr_api_c).get_tsl_tokenizeex(rdd,1);//tsl_tokenizeex_2_(rdd,1);
end else end else
begin begin
r := array(); r := array();

View File

@ -1549,7 +1549,7 @@ type TTslDebuga=class(TCustomControl)
FRuningfile := item.OrigScriptPath; // %% E:\TSUIGROUP\script\tgdb.tsl%%; FRuningfile := item.OrigScriptPath; // %% E:\TSUIGROUP\script\tgdb.tsl%%;
FDebugtsfs["__main__"]:= FRuningfile; FDebugtsfs["__main__"]:= FRuningfile;
ls := item.FEditer.lines; ls := item.FEditer.lines;
d := unit(utssvr_tsltoken_c).get_tsl_tokenizeex(item.FEditer.Text,0xffff);//tsl_tokenizeex_2_(item.FEditer.Text,0xffff); d := unit(utssvr_api_c).get_tsl_tokenizeex(item.FEditer.Text,0xffff);//tsl_tokenizeex_2_(item.FEditer.Text,0xffff);
for i,v in d["blcks"] do for i,v in d["blcks"] do
begin begin
s := ls.GetStringByIndex(v["mbeg"]-1); s := ls.GetStringByIndex(v["mbeg"]-1);

View File

@ -2074,8 +2074,8 @@ begin
unit(utssvr_api_c).get_tssvr_api_c(); unit(utssvr_api_c).get_tssvr_api_c();
np := getdesignerpath()+"dcmps"+ioFileseparator(); np := getdesignerpath()+"dcmps"+ioFileseparator();
CreateDirWithFileName(np+"1.txt"); CreateDirWithFileName(np+"1.txt");
g_orig_lib_path := get_self_libpath()+";"+Getfuncextdir();//tsl_getlibpath_() g_orig_lib_path := sysgettsllibpath()+";"+Getfuncextdir();//tsl_getlibpath_()
set_self_libpath( np+";"+g_orig_lib_path);//tsl_setlibpath_ syssettsllibpath( np+";"+g_orig_lib_path);//tsl_setlibpath_
ini := static getdesginerini(); ini := static getdesginerini();
//class(TDSocketServer),class(TDSocketClient), //class(TDSocketServer),class(TDSocketClient),
//注册的componet //注册的componet

Binary file not shown.

View File

@ -1232,7 +1232,7 @@ type t_mem_mgr = class()
//if not _tool then //if not _tool then
_tool := 0; _tool := 0;
try try
_tool := new aefclassobj_(); if findclass("aefclassobj_") then _tool := new aefclassobj_();
except except
end; end;

View File

@ -6088,7 +6088,7 @@ type Ttfm2Component = class(TTmfParser)
function GetLibPaths(); //»ñµÃlibpath function GetLibPaths(); //»ñµÃlibpath
begin begin
unit(utssvr_api_c).get_tssvr_api_c(); unit(utssvr_api_c).get_tssvr_api_c();
p := get_self_libpath(); p := sysgettsllibpath();
if not p then return array(); if not p then return array();
wapi := gettswin32api(); wapi := gettswin32api();
FCurrentp := wapi.get_current_directory(); FCurrentp := wapi.get_current_directory();

View File

@ -1,6 +1,7 @@
unit utslvclcefinterface; unit utslvclcefinterface;
interface interface
uses cstructurelib; uses cstructurelib;
function cef_version_info(entry:integer);
function cef_object_get(ptr,cls); function cef_object_get(ptr,cls);
function cef_object_del(ptr); function cef_object_del(ptr);
function cef_dictionary_value_create(); function cef_dictionary_value_create();

View File

@ -2,7 +2,10 @@ unit utssvr_api_c;
interface interface
function get_tssvr_api_c(); function get_tssvr_api_c();
function get_func_finder_register(); function get_func_finder_register();
function get_sys_functions();
function get_tsl_tokenizeex(s,flg);
implementation implementation
uses cstructurelib;
function get_tssvr_api_c(); function get_tssvr_api_c();
begin begin
return static new t_tssvr_api_c(); return static new t_tssvr_api_c();
@ -11,6 +14,21 @@ function get_func_finder_register();
begin begin
return static new t_func_finder_register(); return static new t_func_finder_register();
end end
function get_sys_functions();
begin
return static get_tokener().tslL_getfunctions();
end
function get_tsl_tokenizeex(s,flg);
begin
o := get_tokener();
o.flags := flg;
o.source := s;
return o.result();
end
function get_tokener();
begin
return static new t_tsltokenex2();
end
type tsl_c_api_const = class() type tsl_c_api_const = class()
{$ifdef linux} {$ifdef linux}
static const C_TSSVRAPI="libTSSVRAPI.so"; static const C_TSSVRAPI="libTSSVRAPI.so";
@ -22,9 +40,25 @@ type tsl_c_api_const = class()
static const C_TSLInterp="TSLInterp.dll"; static const C_TSLInterp="TSLInterp.dll";
{$endif} {$endif}
end end
function main_thread_check(ck_name);
begin
myid := systhreadid();
mytd := nil;
if getglobalcache(ck_name,mytd) then
begin
return mytd<>myid;
end else
begin
setglobalcache(ck_name,myid);
end
return false ;
end
type t_func_finder_register = class(tsl_c_api_const) //函数注册类型 type t_func_finder_register = class(tsl_c_api_const) //函数注册类型
function create(); function create();
begin begin
////////////////////////////////////////////////////////////////
if main_thread_check("~@~create-thread-func-finder~@~") then raise "t_func_finder_register created must in main thread!";
//////////////////////////////////////////////////////
t := C_TSSVRAPI; t := C_TSSVRAPI;
fhookseted := false; fhookseted := false;
fhooks := array(); fhooks := array();
@ -83,16 +117,221 @@ type t_func_finder_register = class(tsl_c_api_const) //
fhookptr; fhookptr;
fhooks; fhooks;
end end
type t_tsltokenex2 = class(tsl_c_api_const) //脚本解析
public
function create();
begin
t := C_TSSVRAPI;
//TSL_TokenizeEx2(s,flg);
if findfunction("tsl_tokenizeex_2_") then fustslulib := true;
else fustslulib := false;
fsource := array();
fresult := array();
skiperror := true;
fflags := 2^13-1;
end
function tslL_getfunctions();//系统函数
begin
//return array();
if fustslulib then
begin
return tsll_getfunctions_2_();
end
fs := 0;
cnt := 0;
_f_ := static procedure(var fs:pointer;var cnt:integer);cdecl ;external getdlsymaddress(C_PLUGIN,functionname(1));
##_f_(fs,ct);
return strs_ptr_to_array(fs,ct-1,1);
end
property source read fsource write set_source;
property result read get_result;
property flags read fflags write set_lags;
private
fustslulib;//替换
function strs_ptr_to_array(ps,n,fr); //一维字符串数组
begin
mt := get_mem_mgr();
r := array();
i := 0;
if ps=0 then return r;
while true do
begin
if n>0 and i>=n then break;
p := mt.readptr(ps+8*i);
if p=0 then
begin
n := i-1;
break;
end
r[i] := mt.readstr(p);
if not fr then
mt.tfree(p);
i++;
end
return r;
end
function strs_ptr_to_array2(ps,n);//二维字符串数组
begin
mt := get_mem_mgr();
r := array();
if ps=0 then return r;
i := 0;
while true do
begin
if n>0 and i>=n then break;
p := mt.readptr(ps+8*i);
if p=0 then
begin
n := i;
break;
end
r[i] := strs_ptr_to_array(p);
i++;
end
mt.tfree(ps);
return r;
end
function ints_ptr_to_array(ps,n,flg);
begin
mt := get_mem_mgr();
r := array();
if ps=0 then return r;
i := 0;
while true do
begin
if i>=n then break;
t := mt.readint(ps+4*i);
if t=flg then break;
r[i] := t;
i++;
end
mt.tfree(ps);
return r;
end
function TSL_InterpNewErrorInfo();
begin
_f_ := static function():pointer;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1));
return static ##_f_();
end
function TSL_TokenizeEx2();
begin
if fustslulib then
begin
fresult := tsl_tokenizeex_2_(fsource,fflags);
return;
end
oResult := TSL_InterpNewErrorInfo();
_f_ := static function(sc:string;skiperror:integer;
var sWords:pointer; var sUnits:pointer;
var sClasses:pointer;var sFunctions:pointer;
var iLines:pointer;var iBeginEnds:pointer;
var Dependency:pointer;var retBlocks:pointer;
var retBlockCount:integer;fflags:integer; oResult:pointer):integer;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1));
//echo _f_;
##_f_(fsource,true,sWords,sUnits,sClasses,sFunctions,iLines,iBeginEnds,sDependency,retBlocks,retBlockCount,fflags,oResult);
fresult := array();
fresult["words"] :=strs_ptr_to_array(sWords);
fresult["units"] :=strs_ptr_to_array(sUnits);
fresult["class"] :=strs_ptr_to_array(sClasses);
n := 0;
fresult["functions"] := strs_ptr_to_array2(sFunctions,n);
fresult["lines"] := ints_ptr_to_array(iLines,n);
fresult["linebegend"] := ints_ptr_to_array(iBeginEnds,nil,-1);
fresult["dep"] := strs_ptr_to_array(sDependency);
fresult["blcks"] := getblicks(retBlocks,retBlockCount);
end
function getblicks(ptr,n);
begin
r := array();
if ptr=0 then return r;
mt := get_mem_mgr();
for i := 0 to n-1 do
begin
p := mt.readptr(ptr+i*8);
bki := new BlockForEditor(p);
r[i,"mtype"] := bki._getvalue_("mType");
r[i,"mbeg"] := bki._getvalue_("mBeg");
r[i,"mend"] := bki._getvalue_("mEnd");
ct := bki._getvalue_("mSubs");
r[i,"msubs"] := ct;
if ct>0 then
r[i,"msub"] := getblicks(bki._getvalue_("mSub"),ct);
end
return r;
end
function get_result();
begin
if ifnil(fresult) then
begin
TSL_TokenizeEx2();
end
return fresult;
end
function set_source(s);
begin
if fsource<>s and ifstring(s) then
begin
fsource := s;
fresult := nil;
end
end
function set_lags(f);
begin
if f>0 and f<>fflags then
begin
fflags := f;
fresult := nil;
end
end
private
fsource;
fflags;
fresult;
private
static const Block_TypeClass = 1;
static const Block_Function = 2;
static const Block_Statements = 4;
static const Block_If = 8;
static const Block_Else = 16;
static const Block_SubCase = 32;
static const Block_Goto_Label = 64;
static const Block_Empty_Begin_End = 128;
static const Block_Try = 256;
static const Block_NeedSql = 512;
static const Block_UnitStruct = 1024;
static const Block_Propertys = 2048;
static const Block_Fields = 4096;
end
type BlockForEditor=class(tslcstructureobj)
public
function create(ptr)
begin
inherited create(getstruct(),ptr);
end
private
static SSTRUCT;
class function getstruct()
begin
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
("mType","int",0),
("mBeg","int",0),
("mEnd","int",0),
("mSubs","int",0),
("mFolded","int",0), //这个字段什么意思
("mSub","intptr",0),
("Clear","intptr",0) //cptr := _getvalue_("Clear"); f := procedure();cdecl;external cptr;
));
return SSTRUCT;
end
end
type t_tssvr_api_c = class(tsl_c_api_const) type t_tssvr_api_c = class(tsl_c_api_const)
function create(); function create();
begin begin
t := C_TSSVRAPI; t := C_TSSVRAPI;
isok := 0; if main_thread_check("~@~create-thread-tssvr_api~@~") then raise "t_tssvr_api_c created must in main thread!";
if not getglobalcache("@@tsl_c_api@@",isok) then
begin
setglobalcache("@@tsl_c_api@@","tsl_c_api");
reg_libpath_funcs(); reg_libpath_funcs();
end
end end
class function TSL_ObjToStr(L:pointer;v:pointer):string; class function TSL_ObjToStr(L:pointer;v:pointer):string;
begin begin
@ -247,8 +486,11 @@ type t_tssvr_api_c = class(tsl_c_api_const)
private private
class function reg_libpath_funcs();//注册需要的函数 class function reg_libpath_funcs();//注册需要的函数
begin begin
tslL_register(0,"get_self_libpath",makeinstance(thisfunction(get_self_libpath),"cdecl",0)); if not findfunction("syssettsllibpath") then
tslL_register(0,"set_self_libpath",makeinstance(thisfunction(set_self_libpath),"cdecl",0)); begin
tslL_register(0,"sysgettsllibpath",makeinstance(thisfunction(get_self_libpath),"cdecl",0));
tslL_register(0,"syssettsllibpath",makeinstance(thisfunction(set_self_libpath),"cdecl",0));
end
end end
// //
end end

View File

@ -1,227 +0,0 @@
unit utssvr_tsltoken_c;
interface
function get_sys_functions();
function get_tsl_tokenizeex(s,flg);
implementation
uses cstructurelib;
function get_sys_functions();
begin
return static get_tokener().tslL_getfunctions();
end
function get_tsl_tokenizeex(s,flg);
begin
o := get_tokener();
o.flags := flg;
o.source := s;
return o.result();
end
function get_tokener();
begin
return static new t_tsltokenex2();
end
type t_tsltokenex2 = 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}
public
function create();
begin
//TSL_TokenizeEx2(s,flg);
fsource := array();
fresult := array();
skiperror := true;
fflags := 2^13-1;
end
function tslL_getfunctions();//系统函数
begin
//return array();
fs := 0;
cnt := 0;
_f_ := static procedure(var fs:pointer;var cnt:integer);cdecl ;external getdlsymaddress(C_PLUGIN,functionname(1));
##_f_(fs,ct);
return strs_ptr_to_array(fs,ct-1,1);
end
property source read fsource write set_source;
property result read get_result;
property flags read fflags write set_lags;
private
function strs_ptr_to_array(ps,n,fr); //一维字符串数组
begin
mt := get_mem_mgr();
r := array();
i := 0;
if ps=0 then return r;
while true do
begin
if n>0 and i>=n then break;
p := mt.readptr(ps+8*i);
if p=0 then
begin
n := i-1;
break;
end
r[i] := mt.readstr(p);
if not fr then
mt.tfree(p);
i++;
end
return r;
end
function strs_ptr_to_array2(ps,n);//二维字符串数组
begin
mt := get_mem_mgr();
r := array();
if ps=0 then return r;
i := 0;
while true do
begin
if n>0 and i>=n then break;
p := mt.readptr(ps+8*i);
if p=0 then
begin
n := i;
break;
end
r[i] := strs_ptr_to_array(p);
i++;
end
mt.tfree(ps);
return r;
end
function ints_ptr_to_array(ps,n,flg);
begin
mt := get_mem_mgr();
r := array();
if ps=0 then return r;
i := 0;
while true do
begin
if i>=n then break;
t := mt.readint(ps+4*i);
if t=flg then break;
r[i] := t;
i++;
end
mt.tfree(ps);
return r;
end
function TSL_InterpNewErrorInfo();
begin
_f_ := static function():pointer;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1));
return static ##_f_();
end
function TSL_TokenizeEx2();
begin
oResult := TSL_InterpNewErrorInfo();
_f_ := static function(sc:string;skiperror:integer;
var sWords:pointer; var sUnits:pointer;
var sClasses:pointer;var sFunctions:pointer;
var iLines:pointer;var iBeginEnds:pointer;
var Dependency:pointer;var retBlocks:pointer;
var retBlockCount:integer;fflags:integer; oResult:pointer):integer;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1));
//echo _f_;
##_f_(fsource,true,sWords,sUnits,sClasses,sFunctions,iLines,iBeginEnds,sDependency,retBlocks,retBlockCount,fflags,oResult);
fresult := array();
fresult["words"] :=strs_ptr_to_array(sWords);
fresult["units"] :=strs_ptr_to_array(sUnits);
fresult["class"] :=strs_ptr_to_array(sClasses);
n := 0;
fresult["functions"] := strs_ptr_to_array2(sFunctions,n);
fresult["lines"] := ints_ptr_to_array(iLines,n);
fresult["linebegend"] := ints_ptr_to_array(iBeginEnds,nil,-1);
fresult["dep"] := strs_ptr_to_array(sDependency);
fresult["blcks"] := getblicks(retBlocks,retBlockCount);
end
function getblicks(ptr,n);
begin
r := array();
if ptr=0 then return r;
mt := get_mem_mgr();
for i := 0 to n-1 do
begin
p := mt.readptr(ptr+i*8);
bki := new BlockForEditor(p);
r[i,"mtype"] := bki._getvalue_("mType");
r[i,"mbeg"] := bki._getvalue_("mBeg");
r[i,"mend"] := bki._getvalue_("mEnd");
ct := bki._getvalue_("mSubs");
r[i,"msubs"] := ct;
if ct>0 then
r[i,"msub"] := getblicks(bki._getvalue_("mSub"),ct);
end
return r;
end
function get_result();
begin
if ifnil(fresult) then
begin
TSL_TokenizeEx2();
end
return fresult;
end
function set_source(s);
begin
if fsource<>s and ifstring(s) then
begin
fsource := s;
fresult := nil;
end
end
function set_lags(f);
begin
if f>0 and f<>fflags then
begin
fflags := f;
fresult := nil;
end
end
private
fsource;
fflags;
fresult;
private
static const Block_TypeClass = 1;
static const Block_Function = 2;
static const Block_Statements = 4;
static const Block_If = 8;
static const Block_Else = 16;
static const Block_SubCase = 32;
static const Block_Goto_Label = 64;
static const Block_Empty_Begin_End = 128;
static const Block_Try = 256;
static const Block_NeedSql = 512;
static const Block_UnitStruct = 1024;
static const Block_Propertys = 2048;
static const Block_Fields = 4096;
end
type BlockForEditor=class(tslcstructureobj)
public
function create(ptr)
begin
inherited create(getstruct(),ptr);
end
private
static SSTRUCT;
class function getstruct()
begin
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
("mType","int",0),
("mBeg","int",0),
("mEnd","int",0),
("mSubs","int",0),
("mFolded","int",0), //这个字段什么意思
("mSub","intptr",0),
("Clear","intptr",0) //cptr := _getvalue_("Clear"); f := procedure();cdecl;external cptr;
));
return SSTRUCT;
end
end
end.

View File

@ -19,7 +19,6 @@ type TCustomThreadworker = class(t_worker_host)
begin begin
eg := unit(utssvr_api_c).get_func_finder_register(); eg := unit(utssvr_api_c).get_func_finder_register();
eg.add_hook(thisfunction(finder)); eg.add_hook(thisfunction(finder));
//fn := "t_thread_call_back_"$tarraycont;
fn := add_thread_call(ns); fn := add_thread_call(ns);
end end
fp := findfunction(fn); fp := findfunction(fn);
@ -29,9 +28,10 @@ type TCustomThreadworker = class(t_worker_host)
end end
if not fp then raise ("工作线程构造失败!回调函数错误!" $fn); if not fp then raise ("工作线程构造失败!回调函数错误!" $fn);
set_heartbeat(); set_heartbeat();
p := format_thread_param(systhreadid(),fn); p := format_thread_param(get_thread_id(),fn);
b := static makeinstance(thisfunction(t_thread_worker),"stdcall",1); b := static makeinstance(thisfunction(t_thread_worker),"stdcall",1);
cid :=create_thread(b,p); cid :=create_thread(b,p);
if not cid then raise ("工作线程构造失败!可能是堆栈不够");
inherited create(cid); inherited create(cid);
////////////////// //////////////////
end end
@ -60,15 +60,15 @@ type TCustomThreadworker = class(t_worker_host)
begin begin
setglobalcache("~~main~~threader~~",1,(now()+0.015)); setglobalcache("~~main~~threader~~",1,(now()+0.015));
end end
static lenct;
class function dispatch(); class function dispatch();
begin begin
if not FThreaders then return ; if not FThreaders then return ;
set_heartbeat(); set_heartbeat();
lsdata := nil;
for idx,i in mrows(FThreaders,1) do for idx,i in mrows(FThreaders,1) do
begin begin
o := FThreaders[i]; o := FThreaders[i];
msg := o.fetch(data); msg := o.fetch(data,nil,lsdata);
if msg then if msg then
begin begin
case msg of case msg of
@ -107,7 +107,6 @@ type TCustomThreadworker = class(t_worker_host)
end end
property handle read FHandle; property handle read FHandle;
private private
class function init_workerhost(); class function init_workerhost();
begin begin
if not ifarray(FThreaders) then if not ifarray(FThreaders) then
@ -148,9 +147,9 @@ type t_worker_host = class(t_worker_base)
begin begin
if fworkerstate=1 then if fworkerstate=1 then
begin begin
clear();
post_to_("qq",1); post_to_("qq",1);
end end
clear();
FCatcheData := array(); FCatcheData := array();
inherited; inherited;
end end
@ -165,7 +164,7 @@ type t_worker_host = class(t_worker_base)
**} **}
function terminate();override; function terminate();override;
begin begin
if fworkerstate=1 then inherited; if fworkerstate=1 then return inherited;
end end
function ClientReady(flg); //任务句柄改变 function ClientReady(flg); //任务句柄改变
begin begin
@ -276,27 +275,54 @@ type t_worker_base = class()
function create(id); function create(id);
begin begin
FData := array(); FData := array();
fmy_thread := systhreadid(); fmy_thread := get_thread_id();
fto_thread:=id; fto_thread:=id;
fpostct := 0; fpostct := 0;
end end
function close(); //关闭 function close(); //关闭
begin begin
terminate(); return terminate();
end end
function terminate();virtual; //停止 function terminate();virtual; //停止
begin begin
post_to_("q",1); return post_to_("q",1);
end end
function postmessage(d);virtual; //发送数据 function postmessage(d);virtual; //发送数据
begin begin
return post_to_("#d",d); return post_to_("#d",d);
end end
function fetch(d); //获取数据 class function fetch_byid(id,cid,d);
begin
nw := now();
sid := "#"$id$"#";
ls := select ["name"] from listglobalcache() where(["endtm"]>nw and 1=pos(sid,["name"])) order by ["createtm"] end ;
for i,vd in ls do
begin
v := vd["name"];
if getglobalcache(v,d) and not ifnil(d) then
begin
r := get_v_type(v);
del_name(v);
ss := str2array(v,"#");
cid := strtoint64def(ss[2],0);
return r;
end
end
end
function fetch(d,flg,ls); //获取数据
begin
nw := now();
if not ifarray(ls) then
begin
if flg then
begin
ls := select ["name"] from listglobalcache() where(["endtm"]>nw) order by ["createtm"] end ;
end else
begin begin
ls := listglobalcache(); ls := listglobalcache();
end
end
myid := "#"$fmy_thread$"#"$fto_thread$"#"; myid := "#"$fmy_thread$"#"$fto_thread$"#";
nw := now();
for i,vd in ls do for i,vd in ls do
begin begin
v := vd["name"]; v := vd["name"];
@ -306,23 +332,7 @@ type t_worker_base = class()
begin begin
if getglobalcache(v,d) and not ifnil(d) then if getglobalcache(v,d) and not ifnil(d) then
begin begin
msn := static array( r := get_v_type(v);
"#d#",//数据
"#e#",//错误信息
"#s#", //启动成功
"#q#",//退出
"#qq#", //退出完成
"#se#" //启动错误
);
//r := "d";
for ii,vv in msn do
begin
if pos(vv,v) then
begin
r := replacetext(vv,"#","");
break;
end
end
del_name(v); del_name(v);
end end
return r; return r;
@ -349,33 +359,54 @@ type t_worker_base = class()
function post_to_(t,d); //发送 function post_to_(t,d); //发送
begin begin
if ifnil(d) then return 0; if ifnil(d) then return 0;
return setglobalcache(format_idx(t),d,now()+0.001) ; r := setglobalcache(format_idx(t),d,now()+0.001) ;
return 1; return 1;
end end
{** {**
@param(OnMessage)(function[TThreadWorker,data]) 消息回调 %% @param(OnMessage)(function[TThreadWorker,data]) 消息回调 %%
**} **}
private class function del_name(vn);
function del_name(vn);
begin begin
setglobalcache(vn,nil,(now()-1)); setglobalcache(vn,nil,(now()-1));
end end
private
class function get_v_type(v);
begin
msn := static array(
"#d#",//数据
"#e#",//错误信息
"#s#", //启动成功
"#q#",//退出
"#qq#", //退出完成
"#se#" //启动错误
);
//r := "d";
for ii,vv in msn do
begin
if pos(vv,v) then
begin
r := replacetext(vv,"#","");
break;
end
end
return r;
end
function format_idx(t); //格式化 function format_idx(t); //格式化
begin begin
return "#"$fto_thread$"#"$fmy_thread$"#"$t$"#&"$(fpostct++); return "#"$fto_thread$"#"$fmy_thread$"#"$t$"#&"$(fpostct++);
end end
private private
FData; FData; //数据缓存
fmy_thread; fmy_thread; //threadid
fto_thread; fto_thread; //链接id
fpostct; fpostct; //post次数
static const fexpired = 1/24/60/6000;
end end
function format_thread_param(id,script);//信息编码 function format_thread_param(id,script);//信息编码
begin begin
t := get_mem_mgr(); t := get_mem_mgr();
s := tostn(array(id,script)); //s := tostn(array(id,script));
s := id$";"$ script;
len := length(s)+2; len := length(s)+2;
p := t.tmalloc(len); p := t.tmalloc(len);
t.writestr(p,s); t.writestr(p,s);
@ -386,15 +417,15 @@ begin
t := get_mem_mgr(); t := get_mem_mgr();
s := t.readstr(p); s := t.readstr(p);
t.tfree(p); t.tfree(p);
d := stn(s); d := str2array(s,";");//stn(s);
id := d[0]; id := strtoint64(d[0]);
script := d[1]; script := d[1];
end end
function t_thread_worker(ptr:pointer):{$ifdef linux}pointer{$else}integer{$endif}; //回调 function t_thread_worker(ptr:pointer):{$ifdef linux}pointer{$else}integer{$endif}; //回调
begin begin
unformat_thread_param(ptr,id,fn); unformat_thread_param(ptr,id,fn);
this := new t_worker_client(id); this := new t_worker_client(id);
mypid := systhreadid(); mypid := get_thread_id();
fptr := findfunction(fn); fptr := findfunction(fn);
if not ifobj(fptr) then //非函数指针 if not ifobj(fptr) then //非函数指针
@ -412,13 +443,14 @@ begin
if not getglobalcache("~~main~~threader~~",d) then if not getglobalcache("~~main~~threader~~",d) then
begin begin
heartbeatstoped++; heartbeatstoped++;
if heartbeatstoped>5 then if heartbeatstoped>3 then //主线程已经退出了
begin begin
this.post_to_("qq",1); //this.post_to_("qq",1);
this.clear();
return ;//systerminate(2,mypid); return ;//systerminate(2,mypid);
end end
end end
msg := this.fetch(d); msg := this.fetch(d,true,nil);
case msg of case msg of
"d":begin //数据 "d":begin //数据
if iffuncptr(fptr) then if iffuncptr(fptr) then
@ -436,8 +468,7 @@ begin
this.clear(); this.clear();
return 1;//systerminate(1,mypid); return 1;//systerminate(1,mypid);
end end
"q":begin //退出 "q":begin //要求退出
this.clear(); this.clear();
this.post_to_("qq",1); this.post_to_("qq",1);
return ;//systerminate(1,mypid); return ;//systerminate(1,mypid);
@ -448,17 +479,66 @@ begin
end end
end ; end ;
tslprocessmessages(false); //20230428添加tsl消息分发 tslprocessmessages(false); //20230428添加tsl消息分发
end end
end end
function get_thread_id();
begin
{$ifdef linux}
return systhreadself();
{$endif}
return systhreadid();
end
function create_thread(f,p);//构造线程 function create_thread(f,p);//构造线程
begin begin
{$ifdef linux} {$ifdef linux}
return g_thread_new(f,p); return pthread_create(f,p);
//return g_thread_new(f,p);
{$endif} {$endif}
return CreateThread(f,p); return CreateThread(f,p);
end end
function g_thread_new(f:pointer;p:pointer):pointer; ///////////////////////////////pthread////////////////////////////////
{type pthread_attr_t = class(tslcstructureobj)
function create(ptr);
begin
inherited Create(getpstr(),ptr);
end
private
static pstrc;
function getpstr();
begin
if not pstrc then
begin
d := array(
("detachstate","int",0),//int detachstate; // 线程的分离状态
("schedpolicy","int",0),//int schedpolicy; // 线程调度策略
("schedparam","int",0), //structsched_param schedparam; // 线程的调度参数
("inheritsched","int",0), //int inheritsched; // 线程的继承性
("scope","int",0), //int scope; // 线程的作用域
("guardsize","intptr",0), // size_t guardsize; // 线程栈末尾的警戒缓冲区大小
("stackaddr_set","int",0), //int stackaddr_set; // 线程的栈设置
("stackaddr","intptr",0), //void* stackaddr; // 线程栈的位置
("stacksize","intptr",0) //size_t stacksize; // 线程栈的大小
);
pstrc := MemoryAlignmentCalculate(d);
end
return pstrc;
end
end
function pthread_attr_init(attr):integer;
begin
_f_ := static function(attr:pointer):integer;cdecl; external getdlsymaddress( "libc.so.6" ,functionname(1));
return ##_f_(attr._getptr_());
end }
function pthread_create(f,p):integer;
begin
//attr := new pthread_attr_t();pthread_attr_init(attr);attr._setvalue_("stacksize",10240000);
pth := 0;
_f_ := static function(var thread:pointer;attr:pointer; f:pointer;arg:pointer):integer;cdecl; external getdlsymaddress( "libc.so.6" ,functionname(1));
if 0= ##_f_(pth,0,f,p) then return pth;
end
/////////////////////gthread///////////////////////////////
{function g_thread_new(f:pointer;p:pointer):pointer;
begin begin
if not g_thread_get_initialized() then g_thread_init(); if not g_thread_get_initialized() then g_thread_init();
_f_ := static function(n:string;f:pointer;p:pointer):pointer;cdecl; external getdlsymaddress( "libgtk-3.so.0" ,functionname(1)); _f_ := static function(n:string;f:pointer;p:pointer):pointer;cdecl; external getdlsymaddress( "libgtk-3.so.0" ,functionname(1));
@ -473,7 +553,8 @@ function g_thread_init():Integer;
begin begin
_f_ := static function():Integer;cdecl; external getdlsymaddress( "libgtk-3.so.0" ,functionname(1)); _f_ := static function():Integer;cdecl; external getdlsymaddress( "libgtk-3.so.0" ,functionname(1));
return ##_f_(); return ##_f_();
end end }
///////////////////////////////////////////////////////
function CreateThread(f:pointer;p:pointer):pointer; function CreateThread(f:pointer;p:pointer):pointer;
begin begin
_f_ := static function(attr:pointer;size:pointer;addr:pointer;p:pointer;flag:Integer;var threadid:Integer):pointer;stdcall; external getdlsymaddress( "kernel32.dll" , functionname(1)); _f_ := static function(attr:pointer;size:pointer;addr:pointer;p:pointer;flag:Integer;var threadid:Integer):pointer;stdcall; external getdlsymaddress( "kernel32.dll" , functionname(1));

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
tsjni.dll

Binary file not shown.

Binary file not shown.

BIN
tsnet.dll

Binary file not shown.

View File

@ -1,3 +1,14 @@
更新日志--------2024-04-23
修订TS-SQL的JDBC链接模式下在SQLTABLE的使用中比较列名时忽略大小写。
修订解决JDBC链接模式下PG/Gauss下取得的列名都被转换为小写的问题。
修订MakeInstance多线程问题。
修订Linux上threadname设置问题。
修订GetMsgDigest Linux下表现异常问题。
修订Unicode和中文 mbcs在ubuntu下转换的问题。
修订SysExec在某些linux下存在的问题。
升级新增函数systhreadself在linux下返回pthread_t类型的pthread_self()原有systhreadid修正为真实的threadid。
升级新增函数syssettsllibpath,sysgettsllibpath允许启动后修改函数的查找路径。
更新日志--------2024-04-18 更新日志--------2024-04-18
升级JDBC从数据库传递巨型结果集给TSL的支持。 升级JDBC从数据库传递巨型结果集给TSL的支持。
修订因openssl 1.0.2库的线程非安全导致的LIBCURL-TSL的多线程并发可能出现的崩溃问题。 修订因openssl 1.0.2库的线程非安全导致的LIBCURL-TSL的多线程并发可能出现的崩溃问题。