liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

tsl 

更新
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
CommKrnl.dll
View File

Binary file not shown.

BIN
TSLDebugModule.dll
View File

Binary file not shown.

BIN
TSLInterp.dll
View File

Binary file not shown.

BIN
TSSVRAPI.DLL
View File

Binary file not shown.

2
designer/utslcodeeditor.tsf
View File

@ -5241,7 +5241,7 @@ type tfincodemap = class(tcustomcontrol)
end else
FString := s;
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();
fcaretya := -1;
fcaretyb := -1;

8
designer/utslsynmemo.tsf
View File

@ -339,7 +339,7 @@ type TTSLCompletion= class(TSynCompletion)
r[idx]["order"] := 0;
idx++;
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
begin
c := v+" <sysfun>";
@ -400,7 +400,7 @@ type TTslSynHighLighter = class(TSynHighLighter)
FKeyWords[v] := v;
end
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
FBinFunc[v]:=v;
end
@ -1885,7 +1885,7 @@ type TTsfFileParser = class() //
s := d["value"];
if not(s and ifstring(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;
cls := array();
ScriptDelBlocks(r["blcks"],str2array(s,"\n"),cls);
@ -2176,7 +2176,7 @@ type TTsfFileParser = class() //
r := array();
rdd := "";
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
begin
r := array();

2
designer/utslvcldebuger.tsf
View File

@ -1549,7 +1549,7 @@ type TTslDebuga=class(TCustomControl)
FRuningfile := item.OrigScriptPath; // %% E:\TSUIGROUP\script\tgdb.tsl%%;
FDebugtsfs["__main__"]:= FRuningfile;
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
begin
s := ls.GetStringByIndex(v["mbeg"]-1);

4
designer/utslvcldesigner.tsf
View File

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

BIN
editor-install.exe
View File

Binary file not shown.

2
funcext/tvclib/cstructurelib.tsf
View File

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

2
funcext/tvclib/tslvcl.tsf
View File

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

1
funcext/tvclib/utslvclcefinterface.tsf
View File

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

258
funcext/tvclib/utssvr_api_c.tsf
View File

@ -2,7 +2,10 @@ unit utssvr_api_c;
interface
function get_tssvr_api_c();
function get_func_finder_register();
function get_sys_functions();
function get_tsl_tokenizeex(s,flg);
implementation
uses cstructurelib;
function get_tssvr_api_c();
begin
return static new t_tssvr_api_c();
@ -11,6 +14,21 @@ function get_func_finder_register();
begin
return static new t_func_finder_register();
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()
{$ifdef linux}
static const C_TSSVRAPI="libTSSVRAPI.so";
@ -22,9 +40,25 @@ type tsl_c_api_const = class()
static const C_TSLInterp="TSLInterp.dll";
{$endif}
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) //函数注册类型
function create();
begin
////////////////////////////////////////////////////////////////
if main_thread_check("~@~create-thread-func-finder~@~") then raise "t_func_finder_register created must in main thread!";
//////////////////////////////////////////////////////
t := C_TSSVRAPI;
fhookseted := false;
fhooks := array();
@ -83,16 +117,221 @@ type t_func_finder_register = class(tsl_c_api_const) //
fhookptr;
fhooks;
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)
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
if main_thread_check("~@~create-thread-tssvr_api~@~") then raise "t_tssvr_api_c created must in main thread!";
reg_libpath_funcs();
end
class function TSL_ObjToStr(L:pointer;v:pointer):string;
begin
@ -247,8 +486,11 @@ type t_tssvr_api_c = class(tsl_c_api_const)
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));
if not findfunction("syssettsllibpath") then
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

227
funcext/tvclib/utssvr_tsltoken_c.tsf
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.

183
funcext/tvclib/uvclthreadworker.tsf
View File

@ -19,7 +19,6 @@ type TCustomThreadworker = class(t_worker_host)
begin
eg := unit(utssvr_api_c).get_func_finder_register();
eg.add_hook(thisfunction(finder));
//fn := "t_thread_call_back_"$tarraycont;
fn := add_thread_call(ns);
end
fp := findfunction(fn);
@ -29,9 +28,10 @@ type TCustomThreadworker = class(t_worker_host)
end
if not fp then raise ("工作线程构造失败!回调函数错误!" $fn);
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);
cid :=create_thread(b,p);
if not cid then raise ("工作线程构造失败!可能是堆栈不够");
inherited create(cid);
//////////////////
end
@ -60,15 +60,15 @@ type TCustomThreadworker = class(t_worker_host)
begin
setglobalcache("~~main~~threader~~",1,(now()+0.015));
end
static lenct;
class function dispatch();
begin
if not FThreaders then return ;
set_heartbeat();
lsdata := nil;
for idx,i in mrows(FThreaders,1) do
begin
o := FThreaders[i];
msg := o.fetch(data);
msg := o.fetch(data,nil,lsdata);
if msg then
begin
case msg of
@ -107,7 +107,6 @@ type TCustomThreadworker = class(t_worker_host)
end
property handle read FHandle;
private
class function init_workerhost();
begin
if not ifarray(FThreaders) then
@ -148,9 +147,9 @@ type t_worker_host = class(t_worker_base)
begin
if fworkerstate=1 then
begin
clear();
post_to_("qq",1);
end
clear();
FCatcheData := array();
inherited;
end
@ -165,7 +164,7 @@ type t_worker_host = class(t_worker_base)
**}
function terminate();override;
begin
if fworkerstate=1 then inherited;
if fworkerstate=1 then return inherited;
end
function ClientReady(flg); //任务句柄改变
begin
@ -276,27 +275,54 @@ type t_worker_base = class()
function create(id);
begin
FData := array();
fmy_thread := systhreadid();
fmy_thread := get_thread_id();
fto_thread:=id;
fpostct := 0;
end
function close(); //关闭
begin
terminate();
return terminate();
end
function terminate();virtual; //停止
begin
post_to_("q",1);
return post_to_("q",1);
end
function postmessage(d);virtual; //发送数据
begin
return post_to_("#d",d);
end
function fetch(d); //获取数据
class function fetch_byid(id,cid,d);
begin
ls := listglobalcache();
myid := "#"$fmy_thread$"#"$fto_thread$"#";
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
ls := listglobalcache();
end
end
myid := "#"$fmy_thread$"#"$fto_thread$"#";
for i,vd in ls do
begin
v := vd["name"];
@ -306,23 +332,7 @@ type t_worker_base = class()
begin
if getglobalcache(v,d) and not ifnil(d) then
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
r := get_v_type(v);
del_name(v);
end
return r;
@ -349,33 +359,54 @@ type t_worker_base = class()
function post_to_(t,d); //发送
begin
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;
end
{**
@param(OnMessage)(function[TThreadWorker,data]) 消息回调 %%
**}
private
function del_name(vn);
class function del_name(vn);
begin
setglobalcache(vn,nil,(now()-1));
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); //格式化
begin
return "#"$fto_thread$"#"$fmy_thread$"#"$t$"#&"$(fpostct++);
end
private
FData;
fmy_thread;
fto_thread;
fpostct;
static const fexpired = 1/24/60/6000;
FData; //数据缓存
fmy_thread; //threadid
fto_thread; //链接id
fpostct; //post次数
end
function format_thread_param(id,script);//信息编码
begin
t := get_mem_mgr();
s := tostn(array(id,script));
//s := tostn(array(id,script));
s := id$";"$ script;
len := length(s)+2;
p := t.tmalloc(len);
t.writestr(p,s);
@ -386,15 +417,15 @@ begin
t := get_mem_mgr();
s := t.readstr(p);
t.tfree(p);
d := stn(s);
id := d[0];
d := str2array(s,";");//stn(s);
id := strtoint64(d[0]);
script := d[1];
end
function t_thread_worker(ptr:pointer):{$ifdef linux}pointer{$else}integer{$endif}; //回调
begin
unformat_thread_param(ptr,id,fn);
this := new t_worker_client(id);
mypid := systhreadid();
mypid := get_thread_id();
fptr := findfunction(fn);
if not ifobj(fptr) then //非函数指针
@ -412,13 +443,14 @@ begin
if not getglobalcache("~~main~~threader~~",d) then
begin
heartbeatstoped++;
if heartbeatstoped>5 then
if heartbeatstoped>3 then //主线程已经退出了
begin
this.post_to_("qq",1);
//this.post_to_("qq",1);
this.clear();
return ;//systerminate(2,mypid);
end
end
msg := this.fetch(d);
msg := this.fetch(d,true,nil);
case msg of
"d":begin //数据
if iffuncptr(fptr) then
@ -436,8 +468,7 @@ begin
this.clear();
return 1;//systerminate(1,mypid);
end
"q":begin //退出
"q":begin //要求退出
this.clear();
this.post_to_("qq",1);
return ;//systerminate(1,mypid);
@ -448,17 +479,66 @@ begin
end
end ;
tslprocessmessages(false); //20230428添加tsl消息分发
end
end
function get_thread_id();
begin
{$ifdef linux}
return systhreadself();
{$endif}
return systhreadid();
end
function create_thread(f,p);//构造线程
begin
{$ifdef linux}
return g_thread_new(f,p);
return pthread_create(f,p);
//return g_thread_new(f,p);
{$endif}
return CreateThread(f,p);
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
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));
@ -473,7 +553,8 @@ function g_thread_init():Integer;
begin
_f_ := static function():Integer;cdecl; external getdlsymaddress( "libgtk-3.so.0" ,functionname(1));
return ##_f_();
end
end }
///////////////////////////////////////////////////////
function CreateThread(f:pointer;p:pointer):pointer;
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));

BIN
plugin/TSLCPLUGIN.DLL
View File

Binary file not shown.

BIN
plugin/TSLClient.dll
View File

Binary file not shown.

BIN
plugin/TSSecurity.dll
View File

Binary file not shown.

BIN
protocol.dll
View File

Binary file not shown.

BIN
tsjni.dll
View File

Binary file not shown.

BIN
tsleditor.exe
View File

Binary file not shown.

BIN
tsnet.dll
View File

Binary file not shown.

11
whatsnew.txt
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
升级：JDBC从数据库传递巨型结果集给TSL的支持。
修订：因openssl 1.0.2库的线程非安全导致的LIBCURL-TSL的多线程并发可能出现的崩溃问题。