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

tsl64

Browse Source 
更新动态库
This commit is contained in:
liujianjun
2024-06-18 14:11:47 +08:00
parent 1ed266f959
commit d46e01f8fb
14 changed files with 915 additions and 162 deletions
Download Patch File Download Diff File Expand all files Collapse all files
MathKrnl.dll
BIN
View File
Binary file not shown.
PK_SQL.DLL
BIN
View File
Binary file not shown.
PK_SQL_MYSQL.DLL
BIN
View File
Binary file not shown.
PK_SQL_ODBC.DLL
BIN
View File
Binary file not shown.
PK_SQL_POSTGRESQL.DLL
BIN
View File
Binary file not shown.
TSLInterp.dll
BIN
View File
Binary file not shown.
funcext/tvclib/utslvcl_com.tsf
+234 -60
View File
@@ -34,7 +34,7 @@ interface
end
end
*)
uses cstructurelib,tslvcl;
uses cstructurelib,utslvclauxiliary,tslvcl;
function sh_get_IShellLinkW(); //获取快捷方式创建接口
function create_short_cutA(targ,lnk);//创建文件快捷方式
type tagELEMDESC_test =class(tagELEMDESC)
@@ -156,6 +156,10 @@ type t_com_class = class()
function execute_retun_is_excel(fname);virtual;//返回时候参数是否为excel格式
begin
return false;
end
function method_names();virtual; //函数名称
begin
end
function invoke_call(fname,pms);virtual; //执行函数
begin
@@ -349,12 +353,10 @@ type t_com_class = class()
end
function getguid();
begin
global G_CURRENT_CLSID;
if not sguid then
begin
sguid := new tguid();
G_CURRENT_CLSID := get_clsid();
sguid.readstr(G_CURRENT_CLSID);
sguid.readstr(get_clsid());
end
return sguid;
end
@@ -451,6 +453,16 @@ type tagFUNCKIND = class
static const FUNC_DISPATCH = ( FUNC_STATIC + 1 ) ;
end
type DISPID_TYPE = class
static const DISPID_UNKNOWN = -1;
static const DISPID_VALUE = 0;
static const DISPID_PROPERTYPUT = -3;
static const DISPID_NEWENUM = -4;
static const DISPID_EVALUATE = -5;
static const DISPID_CONSTRUCTOR = -6;
static const DISPID_DESTRUCTOR = -7;
static const DISPID_COLLECT = -8;
end
type tagINVOKEKIND =class
static const INVOKE_FUNC = 1;
static const INVOKE_PROPERTYGET = 2;
@@ -529,14 +541,83 @@ type tagwinerr =class
static const E_ABORT=0x80004004L;
static const E_FAIL=0x80004005L;
static const E_ACCESSDENIED=0x80070005L;
static const DISP_E_EXCEPTION=0x80020009L;
static const S_OK = 0;
end
type FACILITY_DISPATCH = class
// FACILITY_DISPATCH
// MessageId: DISP_E_UNKNOWNINTERFACE
// Unknown interface.
static const DISP_E_UNKNOWNINTERFACE =0x80020001L;
// MessageId: DISP_E_MEMBERNOTFOUND
// Member not found.
static const DISP_E_MEMBERNOTFOUND =0x80020003L;
// MessageId: DISP_E_PARAMNOTFOUND
// MessageText:
// Parameter not found.
static const DISP_E_PARAMNOTFOUND =0x80020004L;
// MessageId: DISP_E_TYPEMISMATCH
// MessageText:
// Type mismatch.
static const DISP_E_TYPEMISMATCH =0x80020005L;
// MessageId: DISP_E_UNKNOWNNAME
// MessageText:
// Unknown name.
static const DISP_E_UNKNOWNNAME =0x80020006L;
// MessageId: DISP_E_NONAMEDARGS
// MessageText:
// No named arguments.
static const DISP_E_NONAMEDARGS =0x80020007L;
// MessageId: DISP_E_BADVARTYPE
// MessageText:
// Bad variable type.
static const DISP_E_BADVARTYPE =0x80020008L;
// MessageId: DISP_E_EXCEPTION
// MessageText:
// Exception occurred.
static const DISP_E_EXCEPTION =0x80020009L;
// MessageId: DISP_E_OVERFLOW
// MessageText:
// Out of present range.
static const DISP_E_OVERFLOW =0x8002000AL;
// MessageId: DISP_E_BADINDEX
// MessageText:
// Invalid index.
static const DISP_E_BADINDEX =0x8002000BL;
// MessageId: DISP_E_UNKNOWNLCID
// MessageText:
static const DISP_E_UNKNOWNLCID =0x8002000CL;
// MessageId: DISP_E_ARRAYISLOCKED
// Memory is locked.
static const DISP_E_ARRAYISLOCKED =0x8002000DL;
// MessageId: DISP_E_BADPARAMCOUNT
// MessageText:
// Invalid number of parameters.
static const DISP_E_BADPARAMCOUNT =0x8002000EL;
// MessageId: DISP_E_PARAMNOTOPTIONAL
// MessageText:
// Parameter not optional.
static const DISP_E_PARAMNOTOPTIONAL =0x8002000FL;
// MessageId: DISP_E_BADCALLEE
// MessageText:
// Invalid callee.
static const DISP_E_BADCALLEE =0x80020010L;
// MessageId: DISP_E_NOTACOLLECTION
// MessageText:
// Does not support a collection.
static const DISP_E_NOTACOLLECTION =0x80020011L;
// MessageId: DISP_E_DIVBYZERO
// MessageText:
// Division by zero.
static const DISP_E_DIVBYZERO =0x80020012L;
// MessageId: DISP_E_BUFFERTOOSMALL
// MessageText:
// Buffer too small
static const DISP_E_BUFFERTOOSMALL =0x80020013L;
end
type tcom_const = class(tagTYPEKIND,tagDESCKIND,tagTYPEFLAGS,
tagFUNCFLAGS,tagVARFLAGS,
tagFUNCKIND,tagCALLCONV,tagINVOKEKIND,tagVARKIND,
tagvtype,tagwinerr)
tagFUNCKIND,tagCALLCONV,tagINVOKEKIND,DISPID_TYPE,tagVARKIND,
tagvtype,tagwinerr,FACILITY_DISPATCH)
//////
///////////////////////////
static const IMPLTYPEFLAG_FDEFAULT = 1;
@@ -544,7 +625,6 @@ type tcom_const = class(tagTYPEKIND,tagDESCKIND,tagTYPEFLAGS,
static const IMPLTYPEFLAG_FRESTRICTED = 4;
static const IMPLTYPEFLAG_FDEFAULTVTABLE = 8;
////////////////////////////////
////////////////
static const DISPATCH_METHOD = 0x1;
static const DISPATCH_PROPERTYGET = 0x2;
@@ -922,9 +1002,9 @@ type tagTYPEATTR = class(tcom_stc_base)
("lpstrSchema","intptr",0),
("cbSizeInstance","int",0), //此类型的实例的大小。
("typekind","int",4), //TYPEKIND 值描述此信息所描述的类型。//TKIND_DISPATCH
("cFuncs","short",10), //指示此结构描述的接口上的函数数目。
("cVars","short",10), //指示此结构所描述的接口上的变量和数据字段的数目。
("cImplTypes","short",100), //指示此结构描述的接口上实现的接口的数量。
("cFuncs","short",1), //指示此结构描述的接口上的函数数目。
("cVars","short",0), //指示此结构所描述的接口上的变量和数据字段的数目。
("cImplTypes","short",0), //指示此结构描述的接口上实现的接口的数量。
("cbSizeVft","short",0), // 此类型的虚拟方法表 (VTBL) 的大小。
("cbAlignment","short",8), //指定此类型实例的字节对齐方式。
("wTypeFlags","short",TYPEFLAG_FDISPATCHABLE), //tagTYPEFLAGS
@@ -933,9 +1013,9 @@ type tagTYPEATTR = class(tcom_stc_base)
("tdescAlias","user",class(tagTYPEDESC).TYPEDESC_stc),
("idldescType","user",class(tagIDLDESC).IDLDESC_stc)
);
end
end
public
property cFuncs index "cFuncs" read _getvalue_ write _setvalue_;
function guidobj();
begin
ptr := _getvalueaddr2_("guid");
@@ -993,6 +1073,17 @@ type tagDISPPARAMS = class(tcom_stc_base)
stc := static MemoryAlignmentCalculate(DISPPARAMS_Stc());
inherited create(stc,ptr);
end
function getcnameargs();
begin
ct := _getvalue_("cNamedArgs");
r := array();
if ct>0 then
begin
p := _getvalue_("rgdispidNamedArgs");
r := mtool().readints(p,ct);
end
return r;
end
function getarg(idx);
begin
if (idx >=0) and (idx<_getvalue_("cArgs")) then
@@ -1045,9 +1136,13 @@ type tptrarray =class(tslcstructureobj)
);
inherited create(stc,ptr);
end
function ansistr();
function ansistr(idx);
begin
p := _getvalue_("ptr");
if idx>0 then
begin
p := mtool().readptr( int64(_getptr_()+idx*8));
end else
p := _getvalue_("ptr");
return wideptrtoansi(p);
end
end
@@ -1145,7 +1240,8 @@ type iunkown =class(tcom_const)
end
end
function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;virtual;
begin
begin
ppv := 0;
if IID_IUnknown.equ(riid) then
begin
ppv := _getptr_();
@@ -1211,6 +1307,11 @@ type func_mid_cache = class
frgDispIds;
frgDispIds2;
end
function Invoke_test(s:pointer;dispIdMember:integer;riid:pointer;lcid:integer;wFlags:short;pDispParams:pointer;
pVarResult:pointer;pExcepInfo:pointer;var puArgErr:integer):integer;stdcall;
begin
echo "\r\n>>>>>>idispatch>>>>>>:",functionname(1)," ",dispIdMember," ",wFlags," ",pVarResult," err:",pExcepInfo;
end
type idispatch=class(iunkown)
protected
static IID_IDispatch;
@@ -1223,6 +1324,7 @@ type idispatch=class(iunkown)
[weakref] fcom_mgr;
function create(ptr)
begin
inherited ;//create(getstruct(),ptr);
if not IID_IDispatch then
begin
@@ -1230,40 +1332,60 @@ type idispatch=class(iunkown)
IID_IDispatch.readstr("{00020400-0000-0000-C000-000000000046}");
end
if not ptr then
begin
begin
fvtable._setvalue_("GetTypeInfoCount",makeinstance(thisfunction(GetTypeInfoCount)));
fvtable._setvalue_("GetTypeInfo",makeinstance(thisfunction(GetTypeInfo)));
fvtable._setvalue_("GetIDsOfNames",makeinstance(thisfunction(GetIDsOfNames)));
fvtable._setvalue_("Invoke",makeinstance(thisfunction(Invoke_)));
fvtable._setvalue_("GetTypeInfo",makeinstance(thisfunction(GetTypeInfo)));
fvtable._setvalue_("GetIDsOfNames",makeinstance(thisfunction(GetIDsOfNames)));
fvtable._setvalue_("Invoke",makeinstance(thisfunction(Invoke_)));
//echo tostn(fvtable._getdata_);
end
fglobalL := TS_GetGlobalL();
end
function GetTypeInfoCount(s:pointer;var pctinfo:integer):integer;stdcall;virtual;
begin
//echo "\r\n>>>>>>idispatch:",functionname(1);
return E_NOTIMPL;
echo "\r\n>>>>>>idispatch:",functionname(1);
pctinfo := 0;
ns := fcom_mgr.method_names();
if ifarray(ns) and ns then
begin
pctinfo := 1;
for i,v in ns do
begin
get_func_str_id(lowercase(v));
end
return S_OK;
end
return E_NOTIMPL;
//return E_NOTIMPL;
return 1;
//return E_NOTIMPL S_OK
end
function GetTypeInfo(s:pointer;iTInfo:integer;lcid:integer;var ppTInfo:pointer):integer;stdcall;virtual;
begin
//echo "\r\n>>>>>>idispatch:",functionname(1),iTInfo," ",lcid," ",ppTInfo;
ppTInfo := 0;
return E_NOTIMPL;
if not fcom_mgr.method_names() then return E_NOTIMPL;
if not ftypeinfo then
begin
ftypeinfo := new ITypeInfo();
ftypeinfo := new ITypeInfo();
ftypeinfo.fcom_mgr := fcom_mgr;
end
ppTInfo := ftypeinfo._getptr_();
echo "====",ppTInfo;
return S_OK;
return E_NOTIMPL;
//return S_OK, DISP_E_BADINDEX
end
function GetIDsOfNames(s:pointer;riid:pointer;rgszNames:pointer;cNames:integer;lcid:integer;var rgDispId:integer):integer;stdcall;virtual;
begin
//echo "\r\n>>>>>>idispatch:",functionname(1)," ",lcid," ",cNames;
//echo "\r\n>>>>>>idispatch:",functionname(1)," ",riid," ",lcid," ",cNames;
//return E_NOTIMPL;
if cnames>1 then return E_INVALIDARG;
ostr := new tptrarray(rgszNames);
rgDispId := get_func_str_id(ostr.ansistr);
rgDispId := get_func_str_id(ostr.ansistr());
return S_OK;
//E_OUTOFMEMORY DISP_E_UNKNOWNNAME DISP_E_UNKNOWNLCID
end
function Invoke_(s:pointer;dispIdMember:integer;riid:pointer;lcid:integer;wFlags:short;pDispParams:pointer;
pVarResult:pointer;pExcepInfo:pointer;var puArgErr:integer):integer;stdcall;virtual;
@@ -1275,7 +1397,6 @@ type idispatch=class(iunkown)
FInvokename := fname;
if pVarResult then
begin
//AddRef(s);
rv := new tagVARIANT( pVarResult);
rv._setvalue_("vt" , VT_DISPATCH);
rv._setvalue_("data",s);
@@ -1289,16 +1410,18 @@ type idispatch=class(iunkown)
pms := trans_params(pDispParams);
x := fcom_mgr.invoke_call(fname,pms);
if pVarResult then ObjToVariantRef(fglobalL,x,pVarResult,fcom_mgr.execute_retun_is_excel(fname));
return 0;
return S_OK;
end else
if wFlags = 4 then
if (wFlags .& 4) or (wFlags .& 8) then
begin
fcom_mgr.invoke_propertyset(fname,trans_params(pDispParams)[0]);
end
return 0;
return S_OK;
//////////////返回很多错误类型//////
end
function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;virtual;
begin
function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;override;
begin
ppv := 0;
if IID_IUnknown.equ(riid) or IID_IDispatch.equ(riid) then
begin
ppv := _getptr_();
@@ -1316,10 +1439,16 @@ type idispatch=class(iunkown)
end
return r;
end
function AddRef(s:pointer):integer;stdcall;virtual;
begin
r := inherited;
return r;
end
private
function trans_params(pDispParams);
begin
o := new tagDISPPARAMS(pDispParams);
o := new tagDISPPARAMS(pDispParams);
//echo "\r\ncnamecout:",tostn(o.getcnameargs());
pp := o.getArgs();
pms := array();
for idx,p1 in pp do
@@ -1341,6 +1470,7 @@ type ITypeInfo=class(iunkown)
return new ITypeInfoVtbl(ptr);
end
public
[weakref] fcom_mgr;
function create(ptr)
begin
nptr := not ptr;
@@ -1377,6 +1507,7 @@ type ITypeInfo=class(iunkown)
end
function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;virtual;
begin
ppv := 0;
if IID_IUnknown.equ(riid) or IID_ITypeInfo.equ(riid) then
begin
ppv := _getptr_();
@@ -1404,12 +1535,13 @@ type ITypeInfo=class(iunkown)
if ifnil(ftypeattr) then
begin
ftypeattr := new tagTYPEATTR();
global G_CURRENT_CLSID;
ftypeattr.guidobj().readstr(G_CURRENT_CLSID);
ftypeattr.guidobj().readstr(fcom_mgr.get_clsid());
ns := fcom_mgr.method_names();
if ifarray(ns) then ftypeattr.cFuncs := length(ns) ;
end
pptypeattr := ftypeattr._getptr_();
return S_OK;
//return E_NOTIMPL;
//return E_INVALIDARG ,E_OUTOFMEMORY,S_OK;
end
function GetTypeComp(sf:pointer;var ppTComp:pointer):integer;stdcall;virtual;
begin
@@ -1420,33 +1552,36 @@ type ITypeInfo=class(iunkown)
fITypecomp.fitypeinfo := sf;
end
ppTComp := fITypecomp._getptr_();
return 0;
//return E_NOTIMPL;
return S_OK;
//return E_INVALIDARG ,E_OUTOFMEMORY,S_OK;
end
function GetFuncDesc(sf:pointer;idx:integer;var ppFuncDesc:pointer):integer;stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1)," ",idx," ",ppFuncDesc;
//return E_NOTIMPL;
if not fFuncDesc then fFuncDesc := get_funcs_info();
fFuncDesc._setvalue_("memid",idx);
fFuncDesc._setvalue_("memid",idx+1);
ppFuncDesc := fFuncDesc._getptr_();
return S_OK;
//return E_INVALIDARG ,E_OUTOFMEMORY,S_OK;
end
fFuncDesc;
function GetVarDesc(sf:pointer;index:integer;var ppFuncDesc:pointer):integer;stdcall;virtual;
function GetVarDesc(sf:pointer;index:integer;var ppVarDesc:pointer):integer;stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1);
//return E_NOTIMPL;
return E_NOTIMPL;
//return E_INVALIDARG ,E_OUTOFMEMORY,S_OK;
end
function GetNames(sf:pointer;memid:integer;rgBstrNames:pointer;cMaxNames:integer;var pcNames:integer):integer;stdcall;virtual; //处理命名参数问题
function GetNames(sf:pointer;memid:integer;var rgBstrNames:pointer;cMaxNames:integer;var pcNames:integer):integer;stdcall;virtual; //处理命名参数问题
begin
echo "\r\n===ITypeInfo:",functionname(1)," ",memid," ",rgBstrNames," ",cMaxNames," ",pcNames;
return E_NOTIMPL;
return E_NOTIMPL;
//return E_INVALIDARG ,E_OUTOFMEMORY,S_OK;
end
function GetRefTypeOfImplType(sf:pointer;index:integer;pRefType:pointer):integer;stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1);
//return E_NOTIMPL;
return E_NOTIMPL;
end
function GetImplTypeFlags(sf:pointer;index:integer;pRefType:pointer):integer;stdcall;virtual;
begin
@@ -1462,53 +1597,67 @@ type ITypeInfo=class(iunkown)
pVarResult:pointer;pExcepInfo:pointer;var puArgErr:integer):integer;stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1);
return E_NOTIMPL;
return E_NOTIMPL;
//return DISP_E_EXCEPTION E_INVALIDARG S_OK;
end
function GetDocumentation():integer;stdcall;virtual;
function GetDocumentation(s:pointer;memid:integer; var pBstrName:pointer; var pBstrDocString:pointer; var pdwHelpContext:integer; var pBstrHelpFile:pointer):integer;stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1);
pBstrName := 0;
pBstrDocString := 0;
pdwHelpContext := 0;
pBstrHelpFile := 0;
//pBstrName := pBstrDocString := pdwHelpContext := pBstrHelpFile := 0 ;
return S_OK;
return E_NOTIMPL;
end
function GetDllEntry():integer;stdcall;virtual;
function GetDllEntry(s:pointer;memid:integer;invkind:integer;var pbstrdllname:pointer;var pbstrname:pointer;var pwordinal:short):integer;stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1);
return E_NOTIMPL;
pbstrdllname := 0;
pbstrname := 0;
pwordinal := 0;
return S_OK;
//return E_INVALIDARG,E_OUTOFMEMORY;
end
function GetRefTypeInfo(sf:pointer;hRefType:integer;ITypeInfo:pointer):integer;stdcall;virtual;
function GetRefTypeInfo(sf:pointer;hRefType:integer;var ITypeInfo:pointer):integer;stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1);
return E_NOTIMPL;
end
function AddressOfMember(sf:pointer;memid:integer;invKind:integer;ppv:pointer):integer;stdcall;virtual;
function AddressOfMember(sf:pointer;memid:integer;invKind:integer;var ppv:pointer):integer;stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1);
return E_NOTIMPL;
//return S_OK;
end
function CreateInstance(s:pointer;known:pointer;riid:pointer;var ppvObject:pointer):integer;stdcall;virtual;//
begin
echo "\r\n===ITypeInfo:",functionname(1);
return E_NOINTERFACE;
end
function GetMops(sf:pointer;memid:integer;pBstrMops:pointer):integer;stdcall;virtual;
function GetMops(sf:pointer;memid:integer;var pBstrMops:pointer):integer;stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1);
return E_NOTIMPL;
pBstrMops := 0;
return S_OK;
end
function GetContainingTypeLib(sf:pointer;ppTLib:pointer;var pIndex:integer):integer;stdcall;virtual;
function GetContainingTypeLib(sf:pointer;var ppTLib:pointer;var pIndex:integer):integer;stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1);
ppTLib := 0;ppTLib := -1;
return E_NOINTERFACE;
return E_NOTIMPL;
end
procedure ReleaseTypeAttr(sf:pointer;pTypeAttr:pointer);stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1)," ",sf;
pTypeAttr := 0;
//ftypeattr := nil;
//pTypeAttr := 0;
end
procedure ReleaseFuncDesc(sf:pointer;pFuncDesc:pointer);stdcall;virtual;
begin
echo "\r\n===ITypeInfo:",functionname(1);
//pFuncDesc := 0;
//fFuncDesc := nil;
end
procedure ReleaseVarDesc(sf:pointer;pVarDesc:pointer);stdcall;virtual;
begin
@@ -1516,8 +1665,7 @@ type ITypeInfo=class(iunkown)
end
private
ftypeattr;
fITypecomp;
fITypecomp;
end
function get_funcs_info();
begin
@@ -1534,6 +1682,7 @@ type ITypecomp=class(iunkown)
return new ITypecompVtbl(ptr);
end
public
[weakref] fcom_mgr;
function create(ptr)
begin
nptr := not ptr;
@@ -1552,6 +1701,7 @@ type ITypecomp=class(iunkown)
end
function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;override;
begin
ppv := 0;
if IID_IUnknown.equ(riid) or IID_ITypeComp.equ(riid) then
begin
ppv := _getptr_();
@@ -1651,6 +1801,7 @@ type IClassFactory=class(iunkown)
end
function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;override;
begin
ppv := 0;
if IID_IUnknown.equ(riid) or IID_IClassFactory.equ(riid) then
begin
ppv := _getptr_();
@@ -1912,6 +2063,9 @@ end
function wideptrtoansi(p);
begin
if not p then return "";
r := wideptr_to_ansi(p);
return r;
wlen := uaw_wcslen(p);
sansi := "";
if wlen>0 then
@@ -1925,9 +2079,26 @@ begin
end
return sansi;
end
function wideptr_to_ansi(s);
begin
_f_ := static function(s:pointer):string;cdecl;external makeinstance(thisfunction(wideptr_to_ansi_i));
k := call(_f_,s);
return k;
end
function wideptr_to_ansi_i( s:widestring):pointer;
begin
global g_wideptr_to_ansi_i_return;
g_wideptr_to_ansi_i_return := string(s);
return get_tsl_mem_ptr(g_wideptr_to_ansi_i_return);
end
function gbk_to_wideptr(s,wsowner);
begin
wsowner := widestring(s);
return get_tsl_mem_ptr(wsowner);
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 CoRevokeClassObject(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";
procedure VariantToObj2(L:pointer; V:pointer; var o:tObject;isIndex:integer);cdecl;external "tslkrnl.dll" name "VariantToObj2";
@@ -1940,5 +2111,8 @@ function WideCharToMultiByte(CodePage:integer;dwFlags:integer;lpWideCharStr:poin
function MultiByteToWideChar(CodePage:integer;dwFlags:integer;lpMultiByteStr:string;
cchMultiByte:integer;lpWideCharStr:pointer;cchWideChar:integer):integer;stdcall;external "Kernel32.dll" name "MultiByteToWideChar";
function LoadRegTypeLib(rguid:pointer; wVerMajor:short; wVerMinor:short;lcid:integer;var pptlib:pointer):pointer;cdecl;external "Oleaut32.dll" name "LoadRegTypeLib";
function CoTaskMemAlloc(cb:pointer):pointer;stdcall;external "Ole32.dll" name "CoTaskMemAlloc";
function CoTaskMemRealloc(pv:pointer;cb:pointer):pointer;stdcall;external "Ole32.dll" name "CoTaskMemRealloc";
procedure CoTaskMemFree(cb:pointer);stdcall;external "Ole32.dll" name "CoTaskMemFree";
initialization
end.
funcext/tvclib/utslvclauxiliary.tsf
+10 -2
View File
@@ -1653,7 +1653,7 @@ type TNode = class() //
bidx := idx0;
for i,it in its do
begin
if(it is class(TNode))and(not it.Parent)then
if node_insert_check(it) then
begin
FItems.InsertBefor(it,idx0);
FCurrentAddNode := it;
@@ -1670,7 +1670,7 @@ type TNode = class() //
@param(it)(TNode) 字符串 %%
@param(idx)(integer) 序号 默认为0 %%
**}
if(it is class(TNode))and(not it.Parent)then
if node_insert_check(it) then
begin
if idx<0 then idx := 0;
if idx>FItems.Count then idx := FItems.Count;
@@ -1682,6 +1682,10 @@ type TNode = class() //
return true;
end
end
function node_insert_check(it);virtual;
begin
return (it is class(TNode))and(not it.Parent);
end
function Expand();virtual; //展开
begin
FExpanded := true;
@@ -4317,6 +4321,10 @@ end
function get_tsl_mem_ptr(s,n);
begin
ptr := static makeinstance(thisfunction(get_tsl_ptr_drift));
if ifwstring(s) then
begin
_f_ := static function(var v:widestring;n:integer):pointer;cdecl;external ptr;
end else
if ifstring(s) then
begin
_f_ := static function(var v:string;n:integer):pointer;cdecl;external ptr;
funcext/tvclib/utvclgraphics.tsf
+668 -100
View File
File diff suppressed because it is too large Load Diff
plugin/TSLCPLUGIN.DLL
BIN
View File
Binary file not shown.
plugin/TSLUIL.dll
BIN
View File
Binary file not shown.
tsleditor.exe
BIN
View File
Binary file not shown.
tslkrnl.dll
BIN
View File
Binary file not shown.
whatsnew.txt
+3
View File
@@ -1,3 +1,6 @@
更新日志--------2024-06-11
修正：启用的新的流格式存在诱发崩溃的问题。
更新日志--------2024-06-02
修正：officeplugin的问题。
修正：数据库连接采用JDBC驱动时在无主键sqltable插入时数据异常时的问题。