parent
1ed266f959
commit
d46e01f8fb
BIN
MathKrnl.dll
BIN
MathKrnl.dll
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
BIN
TSLInterp.dll
BIN
TSLInterp.dll
Binary file not shown.
|
|
@ -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
|
||||
|
|
@ -934,8 +1014,8 @@ type tagTYPEATTR = class(tcom_stc_base)
|
|||
("idldescType","user",class(tagIDLDESC).IDLDESC_stc)
|
||||
);
|
||||
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,8 +1136,12 @@ type tptrarray =class(tslcstructureobj)
|
|||
);
|
||||
inherited create(stc,ptr);
|
||||
end
|
||||
function ansistr();
|
||||
function ansistr(idx);
|
||||
begin
|
||||
if idx>0 then
|
||||
begin
|
||||
p := mtool().readptr( int64(_getptr_()+idx*8));
|
||||
end else
|
||||
p := _getvalue_("ptr");
|
||||
return wideptrtoansi(p);
|
||||
end
|
||||
|
|
@ -1146,6 +1241,7 @@ type iunkown =class(tcom_const)
|
|||
end
|
||||
function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;virtual;
|
||||
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
|
||||
|
|
@ -1231,39 +1333,59 @@ type idispatch=class(iunkown)
|
|||
end
|
||||
if not ptr then
|
||||
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_)));
|
||||
//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.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;
|
||||
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);
|
||||
//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_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
|
||||
|
|
@ -1463,52 +1598,66 @@ type ITypeInfo=class(iunkown)
|
|||
begin
|
||||
echo "\r\n===ITypeInfo:",functionname(1);
|
||||
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(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);
|
||||
pbstrdllname := 0;
|
||||
pbstrname := 0;
|
||||
pwordinal := 0;
|
||||
return S_OK;
|
||||
//return E_INVALIDARG,E_OUTOFMEMORY;
|
||||
end
|
||||
function GetRefTypeInfo(sf:pointer;hRefType:integer;var ITypeInfo:pointer):integer;stdcall;virtual;
|
||||
begin
|
||||
echo "\r\n===ITypeInfo:",functionname(1);
|
||||
return E_NOTIMPL;
|
||||
end
|
||||
function GetDllEntry():integer;stdcall;virtual;
|
||||
begin
|
||||
echo "\r\n===ITypeInfo:",functionname(1);
|
||||
return E_NOTIMPL;
|
||||
end
|
||||
function GetRefTypeInfo(sf:pointer;hRefType:integer;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
|
||||
|
|
@ -1517,7 +1666,6 @@ type ITypeInfo=class(iunkown)
|
|||
private
|
||||
ftypeattr;
|
||||
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.
|
||||
|
|
@ -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;
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
BIN
tsleditor.exe
BIN
tsleditor.exe
Binary file not shown.
BIN
tslkrnl.dll
BIN
tslkrnl.dll
Binary file not shown.
|
|
@ -1,3 +1,6 @@
|
|||
更新日志--------2024-06-11
|
||||
修正：启用的新的流格式存在诱发崩溃的问题。
|
||||
|
||||
更新日志--------2024-06-02
|
||||
修正：officeplugin的问题。
|
||||
修正：数据库连接采用JDBC驱动时在无主键sqltable插入时数据异常时的问题。
|
||||
|
|
|
|||
Loading…
Reference in New Issue