diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index 8123794..67d9530 100644 --- a/designer/udesignerproject.tsf +++ b/designer/udesignerproject.tsf @@ -3441,5 +3441,40 @@ E92946FC545E8EA1D20B8952E9954CA9F452AA3011854AAEE58A2A123445AF6A8 1CB3C87955C3470000000049454E44AE42608200"; return r ; end +function GetPathFromFullName(fullname,fname,ftype); +begin + {** + @explan(说明) 获得当前执行tsl文件的所在路径 %% + @param(fullname)(string) 全名 %% + @param(fname)(string) 文件名 ,变参返回%% + @param(ftype)(string) 文件类型 ,变参返回%% + @return(string) 路径 %% + **} + ph := fullname; + n := ""; + rp := ""; + fname := ""; + ftype := ""; + firstd := true; + iofp := ioFileseparator(); + for i := length(ph)downto 1 do + begin + vi := ph[i]; + if vi="." and firstd then + begin + ftype := n; + n := ""; + firstd := false; + end else + if vi=iofp then + begin + rp := ph[1:i-1]; + break; + end else + n := vi+n; + end + FName := n; + return rp; +end end. diff --git a/designer/utslsynmemo.tsf b/designer/utslsynmemo.tsf index 338dcd3..d0e3d08 100644 --- a/designer/utslsynmemo.tsf +++ b/designer/utslsynmemo.tsf @@ -1555,7 +1555,7 @@ type TTsfFileParser = class // //FFileWorker := new TThreadWorker("this.OnMessage :=findfunction('UTslSynMemo.FileSaveThreader') ;"); FFindDirs := array(); end - + function DispatchMethod(o,d);//分发消息 begin if not ifarray(d) then return ; @@ -1596,130 +1596,37 @@ type TTsfFileParser = class // end "parserstring": begin - rti := 0; - rt := array(); - m := d["minus"]; - if ifstring(m) then m := lowercase(m); - filechanged(m); - FormatFile(rti,FCacheS,rt,3,m); - - if m and ifarray(FCacheS) then - begin - r := FCacheS[m]; - end - if r then - begin - //echo "\r\nlodad"; - vmsg := r["msg"]; - end else - begin - s := d["value"]; - if not(s and ifstring(s)) then return rt ; - r := tsl_tokenizeex_2_(s,1); - if not( r and ifarray(r)) then return rt; - - cls := array(); - ScriptDelBlocks(r["blcks"],str2array(s,"\n"),cls); - r["blcks"] := cls; - vmsg := getmsgd_Crc32(s);//GetMsgdigest(s,0); - end - ext := array(); - FormatFunction(rti,r["functions"],rt,"",r["lines"],ext,1); - FormatBlocks(rti,r["blcks"],rt,"",nil,ext,1); - FormatWords(rti,r["words"],rt,"",ext,1); - dounits := array(vmsg); - uout := array(); - for i,v in r["units"] do //单元 - begin - vfn := checknamespacename(v); - if m=(lowercase(vfn)+".tsf") then continue; - vi := LoadByName(vfn); - if vi then - begin - if vi["msg"] =vmsg then - begin - continue; - end - ext := array(); - FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4); - FormatBlocks(rti,vi["blcks"],rt,vfn,nil,ext,4); - FormatWords(rti,vi["words"],rt,vfn,ext,4); - dounits[length(dounits)] := vi["msg"]; - loadunits(vi["units"],dounits,uout); - end - end - //mtic; - for i,v in uout do - begin - vfn := checknamespacename(v); - if m=(lowercase(vfn)+".tsf") then continue; - vi := LoadByName(vfn); - if vi then - begin - if vi["msg"] =vmsg then - begin - continue; - end - ext := array(); - FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4); - end - end - uout := array(); - //echo "\r\n other time:",mtoc; - dounits := array(vmsg); - for i,v in r["class"] do //类 - begin - vfn := checknamespacename(v); - if m=(lowercase(vfn)+".tsf") then continue; - vi := LoadByName(vfn); - if vi then - begin - if vi["msg"] in dounits then continue; - ext:= array(); - FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4); - FormatWords(rti,vi["words"],rt,vfn,ext,4); - //ident 文件名 - loadclasses(vi["class"],dounits,uout); - end - end - for i,v in uout do - begin - vfn := checknamespacename(v); - if m=(lowercase(vfn)+".tsf") then continue; - vi := LoadByName(vfn); - if vi then - begin - if vi["msg"]=vmsg then continue; - ext:= array(); - FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4); - FormatWords(rti,vi["words"],rt,vfn,ext,4); - end - end - //FormatFile(rti,FCacheS,rt,3,m); - return rt; - //return o.postmessage(r); + mtic; + r := parserstring(o,d); + return r; end end - end + end private - function loadunitcalss(us,cs,dounits,uout,cout); + function getinheriteds(r,m,dounits,us,uso,cs,cso); begin - if not ifarray(uout) then uout := array(); - if not ifarray(cout) then cout := array(); - for i,v in us do + if not ifarray(us) then us := array(); + if not ifarray(uso) then uso := array(); + if not ifarray(cs) then cs := array(); + if not ifarray(cso) then cso := array(); + for i,v in r["units"] do begin - vfn := checknamespacename(v); - vi := LoadByName(vfn); - if vi then - begin - if vi["msg"] in dounits then continue; - dounits[length(dounits)] := vi["msg"]; - uout[length(uout)] := vfn; - loadunitcalss(vi["units"],vi["class"],dounits,uout,cout); - end - + vfn := checknamespacename(v); + if m=(lowercase(vfn)+".tsf") then continue; + vi := LoadByName(vfn); + if vi then + begin + if vi["msg"] in dounits then + begin + continue; + end + dounits[length(dounits)] := vi["msg"] ; + us[length(us)] := vfn; + uso[length(uso)] := vi; + getinheriteds(vi,m,dounits,us,uso,cs,cso); + end end - for i,v in cs do + for i,v in r["class"] do begin vfn := checknamespacename(v); if m=(lowercase(vfn)+".tsf") then continue; @@ -1728,48 +1635,68 @@ type TTsfFileParser = class // begin if vi["msg"] in dounits then continue; dounits[length(dounits)] := vi["msg"]; - //ident 文件名 - cout[length(cout)] := vfn; - loadunitcalss(vi["units"],vi["class"],dounits,uout,cout); + cs[length(cs)] := vfn; + cso[length(cso)] := vi; + getinheriteds(vi,m,dounits,us,uso,cs,cso); end - end + end + end - function loadunits(us,dounits,uout); + function parserstring(o,d); begin - if not ifarray(uout) then uout := array(); - for i,v in us do - begin - vfn := checknamespacename(v); - vi := LoadByName(vfn); - if vi then - begin - if vi["msg"] in dounits then continue; - dounits[length(dounits)] := vi["msg"]; - uout[length(uout)] := vfn; - loadunits(vi["units"],dounits,uout); - end - - end - end - function loadclasses(cs,dounits,uout); - begin - if not ifarray(uout) then uout := array(); - for i,v in cs do - begin - vfn := checknamespacename(v); - if m=(lowercase(vfn)+".tsf") then continue; - vi := LoadByName(vfn); - if vi then - begin - if vi["msg"] in dounits then continue; - dounits[length(dounits)] := vi["msg"]; - //ident 文件名 - uout[length(uout)] := vfn; - loadclasses(cs,dounits,uout); - end - end - end - + rti := 0; + rt := array(); + m := d["minus"]; + if ifstring(m) then m := lowercase(m); + filechanged(m); + FormatFile(rti,FCacheS,rt,3,m); + if m and ifarray(FCacheS) then + begin + r := FCacheS[m]; + end + if r then + begin + //echo "\r\nlodad"; + vmsg := r["msg"]; + end else + begin + s := d["value"]; + if not(s and ifstring(s)) then return rt ; + r := tsl_tokenizeex_2_(s,1); + if not( r and ifarray(r)) then return rt; + + cls := array(); + ScriptDelBlocks(r["blcks"],str2array(s,"\n"),cls); + r["blcks"] := cls; + vmsg := getmsgd_Crc32(s);//GetMsgdigest(s,0); + end + ext := array(); + FormatFunction(rti,r["functions"],rt,"",r["lines"],ext,1); + FormatBlocks(rti,r["blcks"],rt,"",nil,ext,1); + FormatWords(rti,r["words"],rt,"",ext,1); + dounits := array(vmsg); + getinheriteds(r,m,dounits,us,uso,cs,cso); + for i,v in us do //单元 + begin + vfn := v; + vi := uso[i]; + ext := array(); + FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4); + FormatBlocks(rti,vi["blcks"],rt,vfn,nil,ext,4); + FormatWords(rti,vi["words"],rt,vfn,ext,4); + end + for i,v in cs do //类 + begin + vfn := v; + vi := cso[i]; + ext:= array(); + FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4); + FormatWords(rti,vi["words"],rt,vfn,ext,4); + end + //FormatFile(rti,FCacheS,rt,3,m); + return rt; + //return o.postmessage(r); + end function checknamespacename(v); begin for ii in FCacheS do @@ -2056,7 +1983,7 @@ type TTsfFileParser = class // ScriptDelBlocks(r["blcks"],str2array(rdd,"\n"),cls); r["blcks"] := cls; if not ifarray(FCacheS) then FCacheS := array(); - FCacheS[fn] := r; + FCacheS[fn] := r;//new tparserdobject( r); FFilePaths[fn] := pfn; WriteParseredFile(fn,r,fl[0,"Time"]); end @@ -2102,7 +2029,7 @@ type TTsfFileParser = class // fn := FCacheDir+ioFileseparator()+ModifyFname(n)+".p"; if importfile(ftstream(),"",fn,d)=1 and ifarray(d) then begin - FCacheS[lowercase(n)] := new tparserdobject(d); + FCacheS[lowercase(n)] := r;//new tparserdobject(d); FFilePaths[lowercase(n)] := d["fullpath"]; return d; end @@ -2157,6 +2084,7 @@ end type tparserdobject = class function create(d); begin + echo "\r\n create f object==="; if ifarray(d) then FData := d; end diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index 8e25619..04a0c64 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -33,22 +33,20 @@ Function tslcstructure(data,dsize,pack,ptr); //function CompareRect(orect,nrect); function calldatafunction(); -//function CallMessgeFunction(f,o,e); +function CallMessgeFunction(f,o,e); //////////////////////执行tsl脚本代码//////////////////// //function TSL_Check(func,funclen,oResult); function CheckTslCode(code,err); //检查tsl语法 //function SysExecWait(handle,exe,cmd,dir,fui); //执行 win32 程序 -function TS_ModulePath(); -function TS_ExecPath(); -function TS_GetAppPath(); +//function TS_ModulePath(); +//function TS_ExecPath(); +//function TS_GetAppPath(); function TS_GetUserProfileHome(); -function TS_GetIniPath(hometype,IniName); +//function TS_GetIniPath(hometype,IniName); function CopyUsedTslDllToNewDir(p); ///////////////////////////////////////////// function DeleteAllFiles(path); function CreateDirWithFileName(fname); -function GetPathFromFullName(fullname,fname,ftype); - //************************ //******************************* function MessageBoxA(txt,title,flag,hd); @@ -57,6 +55,9 @@ function _twinproc_(hwnd,message,wparam,lparam);//win32 function _MessgeHook_a(hwnd,message,wparam,lparam); function remotetslcallback(data); //********其他辅助函数******* +function TslToHexFormatStr(tsl); +function HexFormatStrToTsl(D); +function GetTextWidthAndHeightWidthFont(s,f,mul); //**********操作系统相关函数********************* function initlib(); //////////////////////////////////// @@ -10369,45 +10370,6 @@ type TDragManager=class(TComponent) property DragThreshold:Integer read FDragThreshold write FDragThreshold; // default 5; end; - - - -function GetPathFromFullName(fullname,fname,ftype); -begin - {** - @explan(说明) 获得当前执行tsl文件的所在路径 %% - @param(fullname)(string) 全名 %% - @param(fname)(string) 文件名 ,变参返回%% - @param(ftype)(string) 文件类型 ,变参返回%% - @return(string) 路径 %% - **} - ph := fullname; - n := ""; - rp := ""; - fname := ""; - ftype := ""; - firstd := true; - iofp := ioFileseparator(); - for i := length(ph)downto 1 do - begin - vi := ph[i]; - if vi="." and firstd then - begin - ftype := n; - n := ""; - firstd := false; - end else - if vi=iofp then - begin - rp := ph[1:i-1]; - break; - end else - n := vi+n; - end - FName := n; - return rp; -end - function GetAndDispatchMessageA(hwnd,minm,maxm); begin {** @@ -10778,11 +10740,11 @@ function TSL_NewObject():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$ function TSL_InterpGetLFromWrap(L:pointer):pointer;cdecl;external "TSSVRAPI.dll" name "TSL_InterpGetLFromWrap"; function TS_GetGlobalL():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetGlobalL"; function TSL_FreeObj(L:pointer;v:pointer);cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TSL_FreeObj"; -function TS_ModulePath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ModulePath"; -function TS_ExecPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath"; -function TS_GetAppPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath"; +//function TS_ModulePath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ModulePath"; +//function TS_ExecPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath"; +//function TS_GetAppPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath"; function TS_GetUserProfileHome():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetUserProfileHome"; -function TS_GetIniPath(hometype:integer; var IniName:string):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetIniPath"; +//function TS_GetIniPath(hometype:integer; var IniName:string):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetIniPath"; function TSL_Check(func:string;funclen:integer;oResult:pointer):integer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TSL_Check"; procedure tslprocessmessages();begin {echo "\r\n processmessage";}end; function RunWorkerThreadLoop(); @@ -10800,71 +10762,12 @@ begin end function CreateDirWithFileName(fname); begin - {** - @explan(说明) 根据文件全名构造目录 %% - **} - if not(ifstring(fname)and(length(fname)>4))then exit; - info := FileList("",fname); - if info then exit; - len := length(fname); - iofp := ioFileseparator(); - for i := len downto 1 do - begin - vi := fname[i]; - if vi=iofp then - begin - ffname := fname[1:i]; - break; - end - end - if not ffname then exit; - nct := 4; - {$ifdef linux} - nct := 1; - {$endif} - ph := ffname[1:nct]; - for i := nct+1 to length(ffname) do - begin - vi := ffname[i]; - if vi=iofp then - begin - if not FileList("",ph)then - begin - CreateDir("",ph); - end - end - ph += vi; - end + return unit(utslvclauxiliary).CreateDirWithFileName(fname); end function DeleteAllFiles(path); begin - {** - @explan(说明) 删除指定路径的文件或者文件夹 %% - **} - if not ifstring(path)then return 0; - if not path then return 0; - iofp := ioFileseparator(); - if path[length(path)]=iofp then return call(thisfunction,path[1:(length(path)-1)]); - info := FileList("",path); //"A" - if info then - begin - if pos("D",info[0]["Attr"])then - begin - fs := FileList("",path+iofp+"*"); - for i,v in fs do - begin - n := v["FileName"]; - if n in array(".","..")then continue; - call(thisfunction,path+iofp+n); - end - return RemoveDir("",path); - end else - begin - return FileDelete("",path); - end - return 0; - end + return unit(utslvclauxiliary).DeleteAllFiles(path); end function LoginTslServer(usr,pwd,addr,port); @@ -11097,6 +11000,22 @@ begin **} return(a and not(b))or(b and not(a)); end +function TslToHexFormatStr(tsl); +begin + return unit(utslvclauxiliary).TslToHexFormatStr(tsl); +end +function HexFormatStrToTsl(D); +begin + return unit(utslvclauxiliary).HexFormatStrToTsl(d); +end +function GetTextWidthAndHeightWidthFont(s,f,mul); +begin + return unit(utslvclgdi).GetTextWidthAndHeightWidthFont(s,f,mul); +end +function CallMessgeFunction(f,o,e); +begin + return unit(utslvclauxiliary).CallMessgeFunction(f,o,e); +end Initialization diff --git a/funcext/tvclib/utslvclauxiliary.tsf b/funcext/tvclib/utslvclauxiliary.tsf index dea0728..7b29db4 100644 --- a/funcext/tvclib/utslvclauxiliary.tsf +++ b/funcext/tvclib/utslvclauxiliary.tsf @@ -32,6 +32,9 @@ function ParserCommandLine(s); // //function TslToHexStr(d); function TslToHexFormatStr(tsl); function HexFormatStrToTsl(D); +function DeleteAllFiles(path); +function CreateDirWithFileName(fname); + type tuiglobaldata=class static UIData; class Function uisetdata(n,d); @@ -1893,6 +1896,11 @@ begin end function TslToHexFormatStr(tsl); begin +{** + @explan(说明) 将tsl类型转换为16进制字符串,每行长度为64,用\r\n分割 %% + @param(tsl)(any) tsl基础类型%% + @return(string) 字符串形式的16进制 %% +**} s := TslToHexStr(tsl); r := ""; n := length(s); @@ -1907,7 +1915,7 @@ begin r += s[i:n]; break; end else - r += s[i:ij]; + r += s[i:ij]; if ij>n then break; r += "\r\n"; i := ij+1; @@ -2119,6 +2127,73 @@ begin end return array(0,0); end +function DeleteAllFiles(path); +begin + {** + @explan(说明) 删除指定路径的文件或者文件夹 %% + **} + if not ifstring(path)then return 0; + if not path then return 0; + iofp := ioFileseparator(); + if path[length(path)]=iofp then return call(thisfunction,path[1:(length(path)-1)]); + info := FileList("",path); //"A" + if info then + begin + if pos("D",info[0]["Attr"])then + begin + fs := FileList("",path+iofp+"*"); + for i,v in fs do + begin + n := v["FileName"]; + if n in array(".","..")then continue; + call(thisfunction,path+iofp+n); + end + return RemoveDir("",path); + end else + begin + return FileDelete("",path); + end + return 0; + end +end +function CreateDirWithFileName(fname); +begin + {** + @explan(说明) 根据文件全名构造目录 %% + **} + if not(ifstring(fname)and(length(fname)>4))then exit; + info := FileList("",fname); + if info then exit; + len := length(fname); + iofp := ioFileseparator(); + for i := len downto 1 do + begin + vi := fname[i]; + if vi=iofp then + begin + ffname := fname[1:i]; + break; + end + end + if not ffname then exit; + nct := 4; + {$ifdef linux} + nct := 1; + {$endif} + ph := ffname[1:nct]; + for i := nct+1 to length(ffname) do + begin + vi := ffname[i]; + if vi=iofp then + begin + if not FileList("",ph)then + begin + CreateDir("",ph); + end + end + ph += vi; + end +end initialization