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

* Fixed bug #7159 and implemented clear/copy/redim for interface/widestring/variant arrays

Browse Source 
git-svn-id: trunk@5930 -
This commit is contained in:
michael 2007-01-12 20:16:44 +00:00
parent ea0fc335d1
commit 63af3b33a1
1 changed files with 56 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
rtl/objpas/varutils.inc
View File

@ -278,7 +278,7 @@ begin
end; end;
type type
TVariantArrayType = (vatNormal, vatInterface, vatWideString); TVariantArrayType = (vatNormal, vatInterface, vatWideString, vatVariant);
Function VariantArrayType(psa: PVarArray): TVariantArrayType; Function VariantArrayType(psa: PVarArray): TVariantArrayType;
@ -288,7 +288,9 @@ begin
Result:=vatInterface Result:=vatInterface
else if (psa^.Flags AND ARR_OLESTR) <> 0 then else if (psa^.Flags AND ARR_OLESTR) <> 0 then
Result:=vatWideString Result:=vatWideString
else else if (psa^.Flags and ARR_VARIANT) <> 0 then
Result := vatVariant
else
Result:=vatNormal; Result:=vatNormal;
end; end;
@ -296,16 +298,32 @@ Function SafeArrayClearDataSpace(psa: PVarArray; WipeBytes: Boolean {= True}): H
var var
vat: TVariantArrayType; vat: TVariantArrayType;
P : Pointer;
J,Count : Integer;
begin begin
try try
count:=SafeArrayElementTotal(psa);
vat:=VariantArrayType(psa); vat:=VariantArrayType(psa);
case vat of case vat of
vatNormal : FillChar(psa^.Data^, vatNormal : FillChar(psa^.Data^,Count*psa^.ElementSize,0);
SafeArrayElementTotal(psa)*psa^.ElementSize, vatInterface :
0); for j := 0 to Count - 1 do
vatInterface : NoInterfaces; begin
vatWideString : NoWidestrings; P := SafeArrayCalculateElementAddress(psa,j);
IUnknown(PUnknown(P)^):=Nil
end;
vatWideString :
for j := 0 to Count - 1 do
begin
P := SafeArrayCalculateElementAddress(psa,j);
WideString(PPointer(P)^):='';
end;
vatVariant :
for j := 0 to Count - 1 do
begin
P := SafeArrayCalculateElementAddress(psa,j);
VariantClear(PVarData(P)^);
end;
end; end;
Result:=VAR_OK; Result:=VAR_OK;
except except
@ -317,15 +335,35 @@ end;
Function SafeArrayCopyDataSpace(psa, psaOut: PVarArray): HRESULT; Function SafeArrayCopyDataSpace(psa, psaOut: PVarArray): HRESULT;
var var
vat: TVariantArrayType; vat: TVariantArrayType;
P1,P2 : Pointer;
J,Count : Integer;
begin begin
try try
Count:=SafeArrayElementTotal(psa);
vat:=VariantArrayType(psa); vat:=VariantArrayType(psa);
case vat of case vat of
vatNormal: Move(psa^.Data^, vatNormal: Move(psa^.Data^,psaOut^.Data^,Count*psa^.ElementSize);
psaOut^.Data^, vatInterface :
SafeArrayElementTotal(psa)*psa^.ElementSize); for j := 0 to Count - 1 do
vatInterface : NoInterfaces; // Copy element per element... begin
vatWideString: NoWideStrings; // here also... P1 := SafeArrayCalculateElementAddress(psa,j);
P2 := SafeArrayCalculateElementAddress(psaout,j);
IUnknown(PUnknown(P2)^):=IUnknown(PUnknown(P1)^);
end;
vatWideString :
for j := 0 to Count - 1 do
begin
P1 := SafeArrayCalculateElementAddress(psa,j);
P2 := SafeArrayCalculateElementAddress(psaOut,j);
WideString(PPointer(P2)^):=WideString(PPointer(P1)^);
end;
vatVariant :
for j := 0 to Count - 1 do
begin
P1 := SafeArrayCalculateElementAddress(psa,j);
P2 := SafeArrayCalculateElementAddress(psaOut,j);
VariantCopy(PVarData(P2)^,PVarData(P2)^);
end;
end; end;
Result:=VAR_OK; Result:=VAR_OK;
except except
@ -485,9 +523,11 @@ begin
begin begin
P:=SafeArrayCalculateElementAddress(psa,j); P:=SafeArrayCalculateElementAddress(psa,j);
if vat = vatInterface then if vat = vatInterface then
NoInterfaces // Set to nil IUnknown(PPointer(P)^):=Nil
else else if vat=vatWideString then
NoWideStrings; // Set to empty... WideString(PPointer(P)^):=''
else if vat=vatVariant then
VariantClear(PVarData(P)^);
end; end;
end; end;
ReAllocMem(psa^.Data,Count+D); ReAllocMem(psa^.Data,Count+D);