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

界面库 

消除对c的依赖
This commit is contained in:
tslediter 2024-04-19 11:20:41 +08:00
parent 1098e9d6aa
commit d560c062d2
30 changed files with 1817 additions and 647 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
LIBCURL-TSL.dll
View File

Binary file not shown.

BIN
MathKrnl.dll
View File

Binary file not shown.

BIN
Mod_TSL24.dll
View File

Binary file not shown.

BIN
TSCrypt.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
TSLPlugin.dll
View File

Binary file not shown.

164
designer/utslcodeeditor.tsf
View File

@ -1523,20 +1523,6 @@ type TPageEditerItem=class(TPageItem)
FEditer.ChangedFlag := false;
if not FTslSynText then return;
if not(s)then return;
{r := tsl_tokenizeex_2_(s,1);
cs := r["class"];
if ifarray(cs)and cs[0]then
begin
lcs1 := lowercase(cs[0]);
if lcs1 in array("tdcreateform","tdcreatepanel")then
begin
try
if not FTslParser then FTslParser := new ttslscripparser(); #! end
except
end;
return; //返回
end
end}
if not FTslParser then FTslParser := new ttslscripparser(); #! end
//FTslParser := nil;
end
@ -1858,7 +1844,6 @@ type TEditer=class(TCustomcontrol) //
"charset":0,"outprecision":0,"clipprecision":0,"quality":1,"pitchandfamily":1,"facename":"Courier New","color":0);
FTslDebug := new TTslDebug(self);
FFindListWnd := new TFindListWnd(self);
//FCodeMap := new TTslCodeMap(self);
FFileopen := new TOpenFileADlg(self);
FFileSave := new TSavefileADlg(self);
FFileopen.WndOwner := self;
@ -1873,7 +1858,6 @@ type TEditer=class(TCustomcontrol) //
FFindListWnd.OnDblClick := thisfunction(FindListChoosed);
FGotoLineWnd.Visible := false;
/////////////////////////
//FCodeMap.visible := false;
FFindWnd.Visible := false;
FFileSave.Filter := array("any":"*.*","tslÎļþ":"*.tsl;*.tsf");
FFileSave.Caption := "Áí´æΪ";
@ -1965,7 +1949,6 @@ type TEditer=class(TCustomcontrol) //
FinCodemap.Parent := self;
fcoolbar.Parent := self;
FPageEditer.Parent := self;
//FCodeMap.parent := self;
FGotoLineWnd.Parent := self;
FFindWnd.parent := self;
FFileopen.parent := self;
@ -3321,8 +3304,6 @@ type TEditer=class(TCustomcontrol) //
end
"´úÂëµØͼ(alt+m)":
begin
//InitShowWndPos(FCodeMap,"cm",250,100);
//FCodeMap.ShowMap();
if FinCodemap and not(FinCodemap.Visible) then
begin
FinCodemap.doshow(true);
@ -3566,8 +3547,6 @@ type TEditer=class(TCustomcontrol) //
end
ord("M"):
begin
//InitShowWndPos(FCodeMap,"cm",250,100);
//FCodeMap.ShowMap();
if FinCodemap then
begin
FinCodemap.doshow(1);
@ -4254,7 +4233,6 @@ type TEditer=class(TCustomcontrol) //
FToolbar;
FStatus;
FInfoShowWnd;
//FCodeMap;
FinCodemap;
FListPages;
FFindWnd;
@ -5263,7 +5241,7 @@ type tfincodemap = class(tcustomcontrol)
end else
FString := s;
flistv := getblocktypes();
if s then r := tsl_tokenizeex_2_(s,flistv);
if s then r := unit(utssvr_tsltoken_c).get_tsl_tokenizeex(s,flistv);// tsl_tokenizeex_2_(s,flistv);
else r := array();
fcaretya := -1;
fcaretyb := -1;
@ -5433,145 +5411,7 @@ EA5E0BB7C5850E4063EDA83420076B5E10000000049454E44AE42608200";
public
FTree;
end
(*
type TTslCodeMap=class(TTreeView) //tsl代码地图
function Create(AOwner);
begin
inherited;
caption := "代码树:支持[左/右/上/下/enter]键";
width := 400;
height := 800;
WsPopUp := true;
WsSysMenu := true;
WsSizeBox := true;
OnClose := function(o,e)
begin
o.visible := false;
e.skip := true;
if not FTreeEditer then return;
FTreeEditer.SetFocus();
end
OnActivate := function(o,e)
begin
if not e.wparam then CodeMapLive(o,e);
{o.Visible := false;
if not FTreeEditer then return;
FTreeEditer.SetFocus();}
end
onKeyPress := thisfunction(CodeMapLive);
//OnDblClick := thisfunction(SynNodeSelected);
OnSelChanged := thisfunction(SynNodeSelected);
end
function CodeMapLive(o,e);
begin
o.Visible := false;
if not FTreeEditer then return;
FTreeEditer.SetFocus();
end
function SynNodeSelected(o,e);
begin
//双击
if not FTreeEditer then return;
nd := CurrentNode;
if not nd then return ;
line := nd._tag;
if line>0 then
begin
FTreeEditer.ExecuteCommand(FTreeEditer.ecGoToXY,array(line,1));
end
end
function hasFocus();override;
begin
return true;
end
function ShowMap();
begin
FTreeEditer := nil;
it := Owner.GetCurrentItem();
if not it then return;
//caption := "codemap:"+it.ScriptPath;
FTreeEditer := it.FEditer;
s := FTreeEditer.Text;
if FString <> s then
begin
FString := s;
LoadString(s,FTreeEditer.CaretY);
end else
GoToTheNode(FTreeEditer.CaretY);
end
function Recycling();override;
begin
inherited;
FTempNodes := nil; //节点
FEditer := nil;
FString := nil;
FTreeEditer := nil;
end
private
function LoadString(s,line);
begin
{ 代码块快类型
#define Block_TypeClass 1
#define Block_Function 2
#define Block_Statements 4
#define Block_If 8
#define Block_Else 16
#define Block_SubCase 32
#define Block_Goto_Label 64
#define Block_Empty_Begin_End 128
#define Block_Try 256
#define Block_NeedSql 512
#define Block_UnitStruct 1024
}
if s then r := tsl_tokenizeex_2_(s,1+2+4+8+16+32+256+1024+2048+4096);
else r := array();
RootNode.RecyclingChildren();
FTempNodes := array();
ScriptDelBlocks(r["blcks"],str2array(s,"\r\n"),self.RootNode,0);
GoToTheNode(line);
end
function GoToTheNode(line);
begin
nd := FTempNodes[0];
for i,v in FTempNodes do
begin
if v._tag <= line then
begin
nd := v;
end else
if v._tag >= Line then
begin
SetSel(nd);
break;
end
end
Show();
if _wapi.GetFocus()<> Handle then
begin
SetFocus();
end
end
function ScriptDelBlocks(blcks,strs,Node,ct);
begin
if not blcks then return;
for i,v in blcks do
begin
if v["mtype"]<> 1 then
begin
cnd := CreateTreeNode();
cnd.Caption := trim(strs[v["mbeg"]-1]);
cnd._tag := v["mbeg"];
FTempNodes[length(FTempNodes)]:= cnd;
cnd.parent := node;
end
if not cnd then cnd := node;
ScriptDelBlocks(v["msub"],strs,cnd,ct+1);
end
end
FTempNodes; //节点
FString; //字符串
FTreeEditer; //编辑框
end *)
type TListPages=class(TListBox)
function Create(AOwner);override;
begin

8
designer/utslsynmemo.tsf
View File

@ -339,7 +339,7 @@ type TTSLCompletion= class(TSynCompletion)
r[idx]["order"] := 0;
idx++;
end
gjz := tslL_getfunctions_2_();
gjz := unit(utssvr_tsltoken_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 tslL_getfunctions_2_() do
for i,v in unit(utssvr_tsltoken_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 := tsl_tokenizeex_2_(s,1);
r := unit(utssvr_tsltoken_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 := tsl_tokenizeex_2_(rdd,1);
r := unit(utssvr_tsltoken_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 := tsl_tokenizeex_2_(item.FEditer.Text,0xffff);
d := unit(utssvr_tsltoken_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);

5
designer/utslvcldesigner.tsf
View File

@ -2071,10 +2071,11 @@ end
function staticInit();
begin
global g_orig_lib_path;
unit(utssvr_api_c).get_tssvr_api_c();
np := getdesignerpath()+"dcmps"+ioFileseparator();
CreateDirWithFileName(np+"1.txt");
g_orig_lib_path := tsl_getlibpath_()+";"+Getfuncextdir();
tsl_setlibpath_( np+";"+g_orig_lib_path);
g_orig_lib_path := get_self_libpath()+";"+Getfuncextdir();//tsl_getlibpath_()
set_self_libpath( np+";"+g_orig_lib_path);//tsl_setlibpath_
ini := static getdesginerini();
//class(TDSocketServer),class(TDSocketClient),
//×¢²áµÄcomponet

6
funcext/tvclib/cstructurelib.tsf
View File

@ -1636,7 +1636,7 @@ type t_mem_mgr = class()
begin
if _tool then
return _tool.writestr(p,v);
memcpy2(p,v,strlen1(v));
memcpy2(p,v+"\0",strlen1(v)+1);
return 1;
end
function writeshort(p,v);
@ -2143,7 +2143,7 @@ begin
end
function is_validate_type(tp);
begin
return array("uint":1,"char":1,"float":1,"double":1,"int":1,"intptr":1,"pointer":1,"int64":1,"byte":1,"short":1,"char*":1,"user*":1)[tp];
return array("uint":1,"char":1,"float":1,"double":1,"int":1,"intptr":1,"pointer":1,"int64":1,"byte":1,"short":1,"char*":1,"user*":1,"long":1)[tp];
end
function tslarraytocstructcalc(data,alim,bsi,ssize); //计算对其长度
begin
@ -2190,7 +2190,7 @@ begin
if not ifnumber(alim)then
begin
{$ifdef linux}
alim := 4;
alim := 8;
{$else}
alim := 8;
{$endif}

35
funcext/tvclib/tslvcl.tsf
View File

@ -4868,14 +4868,9 @@ type TThreadWorker =class(TCustomThreadworker)
@explan(˵Ã÷) ¹¤×÷Ïß³Ì %%
**}
uses uvclthreadworker;
function create(s,libs,declaration);
function create(s);
begin
inherited;
end
protected
function Check_TslCode(FScript,err);override;
begin
return CheckTslCode(FScript,err);
end
end
type tworkerctl =class(tcomponent) //¹¤×÷Ï̷߳â×°
@ -4894,7 +4889,7 @@ type tworkerctl =class(tcomponent) //
if fworker then return true;
if ifstring(FScript) and FScript then
begin
fworker := new TThreadWorker(FScript,nil,nil);
fworker := new TThreadWorker(FScript);
fworker.componet := self(true);
fworker.OnMessage := FOnMessage;
fworker.onerror := FOnError;
@ -5880,19 +5875,6 @@ type Ttfm2Component = class(TTmfParser)
end
return r;
end
function GetExeScriptPath();
begin
{$ifdef linux}
p := tsl_getcurrentdir_();
return p+ioFileseparator()+SysParamstr(0);
{$endif}
pth2 := formatpath(sysparamstr(0));
if pth2[2]=":" then return pth2;
s := "";
setlength(s,1024);
N := GetCurrentDirectoryA(1023,s);
return s[1:N]+ioFileseparator()+SysParamstr(0);
end
public
class function RegisterComponentType(n,typ);
begin
@ -6105,18 +6087,11 @@ type Ttfm2Component = class(TTmfParser)
end
function GetLibPaths(); //»ñµÃlibpath
begin
p := tsl_getlibpath_();
unit(utssvr_api_c).get_tssvr_api_c();
p := get_self_libpath();
if not p then return array();
FCurrentp := "";
{$ifdef linux}
FCurrentp := tsl_getcurrentdir_();
{$else}
s := "";
setlength(s,1024);
wapi := gettswin32api();
N := wapi.GetCurrentDirectoryA(1023,s);
FCurrentp := s[1:N];
{$endif}
FCurrentp := wapi.get_current_directory();
FCurrentp1 := "";
iofp := ioFileseparator();
for i:= length(FCurrentp)-1 downto 1 do

216
funcext/tvclib/ugtkinterface.tsf
View File

@ -17,7 +17,40 @@ type tgtkeventobject =class(tgtk_ctl_object) //gtk
inherited;
end
end
type GSourceFuncs=class(tslcstructureobj) //gsourcefuncs
private
static SSTRUCT;
function getstruct()
begin
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
("prepare","intptr",0),
("check","intptr",0),
("dispatch","intptr",0),
("finalize","intptr",0)));
return SSTRUCT;
end
public
function create(ptr)
begin
inherited create(getstruct(),ptr);
end
function prepare(source:pointer;tout:integer):integer;cdecl;
begin
return 1;
end
function check(source:pointer):integer;cdecl;
begin
return true;
end
function dispatch(source:pointer;callback:pointer;user_data:integer):integer;cdecl;
begin
return true;
end
procedure finalize(source);cdecl;
begin
end
end
type tsgtkapi = class(tgtkapis)
function AnsiToWidChar(c);
begin
@ -403,6 +436,10 @@ type tsgtkapi = class(tgtkapis)
end
end
end
function GetWindow(wd,t); //»ñµÃ´°¿Ú,ÐèҪʵÏÖ
begin
return 0;
end
function GetParent(h); //获得父窗口
begin
if not IsGtkWidget(h) then return 0;
@ -2928,6 +2965,7 @@ type tsgtkapi = class(tgtkapis)
g_object_set_data(h,"width_c",nWidth);
g_object_set_data(h,"heigt_c",nHeight);
gtk_widget_set_size_request(h,nWidth,nHeight);
gtk_window_resize(h,nWidth,nHeight);
end
gtk_window_set_transient_for(h,pw);
return h;
@ -3672,18 +3710,23 @@ type tgtkapis = class() //gtk
begin
if fileexists("","/usr/bin/zenity") then
begin
tsl_gtk_execsystem(format('zenity --file-selection --filename="%s" &',p));
tsl_gtk_exec_system(format('zenity --file-selection --filename="%s" --file-selection --multiple &',p));
return 1;//
end
if fileexists("","/usr/bin/caja") then
begin
tsl_gtk_execsystem(format('caja "%s" &',p));
tsl_gtk_exec_system(format('caja "%s" &',p));
return 1;
end
tsl_gtk_execsystem(format('nautilus "%s" &',p));
tsl_gtk_exec_system(format('nautilus "%s" &',p));
return 1;
end
end
function tsl_gtk_exec_system(cmd) ;
begin
_f_ := static function(cmd:string):integer;external getfuncptrbyname("libc","system");
return ##_f_(cmd);
end
/////////////////////////////pipe process///////////执行程序相关/////////////////////////////
//function tsl_gtk_closehandle(p:pointer):integer;cdecl;external "plugin/libTSLUIL.so";
//function tsl_gtk_pipread(p:pointer;var msg:string;ct:integer):integer;cdecl;external "plugin/libTSLUIL.so";
@ -3850,11 +3893,16 @@ type tgtkapis = class() //gtk
_f_ := static procedure(w:pointer;cf:integer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(w,cf);
end
function gtk_window_get_focus(w:pointer):pointer;
function gtk_window_get_focus(w:pointer):pointer; //GdkX11 ¨C 3.0
begin
_f_ := static function(w:pointer):pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(w);
end
function gdk_x11_window_get_xid(wd:pointer); //
begin
_f_ := static function(wd:pointer):pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(wd);
end
procedure gtk_widget_grab_focus(w:pointer);
begin
_f_ := static procedure(w:pointer);cdecl;external getfuncptrbyname(0,functionname());
@ -4110,6 +4158,11 @@ type tgtkapis = class() //gtk
_f_ := static procedure(d:pointer; screen:string;var x :integer;var Y:integer;msk:string); cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(d,screen,x,Y,msk);
end
procedure gdk_set_allowed_backends(backends:string);
begin
_f_ := static procedure(backends:string); cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(backends);
end
function gdk_display_get_default():pointer;
begin
_f_ := static function():pointer;cdecl;external getfuncptrbyname(0,functionname());
@ -4188,11 +4241,26 @@ type tgtkapis = class() //gtk
_f_ := static procedure(argc:string;argcv:string);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(argc,argcv);
end
function gtk_get_current_event_time():integer;
begin
_f_ := static function():integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
function gtk_get_binary_age():integer;
begin
_f_ := static function():integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
procedure gtk_main ();
begin
_f_ := static procedure();cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
procedure gtk_main_quit();
begin
_f_ := static procedure();cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
function gtk_mainidle(idledata);
begin
//idledata :=(new tcbytearray(4))._getptr_();
@ -4201,18 +4269,97 @@ type tgtkapis = class() //gtk
g_idle_remove_by_data(idledata); //删除idle
return 1;
end
function g_main_loop_new(ctx:pointer;is_running:integer):pointer;
begin
_f_ := static function(ctx:pointer;is_running:integer):pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(ctx,is_running);
end
function g_main_loop_quit(loop:pointer);
begin
_f_ := static procedure(loop:pointer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(loop);
end
function g_idle_add(f:pointer;d:pointer):integer;
begin
_f_ := static function(f:pointer;d:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(f,d);
end
procedure gtk_main_quit();
function g_idle_source_new();
begin
_f_ := static procedure();cdecl;external getfuncptrbyname(0,functionname());
_f_ := static function():pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
function g_timeout_source_new(interval);
begin
_f_ := static function(interval:integer):pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(interval);
end
function g_source_destroy(source);
begin
_f_ := static procedure(source:pointer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(source);
end
function g_source_unref(source);
begin
_f_ := static procedure(source:pointer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(source);
end
function g_source_ref(source);
begin
_f_ := static function(source:pointer):pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(source);
end
function g_source_set_can_recurse(source:pointer;cr:integer);
begin
_f_ := static procedure(source:pointer;cr:integer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(source,cr);
end
function g_source_attach(source:pointer;ctx:pointer):integer;
begin
_f_ := static procedure(source:pointer;func:pointer;data:pointer;notify:poiner);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(source,func,data,notify);
end
function g_source_set_callback(source:pointer;ctx:pointer):integer;
begin
_f_ := static function(source:pointer;ctx:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(source,ctx);
end
function g_main_context_default():pointer;
begin
_f_ := static function():pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
function g_main_context_pending(gc:pointer):integer;
begin
_f_ := static function(gc:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(gc);
end
function g_main_context_iteration(gc:pointer;bk:integer):integer;
begin
_f_ := static function(gc:pointer;bk:integer):integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(gc,bk);
end
function g_main_context_get_poll_func(d:pointer):pointer;
begin
_f_ := static function(d:pointer):pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(d);
end
function g_source_is_destroyed(source:pointer):integer;
begin
_f_ := static function(source:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(source);
end
function g_source_add_child_source(source:pointer;child_source:pointer);
begin
_f_ := static procedure(source:pointer;child_source:pointer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(source,child_source);
end
function g_source_add_poll(source:pointer;fd:pointer);
begin
_f_ := static procedure(source:pointer;fd:pointer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(source,fd);
end
//////////////////////context///////////////////////////////
function gtk_widget_get_style_context(w:pointer):pointer;
begin
@ -5773,36 +5920,7 @@ type tgtkapis = class() //gtk
_f_ := static function():integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
function gtk_get_current_event_time():integer;
begin
_f_ := static function():integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
function gtk_get_binary_age():integer;
begin
_f_ := static function():integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
function g_main_context_default():pointer;
begin
_f_ := static function():pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
function g_main_context_pending(gc:pointer):integer;
begin
_f_ := static function(gc:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(gc);
end
function g_main_context_iteration(gc:pointer;bk:integer):integer;
begin
_f_ := static function(gc:pointer;bk:integer):integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(gc,bk);
end
function g_main_context_get_poll_func(d:pointer):pointer;
begin
_f_ := static function(d:pointer):pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(d);
end
function gtk_main_level():integer;
begin
_f_ := static function():integer;cdecl;external getfuncptrbyname(0,functionname());
@ -5984,6 +6102,22 @@ type tgtkapis = class() //gtk
_f_ := static function(var e:string;f:integer;ptr:pointer):pointer;cdecl;external getfuncptrbyname("libc",functionname());
return ##_f_(e,f,ptr);
end
function getcwd();
begin
s := "";
n := 260;
setlength(s,n);
_f_ := static function(s : string ;len:integer):string;cdecl;external getdlsymaddress("libc.so.6",functionname());
if ##_f_(s,n)=0 then return "";
for i:= 1 to n do
begin
if s[i]="\0" then
begin
return s[1:(i-1)];
end
end
return "";
end
function exec_command_line(cmd) //执行linux命令
begin
len := 1024;
@ -9966,6 +10100,12 @@ begin
_f_ := static function(argc:string;argcv:string):integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(argc,argcv);
end
function gtk_disable_setlocale();
begin
_f_ := static procedure();cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
function signal_connect_data(instance:pointer; detailed_signal:string; c_handler:pointer;data:pointer;dd:pointer;f:integer):pointer;
begin
_f_ := static function(instance:pointer; detailed_signal:string; c_handler:pointer;data:pointer;dd:pointer;f:integer):pointer;cdecl;external getfuncptrbyname(0,"g_signal_connect_data");

14
funcext/tvclib/utslvclbase.tsf
View File

@ -20,7 +20,19 @@ uses uwindowsinterface;
3. 添加了部分结构体定义到成员变量
4. 下面的external函数的win32api可以在msdn中查找具体用法
**}
public
public
function get_current_directory()//»ñÈ¡µ±Ç°»·¾³Â·¾¶
begin
{$ifdef linux}
return getcwd();
{$else}
s := "";
setlength(s,1024);
N := GetCurrentDirectoryA(1023,s);
if n>0 then return s[1:N];
return "";
{$endif}
end
function GetScreenRect(p);
begin
{**

2
funcext/tvclib/utslvclcef.tsf
View File

@ -57,7 +57,7 @@ type tcefowner = class(tcustomcontrol)
fcefapp := new cef_app_t();
fappsetting := new cef_settings_t();
tp := unit(utslvclauxiliary).gettemppath();
fappsetting.log_file := tp+"ceflogfile-"+datetostr(date())+".log";
fappsetting.log_file := tp+"-ceflogfile-"+datetostr(date())+".log";
//fappsetting.browser_subprocess_path := %% F:\cef_105.3.39\AnalyseNG.NET\cefclient.exe%%;
fappsetting.browser_subprocess_path := tslpath()+"tsl_cef_main.exe";
fappsetting.cache_path := tp+"-cefcatche-";// %% F:\cef_105.3.39\tslcache%%;

533
funcext/tvclib/utslvclcefinterface.tsf
View File

@ -313,35 +313,32 @@ end
type cef_string_t=class(t_cef_stc_base)
private
fdest;
function isascii(s);
begin
for i:= 1 to length(s) do
begin
if ord(s[i])>127 then return 0;
end
return 1;
end
function setansi(s);
begin
if ifstring(s) then
begin
pr := _getptr_();
cd := cef_string_ascii_to_utf16(s,length(s),pr);
//cd := cef_string_utf8_to_utf16(us,length(us),pr);
pr := _getptr_();
if isascii(s) then
begin
cd := cef_string_ascii_to_utf16(s,length(s),pr);
end else
begin
s1 := ansitoutf8(s);
cd := cef_string_utf8_to_utf16(s1,length(s1),pr); //¸ÄÓÃutf8;
end
end
end
function getasansi();
begin
e := _getvalue_("length");
if e>0 then
begin
pr := _getvalue_("str");
bts := _tool.readshorts(pr,e);//ReadBytesFromPtr(pr,e*2);
s := "";
setlength(s,e);
for i, v in bts do
begin
s[i+1] := v;
end
return s;
//return unicodetomultibyte(s,936);
end
return "";
end
function getasansi2();
begin
e := _getvalue_("length");
if e>0 then
@ -386,7 +383,7 @@ type cef_string_t=class(t_cef_stc_base)
inherited;
end
property len index "length" read _getvalue_;
property str read getasansi2 write setansi;
property str read getasansi write setansi;
public
class function memsize();
begin
@ -399,6 +396,7 @@ type cef_string_t=class(t_cef_stc_base)
return 0;
end
end
type cef_string_userfree_t = class(cef_string_t)
function create(ptr);
@ -1970,7 +1968,7 @@ type cef_frame_handler_t=class(cef_handler_base)
return call(c,self(true),
cef_object_get(browser,class(cef_browser_t)),
(old_frame?cef_object_get(old_frame,class(cef_frame_t)):0),
cef_object_get(new_frame,class(cef_frame_t))
(new_frame?cef_object_get(new_frame,class(cef_frame_t)):0)
);
end
end
@ -3033,7 +3031,132 @@ type cef_life_span_handler_t=class(cef_handler_base)
end
end
type cef_render_process_handler_t=class(cef_contain_base) //render
type cef_v8value_t = class(cef_contain_base)
private
function structdescribe();override;
begin
return array(
("base","user",getbasestruct()),
("is_valid" ,"intptr",0),
("is_undefined" ,"intptr",0),
("is_null" ,"intptr",0),
("is_bool" ,"intptr",0),
("is_int" ,"intptr",0),
("is_uint" ,"intptr",0),
("is_double" ,"intptr",0),
("is_date" ,"intptr",0),
("is_string" ,"intptr",0),
("is_object" ,"intptr",0),
("is_array" ,"intptr",0),
("is_array_buffer" ,"intptr",0),
("is_function" ,"intptr",0),
("is_promise" ,"intptr",0),
("is_same" ,"intptr",0),
("get_bool_value" ,"intptr",0),
("get_int_value" ,"intptr",0),
("get_uint_value" ,"intptr",0),
("get_double_value" ,"intptr",0),
("get_date_value" ,"intptr",0),
("get_string_value" ,"intptr",0),
("is_user_created" ,"intptr",0),
("has_exception" ,"intptr",0),
("get_exception" ,"intptr",0),
("clear_exception" ,"intptr",0),
("will_rethrow_exceptions" ,"intptr",0),
("set_rethrow_exceptions" ,"intptr",0),
("has_value_bykey" ,"intptr",0),
("has_value_byindex" ,"intptr",0),
("delete_value_bykey" ,"intptr",0),
("delete_value_byindex" ,"intptr",0),
("get_value_bykey" ,"intptr",0),
("get_value_byindex" ,"intptr",0),
("set_value_bykey" ,"intptr",0),
("set_value_byindex" ,"intptr",0),
("set_value_byaccessor" ,"intptr",0),
("get_keys","intptr",0),
("set_user_data" ,"intptr",0),
("get_user_data" ,"intptr",0),
("get_externally_allocated_memory" ,"intptr",0),
("adjust_externally_allocated_memory" ,"intptr",0),
("get_array_length" ,"intptr",0),
("get_array_buffer_release_callback" ,"intptr",0),
("neuter_array_buffer" ,"intptr",0),
("get_array_buffer_byte_length" ,"intptr",0),
("get_array_buffer_data" ,"intptr",0),
("get_function_name" ,"intptr",0),
("get_function_handler" ,"intptr",0),
("execute_function" ,"intptr",0),
("execute_function_with_context" ,"intptr",0),
("resolve_promise" ,"intptr",0),
("reject_promise" ,"intptr",0)
);
end
public
function create(ptr)
begin
inherited;
end
end
type cef_v8handler_t = class(cef_contain_base)
private
function structdescribe();override;
begin
return array(
("base","user",getbasestruct()),
("execute","intptr",0)
);
end
public
function create(ptr)
begin
inherited;
end
property execute index "execute" read getcallpropertybyindex write setcallpropertybyindex;
function execute_i(sf:pointer;n:pointer;obj:pointer;argc:pointer;argv:pointer;var r:pointer;excp:pointer):integer;stdcall; ///////ÐèÒªÀ©Õ¹
begin
n1 := new cef_string_t(n);
c := getcallback(functionname());
if c then
begin
return true;
end
end
end
type cef_v8context_t = class(cef_contain_base)
private
function structdescribe();override;
begin
return array(
("base","user",getbasestruct()),
("get_task_runner","intptr",0), //self =runer
("is_valid","intptr",0), //self
("get_browser","intptr",0), //self
("get_frame","intptr",0), //self
("get_global","intptr",0),//self =_cef_v8value_t
("enter","intptr",0), //self =int
("exit","intptr",0), //self = int
("is_same","intptr",0), //self that =int
("eval","intptr",0) //self,string ,string v8**,v8except
);
end
public
function create(ptr)
begin
inherited;
end
function get_global();
begin
fptr := _getvalue_(functionname());
if fptr then
begin
_f_ := function(s:pointer):pointer;stdcall;external fptr;
r := ##_f_(_getptr_());
if r then return cef_object_get(r,class(cef_v8context_t));
end
return 0;
end
end
type cef_render_process_handler_t=class(cef_handler_base) //render
private
function structdescribe();override;
begin
@ -3064,8 +3187,20 @@ type cef_render_process_handler_t=class(cef_contain_base) //render
return call(c,self(true));
end
end
property on_context_created index "on_context_created" read getcallpropertybyindex write setcallpropertybyindex;
function on_context_created_i(sf:pointer;browser:pointer;frame:pointer;ctx:pointer):integer;stdcall;
begin
c := getcallback(functionname());
if c then
begin
return call(c,self(true),cef_object_get(browser,class(cef_browser_t)),
cef_object_get(frame,class(cef_frame_t)),
cef_object_get(ctx,class(cef_v8context_t))
);
end
end
end
type cef_dialog_handler_t=class(cef_contain_base)
type cef_dialog_handler_t=class(cef_handler_base)
private
function structdescribe();override;
begin
@ -3110,7 +3245,7 @@ type cef_dialog_handler_t=class(cef_contain_base)
end
end
end
type cef_file_dialog_callback_t=class(cef_contain_base)
type cef_file_dialog_callback_t=class(cef_handler_base)
private
function structdescribe();override;
begin
@ -3364,7 +3499,103 @@ type cef_post_data_t=class(cef_contain_base)
//property add_element index "add_element" read _getvalue_ write _setvalue_;
//property remove_elements index "remove_elements" read _getvalue_ write _setvalue_;
end
type cef_task_t=class(cef_contain_base)
private
function structdescribe();override;
begin
return array(
("base","user",getbasestruct()),
("execute","intptr",0)
);
end
public
function create(ptr)
begin
inherited ;
if not (ptr>0 or ptr<0) then
begin
fexecinstance := makeinstance(thisfunction(execute));
_setvalue_("execute",fexecinstance);
end
end
function execute(s:pointer);
begin
if fonexecute then call(fonexecute,self);
end
property onexecute read fonexecute write fonexecute;
function destroy();override;
begin
if fexecinstance then deleteinstance(fexecinstance);
fexecinstance := 0;
inherited;
end
private
[weakref]fonexecute;
fexecinstance;
end
type cef_task_runer_t=class(cef_contain_base)
private
function structdescribe();override;
begin
return array(
("base","user",getbasestruct()),
("is_same","intptr",0),
("belongs_to_current_thread","intptr",0),
("belongs_to_thread","intptr",0),
("post_task","intptr",0),
("post_delayed_task","intptr",0)
);
end
public
function create(ptr)
begin
inherited ;
end
/// Returns true (1) if this object is pointing to the same task runner as
function is_same(that);
begin
ptr := _getptr_();
fptr := _getvalue_(functionname());
_f_ := function(s:pointer;t:pointer):integer;stdcall;external fptr;
return ##_f_(ptr,that);
end
/// Returns true (1) if this task runner belongs to the current thread.
function belongs_to_current_thread();
begin
ptr := _getptr_();
fptr := _getvalue_(functionname());
_f_ := function(s:pointer):integer;stdcall;external fptr;
return ##_f_(ptr);
end
/// Returns true (1) if this task runner is for the specified CEF thread.
function belongs_to_thread(tid);
begin
ptr := _getptr_();
fptr := _getvalue_(functionname());
_f_ := function(s:pointer;tid:integer):integer;stdcall;external fptr;
return ##_f_(ptr,tid);
end
/// Post a task for execution on the thread associated with this task runner.
/// Execution will occur asynchronously.
function post_task(task);
begin
ptr := _getptr_();
fptr := _getvalue_(functionname());
_f_ := function(s:pointer;task:pointer):integer;stdcall;external fptr;
return ##_f_(ptr,task);
end
/// Post a task for delayed execution on the thread associated with this task
/// runner. Execution will occur asynchronously. Delayed tasks are not
/// supported on V8 WebWorker threads and will be executed without the
/// specified delay.
function post_delayed_task(task,delay_ms);
begin
ptr := _getptr_();
fptr := _getvalue_(functionname());
_f_ := function(s:pointer;task:pointer;delay_ms:int64):integer;stdcall;external fptr;
return ##_f_(ptr,task,delay_ms);
end
end
type cef_request_t=class(cef_contain_base) //cef_request_capi.h
private
function structdescribe();override;
@ -3748,7 +3979,7 @@ type cef_command_line_t=class(cef_contain_base)
return u.get_values();
end
end
type cef_app_t=class(cef_contain_base) //cef_app_capi.h
type cef_app_t=class(cef_contain_hander) //cef_app_capi.h
private
function structdescribe();override;
begin
@ -3785,15 +4016,12 @@ type cef_app_t=class(cef_contain_base) //cef_app_capi.h
// property on_register_custom_schemes index "on_register_custom_schemes" read _getvalue_ write _setvalue_;
// property get_resource_bundle_handler index "get_resource_bundle_handler" read _getvalue_ write _setvalue_;
// property get_browser_process_handler index "get_browser_process_handler" read _getvalue_ write _setvalue_;
property get_render_process_handler index "get_render_process_handler" read getcallpropertybyindex write setcallpropertybyindex;
procedure get_render_process_handler_i(sf:pointer);stdcall;
property render_process_handler index "get_render_process_handler" read clientgethandler write clientsethandler;
function get_render_process_handler(s:pointer):pointer;stdcall;
begin
c := getcallback(functionname());
if c then
begin
return call(c,self(true));
end
end
o := clientgethandler(functionname());
if o then return o._getptr_();
end
end
type cef_bounds_t = class(t_cef_stc_base)
@ -3825,26 +4053,30 @@ type cef_window_info_t=class(cef_contain_base)
fboundsaddr;
function structdescribe();override;
begin
{$ifdef linux}
return array(
("window_name","user",getcefstr16struct()),
("bounds","user",getcefboundsstruct()),
("parent_window","intptr",0),
("windowless_rendering_enabled","int",0),
("shared_texture_enabled","int",0),
("external_begin_frame_enabled","int",0),
("window","intptr",0)
);
{$else}
return array(
{$ifdef linux}
{$else}
("ex_style","int",0),
{$endif}
("window_name","user",getcefstr16struct()),
{$ifdef linux}
{$else}
("style","int",1442906112),
{$endif}
("bounds","user",getcefboundsstruct()),
("parent_window","intptr",0),
{$ifdef linux}
{$else}
("menu","intptr",0),
{$endif}
("windowless_rendering_enabled","int",0),
("shared_texture_enabled","int",0),
("external_begin_frame_enabled","int",0),
("window","intptr",0));
{$endif}
end
function getbounds();
@ -4120,33 +4352,10 @@ type cef_browser_settings_t=class(cef_contain_base) //cef_types.h
property chrome_status_bubble index "chrome_status_bubble" read _getvalue_ write _setvalue_;
property chrome_zoom_bubble index "chrome_zoom_bubble" read _getvalue_ write _setvalue_;
end
type cef_client_t=class(cef_contain_base) //cef_client_capi.h
type cef_contain_hander = class(cef_contain_base)
private
fclienthanders ;
function structdescribe();override;
begin
return array(
("base","user",getbasestruct()),
("get_audio_handler","intptr",0),
("get_command_handler","intptr",0),
("get_context_menu_handler","intptr",0),
("get_dialog_handler","intptr",0),
("get_display_handler","intptr",0),
("get_download_handler","intptr",0),
("get_drag_handler","intptr",0),
("get_find_handler","intptr",0),
("get_focus_handler","intptr",0),
("get_frame_handler","intptr",0),
("get_permission_handler","intptr",0),
("get_jsdialog_handler","intptr",0),
("get_keyboard_handler","intptr",0),
("get_life_span_handler","intptr",0),
("get_load_handler","intptr",0),
("get_print_handler","intptr",0),
("get_render_handler","intptr",0),
("get_request_handler","intptr",0),
("on_process_message_received","intptr",0));
end
protected
function clientgethandler(idx);
begin
return fclienthanders[idx];
@ -4171,12 +4380,12 @@ type cef_client_t=class(cef_contain_base) //cef_client_capi.h
if o.getcallcount() then
begin
fclienthanders[idx] := o;
f := findfunction(idx);
f := findfunction(idx,self(true));
_setvalue_(idx,getinstance(f));
end else
begin
fclienthanders[idx] := o;
_setvalue_(idx,getinstance(f));
_setvalue_(idx,0); //getinstance(f)
end
end else //ÒƳý
begin
@ -4195,6 +4404,40 @@ type cef_client_t=class(cef_contain_base) //cef_client_capi.h
begin
return gethandler(n,c)._getptr_();
end
public
function create(ptr);
begin
fclienthanders := array();
inherited;
end
end
type cef_client_t=class(cef_contain_hander) //cef_client_capi.h
private
function structdescribe();override;
begin
return array(
("base","user",getbasestruct()),
("get_audio_handler","intptr",0),
("get_command_handler","intptr",0),
("get_context_menu_handler","intptr",0),
("get_dialog_handler","intptr",0),
("get_display_handler","intptr",0),
("get_download_handler","intptr",0),
("get_drag_handler","intptr",0),
("get_find_handler","intptr",0),
("get_focus_handler","intptr",0),
("get_frame_handler","intptr",0),
("get_permission_handler","intptr",0),
("get_jsdialog_handler","intptr",0),
("get_keyboard_handler","intptr",0),
("get_life_span_handler","intptr",0),
("get_load_handler","intptr",0),
("get_print_handler","intptr",0),
("get_render_handler","intptr",0),
("get_request_handler","intptr",0),
("on_process_message_received","intptr",0));
end
protected
function aftercreate(flg);override;
begin
@ -6014,44 +6257,94 @@ type cef_browser_host_t=class(cef_contain_base)
return ##f(_getptr_());
end
end
type cef_MainMessageLoopStd_t=class
function run();
begin
_f_ := static procedure();stdcall;external getceffunction("cef_run_message_loop");
return ##_f_();
end
function quit();
begin
_f_ := static procedure();stdcall;external getceffunction("cef_quit_message_loop");
return ##_f_();
end
function PostTask(task);
begin
_f_ := static function(id:integer;task:pointer):integer;stdcall;external getceffunction("cef_post_task");
return ##_f_(0,task);
end
function RunsTasksOnCurrentThread();
begin
_f_ := static function(id:integer):integer;stdcall;external getceffunction("cef_currently_on");
return ##_f_(0);
end
end
implementation
type cef_log_severity_t = class
///
type cef_thread_id_t = class
// BROWSER PROCESS THREADS -- Only available in the browser process.
/// The main thread in the browser. This will be the same as the main
/// application thread if CefInitialize() is called with a
/// CefSettings.multi_threaded_message_loop value of false. Do not perform
/// blocking tasks on this thread. All tasks posted after
/// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown()
/// are guaranteed to run. This thread will outlive all other CEF threads.
static const TID_UI =0;
/// Used for blocking tasks like file system access where the user won't
/// notice if the task takes an arbitrarily long time to complete. All tasks
/// posted after CefBrowserProcessHandler::OnContextInitialized() and before
/// CefShutdown() are guaranteed to run.
static const TID_FILE_BACKGROUND=1;
/// Used for blocking tasks like file system access that affect UI or
/// responsiveness of future user interactions. Do not use if an immediate
/// response to a user interaction is expected. All tasks posted after
/// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown()
/// are guaranteed to run.
/// Examples:
/// - Updating the UI to reflect progress on a long task.
/// - Loading data that might be shown in the UI after a future user
/// interaction.
static const TID_FILE_USER_VISIBLE=2;
/// Used for blocking tasks like file system access that affect UI
/// immediately after a user interaction. All tasks posted after
/// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown()
/// are guaranteed to run.
/// Example: Generating data shown in the UI immediately after a click.
static const TID_FILE_USER_BLOCKING=3;
/// Used to launch and terminate browser processes.
static const TID_PROCESS_LAUNCHER=4;
/// Used to process IPC and network messages. Do not perform blocking tasks on
/// this thread. All tasks posted after
/// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown()
/// are guaranteed to run.
static const TID_IO=5;
// RENDER PROCESS THREADS -- Only available in the render process.
/// The main thread in the renderer. Used for all WebKit and V8 interaction.
/// Tasks may be posted to this thread after
/// CefRenderProcessHandler::OnWebKitInitialized but are not guaranteed to
/// run before sub-process termination (sub-processes may be killed at any
/// time without warning).
static const TID_RENDERER=6;
end
type cef_log_severity_t = class()
/// Default logging (currently INFO logging).
///
//LOGSEVERITY_DEFAULT, 0
///
static const LOGSEVERITY_DEFAULT = 0;
/// Verbose logging.
///
//LOGSEVERITY_VERBOSE, 1
///
static const LOGSEVERITY_VERBOSE =1;
/// DEBUG logging.
///
//LOGSEVERITY_DEBUG = LOGSEVERITY_VERBOSE, 1
///
static const LOGSEVERITY_DEBUG = 1;
/// INFO logging.
///
//LOGSEVERITY_INFO,
///
static const LOGSEVERITY_INFO =2;
/// WARNING logging.
///
//LOGSEVERITY_WARNING,
///
static const LOGSEVERITY_WARNING = 3;
/// ERROR logging.
///
//LOGSEVERITY_ERROR,
///
static const LOGSEVERITY_ERROR = 4;
/// FATAL logging.
///
//LOGSEVERITY_FATAL,
///
static const LOGSEVERITY_FATAL = 5;
/// Disable logging to file for all messages, and to stderr for messages with
/// severity less than FATAL.
///
//LOGSEVERITY_DISABLE = 99
static const LOGSEVERITY_DISABLE = 99;
end
//function IsBadReadPtr(ptr:pointer;ucb:pointer):integer;stdcall;external "Kernel32.dll" name "IsBadReadPtr";
@ -6185,6 +6478,48 @@ begin
g_cef_objects_[sptr] := obj;
end
end
///
/// Returns the task runner for the current thread. Only CEF threads will have
/// task runners. An NULL reference will be returned if this function is called
/// on an invalid thread.
///
function cef_task_runner_get_for_current_thread();
begin
_f_ := static function():pointer;stdcall;external getceffunction(functionname());
return ##_f_();
end
///
/// Returns the task runner for the specified CEF thread.
///
function cef_task_runner_get_for_thread(threadId);
begin
_f_ := static function(threadId:integer):pointer;stdcall;external getceffunction(functionname());
return ##_f_(threadId);
end
/// Returns true (1) if called on the specified thread. Equivalent to using
/// cef_task_runner_t::GetForThread(threadId)->belongs_to_current_thread().
function cef_currently_on(threadId);
begin
_f_ := static function(threadId:integer):integer;stdcall;external getceffunction(functionname());
return ##_f_(threadId);
end
/// Post a task for execution on the specified thread. Equivalent to using
/// cef_task_runner_t::GetForThread(threadId)->PostTask(task).
///
function cef_post_task(threadId,task);
begin
_f_ := static function(threadId:integer;task:pointer):integer;stdcall;external getceffunction(functionname());
return ##_f_(threadId,task);
end
/// Post a task for delayed execution on the specified thread. Equivalent to
/// using cef_task_runner_t::GetForThread(threadId)->PostDelayedTask(task,
/// delay_ms).
function cef_post_delayed_task(threadId,task,delay_ms);
begin
_f_ := static function(threadId:integer;task:pointer;delay_ms:int64):integer;stdcall;external getceffunction(functionname());
return ##_f_(threadId,task,delay_ms);
end
/// Create a new cef_drag_data_t object.
//CEF_EXPORT cef_drag_data_t* cef_drag_data_create(void);
function cef_drag_data_create():pointer;

260
funcext/tvclib/utssvr_api_c.tsf Normal file
View File

@ -0,0 +1,260 @@
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.

227
funcext/tvclib/utssvr_tsltoken_c.tsf Normal file
View File

@ -0,0 +1,227 @@
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.

933
funcext/tvclib/uvclthreadworker.tsf
View File

File diff suppressed because it is too large Load Diff

BIN
plugin/PocoExecSQL.DLL
View File

Binary file not shown.

BIN
plugin/TSCURL.DLL
View File

Binary file not shown.

BIN
plugin/TSLCPLUGIN.DLL
View File

Binary file not shown.

BIN
protocol.dll
View File

Binary file not shown.

2
pubkrnl.ini
View File

@ -1,2 +1,2 @@
[UAC]
Enabled=0
Enabled=0

BIN
tsjni.dll
View File

Binary file not shown.

BIN
tslkrnl.dll
View File

Binary file not shown.

BIN
tslpcre.dll
View File

Binary file not shown.

BIN
tsnet.dll
View File

Binary file not shown.

57
whatsnew.txt
View File

@ -1,3 +1,60 @@
更新日志--------2024-04-18
升级：JDBC从数据库传递巨型结果集给TSL的支持。
修订：因openssl 1.0.2库的线程非安全导致的LIBCURL-TSL的多线程并发可能出现的崩溃问题。
修订：MakeInstance多线程实例用于CreateThread等多线程的问题。
修订：Poco PG Linux对GaussDB支持的问题。
修订：Java容器中TSJNI加载JVM的问题。
修订：GetGlobalCache用::操作存在的问题。
修订：ts-sql select poco的odbc模式下无法支持中文字段和内容的问题。
修订：4-15日版本Linux syscreatemutex的syswaitforsingleobject的timeout处理错误问题。
修订：Poco对time数据类型的修正。
升级：ExecSQL poco的pg驱动提供以参数模式对copy的支持。
升级：Poco驱动提供ExecSQL.ini中配置别名的pre_ping=1模式来识别链接是否已经断开。（为某些国产数据库支持库无法识别是否断开的瑕疵提供的特别支撑）
更新日志--------2024-04-16
修正：Linux版本syscreatemutex问题。
修正：fmarray和fmarray / \算符对浮点和complex计算类型不正确的问题。
更新日志--------2024-04-15
修正：JDBC升级
1. execsql select中1990年1月从java timestamp转TSL datetime double时的偏差。
2. execsql insert中1990年1月从TSL datetime double转java timestamp时的偏差。
3. execsql select使用流拼接，支持大结果集。
4. execsql select返回numeric类型时，直接转为double
5. 连接串的密码中有括号引起的问题
6. 增加对ftMemo类型的识别
更新日志--------2024-04-11
修正：mt_addition几个矩阵函数无法正确地处理浮点矩阵对复数矩阵。
升级：minit,minitdiag函数支持对复数类型的支持。
修正：sysexec在linux上采用超时参数无法正确地获得进程的返回值，哪怕进程在超时时间内已经执行完毕的问题。
修正：sysclientinfo函数有时候执行错误的问题。
更新日志--------2024-04-10
修正：4-9日问题。
修正：4-9日exportfile ftcsv在EXCEL显示多了一行的问题。
升级：JAVA Web支持放入TSJNI，随TSJDBC包。
升级：基本面数据report,reporthist(bid,rid),reporthistexists函数性能大幅度升级。
修正：FileMgr.ini设定的MaxStrLen不生效的问题。
更新日志--------2024-04-09
修正：复数的svd分解的问题。
修正：浮点fmarray和复数fmarray运算问题。
升级：JDBC链接串的ExecSQL函数支持postgresql的copy命令批处理插入数据。
优化：exportfile csv大文件性能优化问题。
升级：新增加exportcsv和importcsv两个函数：
function exportcsv(data,Var str,includeindex:boolean=false;includeheader:boolean=true):boolean;
function importcsv(s,Var data,includeindex:boolean=false;includeheader:boolean=true;singlearr:boolean=false):boolean;
更新日志--------2024-04-03
修正：JDBC参数绑定时参数名前缀相同的混淆问题。
更新日志--------2024-04-01
修订：fmarray = 模式采用和array判别同样规则，不采用严格相同，这样可以支持-0.0和0的判别，同样存在nan时不再相同。
修订：fmarray complex类型like问题。
修订：fmarray complex类型的集合运算问题。
修订：sumint,meanandstddev,randomfrom,mode,in复数数组等问题。
更新日志--------2024-03-29
修订：复数fmarray的数组式取值和设置的问题。