苹果写了一个对动态数组操作的类，为了在COM中传递可变参数，但是有些地方不明，请高手指教

Question

{ *********************************************************************** }
{                                                                         }
{                   CopyRight eastphoenix 2003-02-09                      }
{                         [email protected]                             }
{                                                                         }
{                       用于在COM中传递可变参数                           }
{           欢迎进行改进，请您通知我一声，大家一起提高，谢谢！            }
{ *********************************************************************** }
unit unitVariantArray;interface
uses Variants,Windows;type
  VariantInfo = record
    fieldName:string;           //字段名
    fieldValue:string;          //字段值
  end;
type
  VariantArrayType = array of VariantInfo;type
  TVariantArray = class(TObject)
    private
      arrayLength:integer;        //数组长度，类构造时提供
      tempArray:Variant;
      tempPointer:Pointer;
      arrayData:VariantArrayType; //带结构的变长数组
    public
      //构造函数，输入构造数组的长度
      constructor Create(const newArrayLength:integer);overload;
      //析构函数
      destructor Destroy;                                           
      procedure Free;
      //设置数组的一条记录的值，num是数组的下标，FieldName是字段名，FieldValue是字段值
      procedure SetValue(const num:integer;FieldName:string;FieldValue:string);
      //取数组的一条记录的值，num是数组的下标，FieldName是字段名，FieldValue是字段值
      procedure GetValue(const num:integer;out FieldName:string;out FieldValue:string);
      //取数组长度
      function GetArrayLength:integer;
      //为数组整体赋值，inData由COM传递过来
      procedure SetArray(const inData:OleVariant);
      //从数组中取值，outData为一个需要传给COM的变量
      procedure GetArray(out outData:OleVariant);
    end;implementation{ TVariantArray }constructor TVariantArray.Create(const newArrayLength: integer);
begin
  self.arrayLength := newArrayLength;
  setlength(self.arrayData,newArrayLength);
  self.tempArray := VarArrayCreate([0,sizeof(arrayData)],varByte);
end;destructor TVariantArray.Destroy;
begin
  setlength(self.arrayData,0);
  Finalize(self.arrayData); //是否还需要这步
  self.arrayData := nil;
end;procedure TVariantArray.Free;
begin
  if self <> nil then self.Destroy;
end;procedure TVariantArray.GetArray(out outData: OleVariant);
begin
  self.tempPointer := VarArrayLock(self.tempArray);
  Move(self.arrayData,self.tempPointer^,sizeof(self.arrayData));
  VarArrayUnLock(self.tempArray);
  outData := self.tempArray;
end;function TVariantArray.GetArrayLength: integer;
begin
  result := self.arrayLength;
end;procedure TVariantArray.GetValue(const num: integer;
  out FieldName: string; out FieldValue: string);
begin
  FieldName := self.arrayData[num].fieldName;
  FieldValue := self.arrayData[num].fieldValue;
end;procedure TVariantArray.SetArray(const inData: OleVariant);
begin
  self.tempArray := inData;
  self.tempPointer := VarArrayLock(self.tempArray);
  Move(self.tempPointer^,self.arrayData,sizeof(self.arrayData));
  VarArrayUnLock(self.tempArray);
end;procedure TVariantArray.SetValue(const num: integer; FieldName,
  FieldValue: string);
begin
  try
    self.arrayData[num].fieldName := FieldName;
    self.arrayData[num].fieldValue := FieldValue;
  except
    raise;
  end;
end;end.

Answer 1

Exampleprocedure TForm1.Button3Click(Sender: TObject);
var
  test:IVariantArray;
  aaa:TVariantArray;
  bbb:TVariantArray;
  SendData,GettedData:OleVariant;
  i,j:integer;
  msgString:string;
  fieldName,fieldValue:string;
begin
  test := CoVariantArray.Create;
  try
    aaa := TVariantArray.Create(3);
    bbb := TVariantArray.Create(3);
    try
      aaa.SetValue(0,'bookid','0');
      aaa.SetValue(1,'bookname','射雕英雄传');
      aaa.SetValue(2,'bookauthor','金庸');
    except
      showmessage('SetValue Error!');
    end;
    try
      aaa.GetArray(SendData);
    except
      showmessage('GetArray Error!');
    end;
    test.GetArray(3,SendData,GettedData); //COM中为 GettedData := SendData;
    try
      bbb.SetArray(GettedData);
    except
      showmessage('SetArray Error!');
    end;
    msgString := '';
    j := bbb.GetArrayLength;
    for i := 0 to j - 1 do
    begin
      bbb.GetValue(i,fieldName,fieldValue);
      msgString := '';
      msgString := fieldName + ' ' + fieldValue;
      showmessage(msgString);
    end;
  finally
    aaa.Free;
    bbb.Free;
    test := nil;
  end;
end;各位老大帮忙看看是否有内存泄漏，小弟的Delphi基础不好

Answer 2

self.tempPointer := VarArrayLock(self.tempArray);
Move(self.arrayData,self.tempPointer^,sizeof(self.arrayData));
VarArrayUnLock(self.tempArray);哪位老大给讲一下上面的工作原理？用了VarArrayCreate后，还用释放吗？如何释放呢？

Answer 3

不用释放吧，置为NULL就行了。上面的代码根本不行，
SetArray（const inData: OleVariant);这函数不如写成:VarCopy(Src, Dst)
就行了。VarArrayLock和VarArrayUnLock是成对出现的，不能单独一个出现，不然会出现问题的。一般是这样进行操作：
var 
  I: Integer;
  S: string;
  P: Pointer;
  Len: Integer;
  D: OleVariant;
begin
  S := 'message';
  I := 10;
  Len := SizeOf(Integer) + Length(S);
  D := VarArrayCreate([0, Len], varByte);
  P := VarArrayLock(D);
  try
    Move(I, P^, SizeOf(Integer));
    Inc(Integer(P), SizeOf(Integer));
    Move(S[1], P^, Length(S));    
  finally
    VarArrayUnLock(D);
  end;         //好了，这里的D: OleVariant就包含了I, S这两个值了。  //读出来是这样
  I := 0;
  S := '';
  Len := VarArrayHighBound(D, 1);  //取出D中共有几个Byte数据
  P := VarArrayLock(D);  
  try
    Move(P^, I, SizeOf(Integer)); //将前面4个字节的数据给i
    Inc(Integer(P), SizeOf(Integer));
    SetLength(S, Len - SizeOf(Integer)); //其它的就是字符串。先分配字符串空间。
    Move(S[1], P^, Length(S));           //Move的操作就是需要有空间才能操作，否则...    ShowMessage(IntToStr(I));
    ShowMessage(S);
  finally
    VarArrayUnLock(D);
  end; 
end;一般来说，我是将Len := Length(S)先写入OleVariant，然后读的时候就将Len读出，再SetLength，再读出具体string.
另，你的类中的函数Free是多余的，它已经在TObject声明了，没必要写了。Destroy声明中后面加一个"override"关键字。destructor TVariantArray.Destroy;
begin
  //当SetLength 的Length为0时，就清空了数据了。
  setlength(self.arrayData,0);
  //这个后面两句就不用了。
  //Finalize(self.arrayData); //是否还需要这步
  //self.arrayData := nil;
  //
  //最好再加上
  inherited Destroy;
end;

Answer 4

谢谢木石兄，不过现在我第一次可以运行，第二次在创建实例时出现Access Violation at address ，是不是我释放的不彻底？
这个情况我以前出现过，于是我把Destroy后面的override去掉，自己写了Free，就解决了，可是现在又不行了。
TObject.Destroy里面没有代码，还用的着inherited Destroy吗？
你说代码不能用，指的是哪部分，例子程序里有一个调用COM的函数，只是交换数据而已。

Answer 5

procedure TVariantArray.SetArray(const inData: OleVariant);
begin
  VarCopy(tempArray, InData);
  {
  self.tempArray := inData;
  self.tempPointer := VarArrayLock(self.tempArray);
  Move(self.tempPointer^,self.arrayData,sizeof(self.arrayData));
  VarArrayUnLock(self.tempArray);}
end;GetArray也是改成VarCopy试试。我这里改成VarCopy之后就没错了。
它是在这里异常了。
测试代码不全，不好测。TObject.Destroy和Create虽然没有代码，不写Inherited虽然不会错，但这是风格，习惯，呵呵。

Answer 6

同意木石三兄弟讲的
Free确实没有用
这样反而不安全
我也觉得destroy的override应该要
最后直接加inherited
还有construct不要用OVERLOAD
直接写好了
再加一句inherited create;
这样可能安全些

Answer 7

不行啊木石兄，我的数据放在私有变量arrayData里，没有在你只用一句VarCopy(tempArray, InData);我的数据没传过去啊。是不报错了，可是没有数据。老鱼兄有什么高见继续说说啊。

Answer 8

少打了个字：没有在tempArray里。

Answer 9

干脆：
  TempArray := InData;  OutArray := TempArray;:D

Answer 10

最新进展，如果不调用Free函数，一切正常，除了内存涨些：）
以为释放内存错误，于是调用Free，把析构函数内全部注释，即调用一个空析构函数，还是第二次报错。
请熟悉VCL的老大们帮忙。为什么调用了析构函数，下一次调用构造函数会出错？

Answer 11

每次创建一个对象，在例子程序里不创建bbb，只用一个aaa，则问题解决，但是发现没运行5次，则内存涨4k，是不是还是没释放干净？
只用一句setlength(self.arrayData,0)，数据是没有了，可在delphi里看变量时，发现好多((),(),(),(),(),…………无穷无尽，是内存泄漏吗？
各位老大不要嫌分少啊，可以再加嘛。

Answer 12

问题解决，内存涨到一定程度就不涨啦。最终完成版如下：{ *********************************************************************** }
{                                                                         }
{                   CopyRight eastphoenix 2003-02-09                      }
{                         [email protected]                             }
{                                                                         }
{                       用于在COM中传递可变参数                           }
{           欢迎进行改进，请您通知我一声，大家一起提高，谢谢！            }
{ *********************************************************************** }
unit unitVariantArray;interface
uses Variants,Windows,dialogs,sysutils;type
  VariantInfo = record
    fieldName:string;           //字段名
    fieldValue:string;          //字段值
  end;
type
  VariantArrayType = array of VariantInfo;type
  TVariantArray = class//(TObject)
    private
      arrayLength:integer;        //数组长度，类构造时提供
      tempArray:Variant;
      tempPointer:Pointer;
      arrayData:VariantArrayType; //带结构的变长数组
    public
      //构造函数，输入构造数组的长度
      constructor Create(const newArrayLength:integer);
      //析构函数
      destructor Destroy;override;
      //设置数组的一条记录的值，num是数组的下标，FieldName是字段名，FieldValue是字段值
      procedure SetValue(const num:integer;FieldName:string;FieldValue:string);
      //取数组的一条记录的值，num是数组的下标，FieldName是字段名，FieldValue是字段值
      procedure GetValue(const num:integer;out FieldName:string;out FieldValue:string);
      //取数组长度
      function GetArrayLength:integer;
      //为数组整体赋值，inData由COM传递过来
      procedure SetArray(const inData:OleVariant);
      //从数组中取值，返回值为一个需要传给COM的变量
      function GetArray:OleVariant;
    end;implementation{ TVariantArray }constructor TVariantArray.Create(const newArrayLength: integer);
begin
  inherited create;
  self.arrayLength := newArrayLength;
  setlength(self.arrayData,newArrayLength);
  self.tempArray := VarArrayCreate([0,sizeof(arrayData)],varByte);
end;destructor TVariantArray.Destroy;
begin
  setlength(self.arrayData,0);
  self.arrayLength := 0;
  self.tempPointer := nil;
  self.tempArray := null;
  inherited Destroy;
end;
function TVariantArray.GetArray: OleVariant;
begin
  self.tempPointer := VarArrayLock(self.tempArray);
  Move(self.arrayData,self.tempPointer^,sizeof(self.arrayData));
  VarArrayUnLock(self.tempArray);
  result := self.tempArray;
end;function TVariantArray.GetArrayLength: integer;
begin
  result := self.arrayLength;
end;procedure TVariantArray.GetValue(const num: integer;
  out FieldName: string; out FieldValue: string);
begin
  FieldName := self.arrayData[num].fieldName;
  FieldValue := self.arrayData[num].fieldValue;
end;procedure TVariantArray.SetArray(const inData: OleVariant);
begin
  self.tempArray := inData;
  self.tempPointer := VarArrayLock(self.tempArray);
  Move(self.tempPointer^,self.arrayData,sizeof(self.arrayData));
  VarArrayUnLock(self.tempArray);
end;procedure TVariantArray.SetValue(const num: integer; FieldName,
  FieldValue: string);
begin
  try
    self.arrayData[num].fieldName := FieldName;
    self.arrayData[num].fieldValue := FieldValue;
  except
    raise;
  end;
end;end.超过回复次数，只好牵马甲来了，有马甲真好：）

Answer 13

我也写一个，你试试。
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;var
  Form1: TForm1;implementation{$R *.dfm}type
  PData = ^TData;
  TData = record
    Field: string;
    Value: string;
  end;
  PDataArr = ^TDataArr;
  TDataArr = array of TData;  TVariantArray = class
  private
    FLength: Integer;
    FData: Variant;
    function GetItem(const Index: Integer): TData;
    function GetLength: Integer;
    procedure SetData(const Value: Variant);
    procedure SetItem(const Index: Integer; const Value: TData);
    procedure SetLength(const Value: Integer);
  public
    constructor Create(ALength: Integer);
    destructor Destroy; override;
    property Data: Variant read FData write SetData;
    property Length: Integer read GetLength write SetLength;
    property Item[const Index: Integer]: TData read GetItem write SetItem;
  end;{ TVariantArray }constructor TVariantArray.Create(ALength: Integer);
begin
  inherited Create;
  Length := ALength;
end;destructor TVariantArray.Destroy;
begin
  FData := NULL;
  inherited Destroy;
end;function TVariantArray.GetItem(const Index: Integer): TData;
begin
  if not (Index in [0..(Length - 1)]) then
    raise Exception.Create('invalid index');
  Result.Field := FData[2 * Index];
  Result.Value := FData[2 * Index + 1];
end;function TVariantArray.GetLength: Integer;
begin
  Result := VarArrayHighBound(FData, 1) div 2;
  if FLength <> Result then
    FLength := Result;
end;procedure TVariantArray.SetData(const Value: Variant);
begin
  if not VarIsArray(Value) then
  begin
    FData := NULL;
    FLength := 0;
  end else
  begin
    FData := Value;
    FLength := VarArrayHighBound(FData, 1) div 2;
  end;
end;procedure TVariantArray.SetItem(const Index: Integer; const Value: TData);
begin
  if not (Index in [0..(Length - 1)]) then
    raise Exception.Create('invalid index');
  FData[2 * Index] := Value.Field;
  FData[2 * Index + 1] := Value.Value;
end;procedure TVariantArray.SetLength(const Value: Integer);
var
  Old: OleVariant;
  I, Len, OldLen: Integer;
begin
  if Value = FLength then Exit;
  Old := FData;
  OldLen := FLength;
  if Value = 0 then
  begin
    FData := NULL;
    FLength := 0;
  end else
  begin
    FLength := Value;
    FData := VarArrayCreate([0, 2 * FLength], varVariant);
    for I := 0 to 2 * FLength - 1 do
      FData[I] := '';
    Len := OldLen;
    if FLength < OldLen then
      Len := FLength;
    for I := 0 to Len - 1 do
    begin
      FData[2 * I] := Old[2 * I];
      FData[2 * I + 1] := Old[2 * I + 1];
    end;
  end;
end;function Data(Field, Value: string): TData;
begin
  Result.Field := Field;
  Result.Value := Value;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  Value1, Value2: TVariantArray;
begin
  Value1 := TVariantArray.Create(3);
  Value1.Item[0] := Data('bookid','0');
  Value1.Item[1] := Data('bookname','射雕英雄传');
  Value1.Item[2] := Data('bookauthor','金庸');  Value2 := TVariantArray.Create(0);
  Value2.Data := Value1.Data;
  ShowMessage(IntToStr(Value2.Length));
  ShowMessage(Value2.Item[1].Value);
  Value2.Free;
  Value1.Free;
end;end.