这里有两个错误。
首先在Variants.DynArrayVariantBounds
. 当动态数组是nil
this 错误地返回一个低/高边界对(0, 0)
. 它应该返回(0, -1)
。此错误已在最新版本的 Delphi 中修复。这会导致V := sa
返回一个带有单个空元素的变体数组。
第二个错误影响另一个方向,sa := V
. 这个错误仍然存在于最新版本的 Delphi 中。这个错误在Variants.DynArrayFromVariant
. 有一个repeat/until
循环遍历输入变量数组并填充输出动态数组。当输入变量数组为空时,不应进入该repeat/until
循环。但是,代码错误地这样做并尝试使用 读取变体数组的元素VarArrayGet
。由于数组为空,因此会引发运行时错误。我已经报告了这个:QC#109445。
这是修复错误的非常简单的代码。请注意,我只考虑了数组是一维的情况。如果您需要支持更高维的数组,那么您可以扩展这种方法来做到这一点。
program Project1;
{$APPTYPE CONSOLE}
uses
Variants;
var
OriginalVarFromDynArray: procedure(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
OriginalVarToDynArray: procedure(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
function DynArrayVarType(typeInfo: PDynArrayTypeInfo): Integer;
const
tkDynArray = 17;
begin
Result := varNull;
if (typeInfo<>nil) and (typeInfo.Kind=tkDynArray) then
begin
Inc(PChar(typeInfo), Length(typeInfo.name));
Result := typeInfo.varType;
if Result=$48 then
Result := varString;
end;
if (Result<=varNull) or (Result=$000E) or (Result=$000F) or ((Result>varInt64) and not (Result=varString)) then
VarCastError;
end;
procedure VarFromDynArray(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
var
VarType, DynDim: Integer;
begin
DynDim := DynarrayDim(PDynArrayTypeInfo(TypeInfo));
if DynDim=1 then
begin
//only attempt to deal with 1 dimensional arrays
if DynArray=nil then begin
VarClear(V);
VarType := DynArrayVarType(PDynArrayTypeInfo(TypeInfo));
if VarType = varString then
VarType := varOleStr;
V := VarArrayCreate([0, -1], VarType);
exit;
end;
end;
OriginalVarFromDynArray(V, DynArray, TypeInfo);
end;
procedure VarToDynArray(var DynArray: Pointer; const V: Variant; TypeInfo: Pointer);
var
DimCount: Integer;
Len: Integer;
begin
DimCount:= VarArrayDimCount(V);
if DimCount=1 then
begin
//only attempt to deal with 1 dimensional arrays
Len := VarArrayHighBound(V, 1) - VarArrayLowBound(V, 1) + 1;
if Len=0 then begin
DynArraySetLength(DynArray, PDynArrayTypeInfo(TypeInfo), 1, @Len);
exit;
end;
end;
OriginalVarToDynArray(DynArray, V, TypeInfo);
end;
procedure FixVariants;
var
VarMgr: TVariantManager;
begin
GetVariantManager(VarMgr);
OriginalVarFromDynArray := VarMgr.VarFromDynArray;
VarMgr.VarFromDynArray := VarFromDynArray;
OriginalVarToDynArray := VarMgr.VarToDynArray;
VarMgr.VarToDynArray := VarToDynArray;
SetVariantManager(VarMgr);
end;
type
TDynamicStringArray = array of string;
var
V: Variant;
sa: TDynamicStringArray;
begin
FixVariants;
sa := nil;
V := sa;
sa := V;
Writeln(Length(sa));
Readln;
end.