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