diff --git a/editor-install.exe b/editor-install.exe new file mode 100644 index 0000000..f59366f Binary files /dev/null and b/editor-install.exe differ diff --git a/funcext/tvclib/utslvcl_com.tsf b/funcext/tvclib/utslvcl_com.tsf index 386bfbe..e1c8aa6 100644 --- a/funcext/tvclib/utslvcl_com.tsf +++ b/funcext/tvclib/utslvcl_com.tsf @@ -33,6 +33,25 @@ interface end *) uses tslvcl; +function create_short_cutA(targ,lnk);//创建文件快捷方式 +type tiunkown = class(iunkown) //对外输出com接口 + function create(ptr) + begin + inherited; + end +end +type tIClassFactory = class(IClassFactory) + function create(ptr) + begin + inherited; + end +end +type tclsguid = class(tguid) //clsid对象 + function create(ptr); + begin + inherited; + end +end type t_com_class = class() private theFactory; @@ -502,7 +521,6 @@ type iunkown =class(tslcstructureobj,tcom_const) static SSTRUCT; protected static IID_IUnknown ;//:= new tguid(); - static IID_IClassFactory;// := new tguid(); static IID_IDispatch;// := new tguid(); m_dwRef; fvtable; @@ -511,11 +529,10 @@ type iunkown =class(tslcstructureobj,tcom_const) if not SSTRUCT then begin IID_IUnknown := new tguid(); - IID_IClassFactory := new tguid(); - IID_IDispatch := new tguid(); + + IID_IUnknown.readstr("{00000000-0000-0000-C000-000000000046}"); - IID_IClassFactory.readstr("{00000001-0000-0000-C000-000000000046}"); - IID_IDispatch.readstr("{00020400-0000-0000-C000-000000000046}"); + SSTRUCT := MemoryAlignmentCalculate(array( ("vtable","intptr",0) @@ -583,11 +600,18 @@ type idispatch=class(iunkown) begin return frgDispIds2[id]; end - public + protected + static IID_IDispatch; + public [weakref] fcom_mgr; function create(ptr) begin inherited ;//create(getstruct(),ptr); + if not IID_IDispatch then + begin + IID_IDispatch := new tguid(); + IID_IDispatch.readstr("{00020400-0000-0000-C000-000000000046}"); + end if not ptr then begin fvtable := new dispatchvtable(); @@ -684,12 +708,19 @@ type IClassFactory=class(iunkown) private static dwRegister; static theFactory; - fdispatchs; + fdispatchs; + protected + static IID_IClassFactory;// := new tguid(); public [weakref] fcom_mgr; function create(ptr);override; begin inherited ; + if not IID_IClassFactory then + begin + IID_IClassFactory := new tguid(); + IID_IClassFactory.readstr("{00000001-0000-0000-C000-000000000046}"); + end fdispatchs := array(); if not ptr then begin @@ -707,7 +738,7 @@ type IClassFactory=class(iunkown) m_dwRef := 0; end end - function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall; + function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;virtual; begin if IID_IUnknown.equ(riid) or IID_IClassFactory.equ(riid) then begin @@ -738,9 +769,252 @@ type IClassFactory=class(iunkown) return 1; end end + +type trelease = class() + private + [weakref]freleases; + public + function create(); + begin + freleases := array(); + end + function add(o); + begin + for i,v in freleases do + begin + if o= v then return ; + end + freleases[length(freleases)] := o; + end + function del(o); + begin + for i := 0 to length(freleases)-1 do + begin + if freleases[i]=0 then + begin + return deleteindex(freleases,i,true); + end + end + end + function Destroy(); + begin + for i,v in freleases do + begin + if v then + v.Release(); + end + freleases := array(); + end + +end +type ishelllinkavtable =class(tslcstructureobj) + uses cstructurelib; + private + class function getstruct() + begin + if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array( + ("QueryInterface","intptr",0), + ("AddRef","intptr",0), + ("Release","intptr",0), + ("GetPath","intptr",0), + ("GetIDList","intptr",0), + ("SetIDList","intptr",0), + ("GetDescription","intptr",0), + ("SetDescription","intptr",0), + ("GetWorkingDirectory","intptr",0), + ("SetWorkingDirectory","intptr",0), + ("GetArguments","intptr",0), + ("SetArguments","intptr",0), + ("GetHotkey","intptr",0), + ("SetHotkey","intptr",0), + ("GetShowCmd","intptr",0), + ("SetShowCmd","intptr",0), + ("GetIconLocation","intptr",0), + ("SetIconLocation","intptr",0), + ("SetRelativePath","intptr",0), + ("Resolve","intptr",0), + ("SetPath","intptr",0) + ) + ); + return SSTRUCT; + end + public + function create(ptr) + begin + inherited create(getstruct(),ptr); + end +end +type iPersistFilevtable =class(tslcstructureobj) + uses cstructurelib; + private + class function getstruct() + begin + if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array( + ("QueryInterface","intptr",0), + ("AddRef","intptr",0), + ("Release","intptr",0), + ("GetClassID","intptr",0), + ("IsDirty","intptr",0), + ("Load","intptr",0), + ("Save","intptr",0), + ("SaveCompleted","intptr",0), + ("GetCurFile","intptr",0) + ) + ); + return SSTRUCT; + end + public + function create(ptr) + begin + inherited create(getstruct(),ptr); + end +end +type IShellLink=class(tiunkown) //"000214EE-0000-0000-C000-000000000046" + public + function create(ptr);override; + begin + inherited ; + fdispatchs := array(); + if not ptr then + begin + fvtable := new ishelllinkavtable(); + _setvalue_("vtable",fvtable._getptr_()); + end else + begin + fvtable := new ishelllinkavtable(_getvalue_("vtable")); + end + end + function AddRef(s):integer;override; + begin + f := function(s:pointer):integer;stdcall;external fvtable._getvalue_("AddRef"); + if not s then s := _getptr_(); + return call(f,_getptr_()); + end + function Release(s):integer;override; + begin + f := function(s:pointer):integer;stdcall;external fvtable._getvalue_("Release"); ; + if not s then s := _getptr_(); + return call(f,s); + end + function QueryInterface(s,riid,ppv):integer;virtual; + begin + f := function(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;external fvtable._getvalue_("QueryInterface");; + if not s then s := _getptr_(); + return call(f,s,riid,ppv); + end + function SetPath(s:pointer;target:widestring):integer;stdcall;virtual; + begin + ptr := fvtable._getvalue_("SetPath"); + f := function(s:pointer;target:widestring):integer;stdcall ;external ptr; + if not s then s := _getptr_(); + R := ##f(s,target); + RETURN R; + end + function SetDescription(s:pointer;descrip:widestring):integer;stdcall;virtual; + begin + f := function(s:pointer;descrip:widestring):integer;stdcall;external fvtable._getvalue_("SetDescription"); + if not s then s := _getptr_(); + return call(f,s,t); + end +end + +type IPersistFile=class(tiunkown) //"0000010b-0000-0000-C000-000000000046" + public + function create(ptr);override; + begin + inherited ; + fdispatchs := array(); + if not ptr then + begin + fvtable := new iPersistFilevtable(); + _setvalue_("vtable",fvtable._getptr_()); + end else + begin + fvtable := new iPersistFilevtable(_getvalue_("vtable")); + m_dwRef := 0; + end + end + function addref(s:pointer):integer;stdcall;override; + begin + ptr := fvtable._getvalue_("AddRef"); + f := function(s:pointer):integer;stdcall;external ptr; + if not s then s := _getptr_(); + return call(f,s); + end + function Release(s:pointer):integer;stdcall;override; + begin + ptr := fvtable._getvalue_("AddRef"); + f := function(s:pointer):integer;stdcall;external ptr; + if not s then s := _getptr_(); + return call(f,s); + + end + function IsDirty(s:pointer):integer;stdcall;virtual; + begin + ptr := fvtable._getvalue_("IsDirty"); + f := function(s:pointer):integer;stdcall;external ptr; + if not s then s := _getptr_(); + return call(f,s); + end + function Load(s:pointer;fn:widestring;md:integer):integer;stdcall;virtual; + begin + ptr := fvtable._getvalue_("Load"); + f := function(s:pointer;fn:string;dwmode:integer):integer;stdcall;external ptr; + if not s then s := _getptr_(); + return call(f,s,fn,md); + end + function Save(s:pointer;fn:widestring;Remember:integer):integer;stdcall;virtual; + begin + ptr := fvtable._getvalue_("Save"); + f := function(s:pointer;fn:widestring;remember:integer):integer;stdcall;external ptr; + if not s then s := _getptr_(); + r := call(f,s,fn,Remember); + return r; + end + function SaveCompleted(s:pointer;fn:widestring); + begin + ptr := fvtable._getvalue_("SaveCompleted"); + f := function(s:pointer;fn:widestring):integer;stdcall;external ptr; + if not s then s := _getptr_(); + return call(f,s,fn); + end + function GetCurFile(s:pointer;fn:widestring); + begin + ptr := fvtable._getvalue_("GetCurFile"); + f := function(fn:pointer):integer;stdcall;external ptr; + if not s then s := _getptr_(); + return call(f,s,fn); + end +end +function create_short_cutA(targ,lnk);//创建文件快捷方式 +begin + if not fileexists("",targ) then return -1; + if not ifstring(lnk) then return -1; + rels := new trelease(); + if 1<>createcomobject("{00021401-0000-0000-C000-000000000046}",obj) then return -1; + hd := int64(obj); + aic := new IShellLink(hd); + cls := new tclsguid(); + cls.readstr("{000214F9-0000-0000-C000-000000000046}"); + if 0 <> aic.QueryInterface(hd,cls._getptr_(),v) then return -1; + ilink := new IShellLink(v); + rels.add(ilink); + ilink.SetPath(nil,widestring(targ)); + fclsid := new tclsguid(); + fclsid.readstr("{0000010b-0000-0000-C000-000000000046}"); + if 0<>ilink.QueryInterface(nil,fclsid._getptr_(),v2) then + begin + return -1; + end + ifile := new IPersistFile(v2); + rels.add(ifile); + return ifile.save(nil,widestring(lnk),true); +end +function CoCreateInstance(rclsid:pointer;pUnk:pointer;dwClsContext:integer;riid:integer;var lpdwRegister:integer):integer; stdcall; external "ole32.dll" name "CoCreateInstance"; function CoRegisterClassObject(rclsid:pointer;pUnk:pointer;dwClsContext:integer;flags:integer;var lpdwRegister:integer):integer; stdcall; external "ole32.dll" name "CoRegisterClassObject"; + function CoRevokeClassObject(var lpdwRegister:integer):integer; stdcall; external "ole32.dll" name "CoRevokeClassObject"; function WSAStartup(q:short;d:pointer):integer; stdcall; external "Ws2_32.dll" name "WSAStartup"; function CoInitializeEx(q:pointer;d:integer):integer; stdcall; external "ole32.dll" name "CoInitializeEx"; @@ -751,6 +1025,8 @@ function uaw_wcslen(s:pointer):integer;stdcall;external "Kernel32.dll" name "uaw function WideCharToMultiByte(CodePage:integer;dwFlags:integer;lpWideCharStr:pointer; cchWideChar:integer;var lpMultiByteStr:string;cbMultiByte:integer; lpDefaultChar:pointer;var lpUsedDefaultChar:integer):integer;stdcall;external "Kernel32.dll" name "WideCharToMultiByte"; +function MultiByteToWideChar(CodePage:integer;dwFlags:integer;lpMultiByteStr:string; + cchMultiByte:integer;var lpWideCharStr:pointer;cchWideChar:integer):integer;stdcall;external "Kernel32.dll" name "MultiByteToWideChar"; diff --git a/funcext/tvclib/utslvclinstall.tsf b/funcext/tvclib/utslvclinstall.tsf index 99bb347..eb33627 100644 --- a/funcext/tvclib/utslvclinstall.tsf +++ b/funcext/tvclib/utslvclinstall.tsf @@ -45,6 +45,16 @@ type t_tsl_window_reg = class() reg.SetValueStringA("InstallTime",datetimetostr(now())); return install_info_setex(reg); end + function createshortcut();virtual; + begin + uses utslvcl_com; + wapi := initializeapplication()._wapi; + path := ""; + setlength(path,1024); + if not wapi.SHGetSpecialFolderPathA(0,path,2,0) then return -1; + sn := gets(path)+"\\"+getdisplayname()+".lnk"; + return create_short_cutA(fexe,sn); + end function install_info_setex(reg);virtual; //写入额外信息 begin return 0; @@ -139,6 +149,13 @@ type t_tsl_window_reg = class() fdefaultexedir; finstallforall; private + function gets(s); + begin + for i:= 1 to length(s) do + begin + if s[i]="\0" then return s[1:(i-1)]; + end + end function setexename(s); begin if ifstring(s) and s and (s<>fexename) and not(pos("\\",s)) then diff --git a/funcext/tvclib/uwindowsinterface.tsf b/funcext/tvclib/uwindowsinterface.tsf index 1f37d4e..a4429cb 100644 --- a/funcext/tvclib/uwindowsinterface.tsf +++ b/funcext/tvclib/uwindowsinterface.tsf @@ -681,6 +681,8 @@ type twindowsapi = class() function ChooseFontA(LOGFONTA:pointer):integer;stdcall;external "Comdlg32.dll" name "ChooseFontA"; function ChooseColorA(LOGFONTA:pointer):integer;stdcall;external "Comdlg32.dll" name "ChooseColorA"; //************************************ + + function SHGetSpecialFolderPathA(hwnd:pointer;var path:string;csidl:integer;ifcreate:integer):integer;stdcall;external "Shell32.dll" name "SHGetSpecialFolderPathA"; function Shell_NotifyIconA(dwMessage:integer; lpData:pointer):integer;stdcall;external "Shell32.dll" name "Shell_NotifyIconA"; function ILCreateFromPathA(pszPath:string):pointer;stdcall;external "Shell32.dll" name "ILCreateFromPathA"; procedure ILFree(pidl:pointer);stdcall;external "Shell32.dll" name "ILFree"; diff --git a/tsleditor鍗歌浇.cmd b/tsleditor鍗歌浇.cmd deleted file mode 100644 index 23a6ea6..0000000 --- a/tsleditor鍗歌浇.cmd +++ /dev/null @@ -1 +0,0 @@ -"%~dp0tsleditor.exe" -uninstall \ No newline at end of file diff --git a/tsleditor娉ㄥ唽.cmd b/tsleditor娉ㄥ唽.cmd deleted file mode 100644 index ebc14c5..0000000 --- a/tsleditor娉ㄥ唽.cmd +++ /dev/null @@ -1 +0,0 @@ -"%~dp0tsleditor.exe" -install \ No newline at end of file