paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 09:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patches from Ludo Brands for typelib

Browse Source 
- Mantis #21516 fix range check error
  - Mantis #21513 Specific workaround for potentially bugged Office10/MSacc.OLB

git-svn-id: trunk@20544 -
This commit is contained in:
marco 2012-03-20 18:53:38 +00:00
parent 0e0a5dee4f
commit ecb34fb8da
1 changed files with 16 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
packages/winunits-base/src/typelib.pas
View File

@ -475,6 +475,14 @@ var
end; end;
end; end;
function GetName(i:integer):string; //bug in Office10\MSacc.OLB _WizHook.Key
begin
if i<cnt then
result:=BL[i]
else
result:='Param'+inttostr(i);
end;
begin begin
Propertycnt:=0; Propertycnt:=0;
SetLength(aPropertyDefs,TA^.cFuncs+TA^.cVars); // worst case, all functions getters or all setters SetLength(aPropertyDefs,TA^.cFuncs+TA^.cVars); // worst case, all functions getters or all setters
@ -518,8 +526,6 @@ begin
((sl='gettypeinfocount') or (sl='gettypeinfo') or (sl='getidsofnames') or (sl='invoke')) then //IDispatch ((sl='gettypeinfocount') or (sl='gettypeinfo') or (sl='getidsofnames') or (sl='invoke')) then //IDispatch
continue; continue;
// get return type // get return type
if iname='DocumentProperty' then
sl:=sl; //remove
if bIsDispatch and ((FD^.invkind=INVOKE_PROPERTYGET) or (FD^.invkind=INVOKE_FUNC)) then if bIsDispatch and ((FD^.invkind=INVOKE_PROPERTYGET) or (FD^.invkind=INVOKE_FUNC)) then
begin begin
sType:=TypeToString(TI,FD^.elemdescFunc.tdesc); sType:=TypeToString(TI,FD^.elemdescFunc.tdesc);
@ -590,8 +596,6 @@ begin
sl:=TypeToString(TI,FD^.lprgelemdescParam[k].tdesc); sl:=TypeToString(TI,FD^.lprgelemdescParam[k].tdesc);
bParamByRef:=(FD^.lprgelemdescParam[k].tdesc.vt=VT_PTR) and // by ref bParamByRef:=(FD^.lprgelemdescParam[k].tdesc.vt=VT_PTR) and // by ref
not((FD^.lprgelemdescParam[k].tdesc.lptdesc^.vt=VT_USERDEFINED) and bIsInterface);// but not pointer to interface not((FD^.lprgelemdescParam[k].tdesc.lptdesc^.vt=VT_USERDEFINED) and bIsInterface);// but not pointer to interface
if BL[k+1]='pFormat' then
sl:=sl; //remove
if bParamByRef then if bParamByRef then
delete(sl,1,1); delete(sl,1,1);
if bIsDispatch and not bIsAutomatable then if bIsDispatch and not bIsAutomatable then
@ -606,8 +610,8 @@ begin
PARAMFLAG_FOUT:sPar:='out '; PARAMFLAG_FOUT:sPar:='out ';
PARAMFLAG_FIN:sPar:='var '; //constref in safecall? TBD PARAMFLAG_FIN:sPar:='var '; //constref in safecall? TBD
end; end;
if not MakeValidId(BL[k+1],sVarName) then if not MakeValidId(GetName(k+1),sVarName) then
AddToHeader('// Warning: renamed parameter ''%s'' in %s.%s to ''%s''',[BL[k+1],iname,sMethodName,sVarName],True); AddToHeader('// Warning: renamed parameter ''%s'' in %s.%s to ''%s''',[GetName(k+1),iname,sMethodName,sVarName],True);
sPar:=sPar+format('%s:%s;',[sVarName,sl]); sPar:=sPar+format('%s:%s;',[sVarName,sl]);
sFunc:=sFunc+sPar; sFunc:=sFunc+sPar;
if bCreateEvents then if bCreateEvents then
@ -696,8 +700,8 @@ begin
sPropParam2:=''; sPropParam2:='';
if bPropHasParam then if bPropHasParam then
begin begin
if not MakeValidId(BL[1],sPropParam) then if not MakeValidId(GetName(1),sPropParam) then
AddToHeader('// Warning: renamed property index ''%s'' in %s.%s to ''%s''',[BL[1],iname,sMethodName,sPropParam]); AddToHeader('// Warning: renamed property index ''%s'' in %s.%s to ''%s''',[GetName(1),iname,sMethodName,sPropParam]);
sPropParam:=sPropParam+':'+TypeToString(TI,FD^.lprgelemdescParam[0].tdesc); sPropParam:=sPropParam+':'+TypeToString(TI,FD^.lprgelemdescParam[0].tdesc);
end; end;
if bIsDispatch then if bIsDispatch then
@ -734,8 +738,6 @@ begin
sPropParam3:=sPropParam+'; const par'+sMethodName; sPropParam3:=sPropParam+'; const par'+sMethodName;
sPropParam:='['+sPropParam+']'; sPropParam:='['+sPropParam+']';
end; end;
if sMethodName='SelectedItem' then
sl:=sl; //remove
if FD^.invkind=INVOKE_PROPERTYGET then if FD^.invkind=INVOKE_PROPERTYGET then
begin begin
s:=s+format(' function Get_%s%s : %s; %s;'#13#10,[sMethodName,sPropParam2,sType,sConv]); s:=s+format(' function Get_%s%s : %s; %s;'#13#10,[sMethodName,sPropParam2,sType,sConv]);
@ -752,8 +754,8 @@ begin
end end
else else
begin begin
if not MakeValidId(BL[1],sVarName) then if not MakeValidId(GetName(1),sVarName) then
AddToHeader('// Warning: renamed parameter ''%s'' in %s.Set_%s to ''%s''',[BL[1],iname,sMethodName,sVarName]); AddToHeader('// Warning: renamed parameter ''%s'' in %s.Set_%s to ''%s''',[GetName(1),iname,sMethodName,sVarName]);
with aPropertyDefs[findProperty(FD^.memid)] do with aPropertyDefs[findProperty(FD^.memid)] do
begin begin
if FD^.invkind=INVOKE_PROPERTYPUT then if FD^.invkind=INVOKE_PROPERTYPUT then
@ -1350,7 +1352,7 @@ begin
if (TA^.wTypeFlags and TYPEFLAG_FDUAL)=TYPEFLAG_FDUAL then if (TA^.wTypeFlags and TYPEFLAG_FDUAL)=TYPEFLAG_FDUAL then
begin begin
//get TKIND_INTERFACE //get TKIND_INTERFACE
OleCheck(TI.GetRefTypeOfImplType(-1,RTIT)); OleCheck(TI.GetRefTypeOfImplType($ffffffff,RTIT));
OleCheck(TI.GetRefTypeInfo(RTIT,TIref)); OleCheck(TI.GetRefTypeInfo(RTIT,TIref));
//get its ancestor //get its ancestor
OleCheck(TIref.GetRefTypeOfImplType(0,RTIT)); OleCheck(TIref.GetRefTypeOfImplType(0,RTIT));
@ -1676,7 +1678,7 @@ begin
if ((il mod 16)=0) and (il>0) then if ((il mod 16)=0) and (il>0) then
sl:=sl+'+'#13#10; sl:=sl+'+'#13#10;
end; end;
sl:=format('LazarusResources.Add(''T%s'',''BMP'',['#13#10,[BstrName]) sl:=format('LazarusResources.Add(''TAxc%s'',''BMP'',['#13#10,[BstrName])
+ sl + #13#10']);'#13#10; + sl + #13#10']);'#13#10;
FAXImages.Add(sl); FAXImages.Add(sl);
end; end;