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

界面库

Browse Source 
消除对c的依赖
This commit is contained in:
liujianjun
2024-04-19 11:20:41 +08:00
parent 1098e9d6aa
commit d560c062d2
30 changed files with 1817 additions and 647 deletions
Download Patch File Download Diff File Expand all files Collapse all files
funcext/tvclib/cstructurelib.tsf
+3 -3
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}
funcext/tvclib/tslvcl.tsf
+5 -30
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
funcext/tvclib/ugtkinterface.tsf
+178 -38
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");
funcext/tvclib/utslvclbase.tsf
+13 -1
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
{**
funcext/tvclib/utslvclcef.tsf
+1 -1
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%%;
funcext/tvclib/utslvclcefinterface.tsf
+434 -99
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;
funcext/tvclib/utssvr_api_c.tsf
+260
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.
funcext/tvclib/utssvr_tsltoken_c.tsf
+227
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.
funcext/tvclib/uvclthreadworker.tsf
+628 -305
View File
File diff suppressed because it is too large Load Diff