Another_eYes:谢谢,你的方法不把过程放在DLL中也可以,但是放在DLL中,也不行。
小弟做了一个小测试程序,把代码贴出来,大家看看,一起讨论一下。
开发环境:Win2000 Pro + D7, no serivce pack。
========================================================
Dll代码
========================================================
library dllarray;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,Classes,windows;
type
PDataItem = ^TDataItem;
TDataItem = record
DataID : integer;
DataType : string[2]
//IN - Integer , ST- String, AR - array;
DataValue : Pointer;
end;
PDataArray = ^TDataArray;
TDataArray = array of TDataItem;
PSQDataItem = ^TSQDataItem;
TSQDataItem = record
ItemTag : integer;
ItemLength : integer;
ItemValue : Pointer;
end;
PSQDataArray = ^TSQDataArray;
TSQDataArray = array of TSQDataItem;
procedure TempProc(DataArray: Pointer
var Len: integer);
var
tempAry: PDataArray;
tempLen: integer;
I, J: integer;
tempStr: string;
tempInt: integer;
//SQDataArray : TSQDataArray;
begin
tempAry := DataArray
// 区别处
tempLen := 9;
SetLength(tempAry^, tempLen);
J := 1;
for I := 0 to tempLen - 1 do
begin
tempAry^.DataID := I;
case J of
1 : //Integer Value
begin
tempAry^.DataType := 'IN';
tempInt := 1000 + I;
GetMem(tempAry^.DataValue, SizeOf(Integer));
Integer(tempAry^.DataValue^) := tempInt;
end;
2 : //String Value
begin
tempAry^.DataType := 'ST';
tempStr := 'String Value' + IntToStr(I + 1);
GetMem(tempAry^.DataValue, Length(tempStr));
StrPCopy(tempAry^.DataValue, tempStr);
end;
3 : //array value
begin
tempAry^.DataType := 'AR';
tempAry^.DataValue := nil;
SetLength(TSQDataArray(tempAry^.DataValue), 2);
TSQDataArray(tempAry^.DataValue)[0].ItemTag := 0;
TSQDataArray(tempAry^.DataValue)[0].ItemLength := 10;
TSQDataArray(tempAry^.DataValue)[1].ItemTag := 1;
TSQDataArray(tempAry^.DataValue)[1].ItemLength := 20;
{
tempAry^.DataType := 'AR';
SetLength(SQDataArray, 2);
SQDataArray[0].ItemTag := 0;
SQDataArray[0].ItemLength := 10;
SQDataArray[1].ItemTag := 1;
SQDataArray[1].ItemLength := 20;
GetMem(tempAry^.DataValue, SizeOf(TSQDataItem) * Length(SQDataArray));
ZeroMemory(tempAry^.DataValue, SizeOf(TSQDataItem) * Length(SQDataArray));
TSQDataArray(tempAry^.DataValue^) := Copy(SQDataArray, 0, Length(SQDataArray));
}
end;
end;//case...
Inc(J);
if J > 3 then J := 1;
end;
Len := tempLen;
end;
exports
TempProc;
end.
==========================================================
//调用程序代码
=========================================================
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
PDataItem = ^TDataItem;
TDataItem = record
DataID : integer;
DataType : string[2]
//IN - Integer , ST- String, AR - array;
DataValue: Pointer;
end;
PDataArray = ^TDataArray;
TDataArray = array of TDataItem;
PSQDataItem = ^TSQDataItem;
TSQDataItem = record
ItemTag : integer;
ItemLength : integer;
ItemValue : Pointer;
end;
PSQDataArray = ^TSQDataArray;
TSQDataArray = array of TSQDataItem;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
procedure TempProcDll(DataArray: Pointer
var Len: integer);
implementation
{$R *.dfm}
procedure TempProcDll
external 'dllarray.dll' name 'TempProc'
// 无类型指针,可用于 DLL (我猜的)
// 参数 DataArray 前的 var 不是必须
procedure TempProc(DataArray: Pointer
var Len: integer);
var
tempAry: PDataArray;
tempLen: integer;
I, J: integer;
tempStr: string;
tempInt: integer;
//SQDataArray : TSQDataArray;
begin
tempAry := DataArray
// 区别处
tempLen := 9;
SetLength(tempAry^, tempLen);
J := 1;
for I := 0 to tempLen - 1 do
begin
tempAry^.DataID := I;
case J of
1 : //Integer Value
begin
tempAry^.DataType := 'IN';
tempInt := 1000 + I;
GetMem(tempAry^.DataValue, SizeOf(Integer));
Integer(tempAry^.DataValue^) := tempInt;
end;
2 : //String Value
begin
tempAry^.DataType := 'ST';
tempStr := 'String Value' + IntToStr(I + 1);
GetMem(tempAry^.DataValue, Length(tempStr));
StrPCopy(tempAry^.DataValue, tempStr);
end;
3 : //array value
begin
tempAry^.DataType := 'AR';
tempAry^.DataValue := nil;
SetLength(TSQDataArray(tempAry^.DataValue), 2);
TSQDataArray(tempAry^.DataValue)[0].ItemTag := 0;
TSQDataArray(tempAry^.DataValue)[0].ItemLength := 10;
TSQDataArray(tempAry^.DataValue)[1].ItemTag := 1;
TSQDataArray(tempAry^.DataValue)[1].ItemLength := 20;
{SetLength(SQDataArray, 2);
SQDataArray[0].ItemTag := 0;
SQDataArray[0].ItemLength := 10;
SQDataArray[1].ItemTag := 1;
SQDataArray[1].ItemLength := 20;
GetMem(tempAry^.DataValue, SizeOf(TSQDataItem) * Length(SQDataArray));
ZeroMemory(tempAry^.DataValue, SizeOf(TSQDataItem) * Length(SQDataArray));
TSQDataArray(tempAry^.DataValue^) := Copy(SQDataArray);}
end;
end;//case...
Inc(J);
if J > 3 then J := 1;
end;
Len := tempLen;
end;
// 标准的 Delphi 动态数组,带引用计数
// 参数 DataArray 前的 var 必须
procedure TempProc1(var DataArray: TDataArray
var Len: integer);
var
tempAry: TDataArray;
tempLen: integer;
I, J : integer;
tempStr: string;
tempInt: integer;
SQDataArray : TSQDataArray;
begin
tempLen := 9;
SetLength(tempAry, tempLen);
J := 1;
for I := 0 to tempLen - 1 do
begin
tempAry.DataID := I;
case J of
1 : //Integer Value
begin
tempAry.DataType := 'IN';
tempInt := 1000 + I;
GetMem(tempAry.DataValue, SizeOf(Integer));
Integer(tempAry.DataValue^) := tempInt;
end;
2 : //String Value
begin
tempAry.DataType := 'ST';
tempStr := 'String Value' + IntToStr(I + 1);
GetMem(tempAry.DataValue, Length(tempStr));
StrPCopy(tempAry.DataValue, tempStr);
end;
3 : //array value
begin
tempAry.DataType := 'AR';
SetLength(SQDataArray, 2);
SQDataArray[0].ItemTag := 0;
SQDataArray[0].ItemLength := 10;
SQDataArray[1].ItemTag := 1;
SQDataArray[1].ItemLength := 20;
GetMem(tempAry.DataValue, SizeOf(SQDataArray));
TSQDataArray(tempAry.DataValue^) := Copy(SQDataArray);
end;
end;//case...
Inc(J)
if J > 3 then J := 1;
end;
DataArray := tempAry
//区别处
Len := tempLen;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
tempAry : TDataArray;
ArrayLen: integer;
I, J : integer;
P : Pointer;
strMsg : string;
SQDataArray : TSQDataArray;
begin
ArrayLen := 0;
SetLength(tempAry, 0);
P := Pointer(@tempAry);
//本单元过程
//TempProc(P, ArrayLen);
//调用Dll过程
try
TempProcDll(P, ArrayLen);
except
ShowMessage('Dll error!');
Exit;
end;
strMsg := 'Pointer parameter, array length: ' + IntToStr(Length(tempAry)) + #13 + #10;
for I := Low(tempAry) to High(tempAry) do
begin
strMsg := strMsg + #13 + #10;
if tempAry.DataType = 'IN' then
begin
strMsg := strMsg +'The ' + IntToStr(I + 1) + ' element, Integer Data, Value:' + IntToStr(Integer(tempAry.DataValue^));
end;
if tempAry.DataType = 'ST' then
begin
strMsg := strMsg +'The ' + IntToStr(I + 1) + ' element, string Data, Value:' + PChar(tempAry.DataValue);
end;
SetLength(SQDataArray, 0);
if tempAry.DataType = 'AR' then
begin
//ShowMessage(IntToStr(Length(TSQDataArray(tempAry.DataValue))));
//SQDataArray := tempAry.DataValue;
SQDataArray := TSQDataArray(tempAry.DataValue);
//ShowMessage(IntToStr(Length(SQDataArray)));
strMsg := strMsg + 'The ' + IntToStr(I + 1) + ' element, array Data, Value:' + #13 + #10;
for J := Low(SQDataArray) to High(SQDataArray) do
begin
strMsg := strMsg + 'Array element ' + IntToStr(J + 1) + ', ItemTag:' + IntToStr(SQDataArray[J].ItemTag) + ', ItemLength:' + IntToStr(SQDataArray[J].ItemLength) + #13 + #10;
if SQDataArray[J].ItemValue <> nil then
FreeMem(SQDataArray[J].ItemValue);
end;
end;
// 释放 tempAry.DataValue
if tempAry.DataType = 'AR' then
SetLength(SQDataArray, 0)
else
FreeMem(tempAry.DataValue);
end;
ShowMessage(strMsg);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
tempAry : TDataArray;
ArrayLen: integer;
I, J : integer;
strMsg : string;
SQDataArray : PSQDataArray;
begin
ArrayLen := 0;
SetLength(tempAry, 0);
TempProc1(tempAry, ArrayLen)
// TDataArray
strMsg := 'Pointer parameter, array length: ' + IntToStr(Length(tempAry));
for I := Low(tempAry) to High(tempAry) do
begin
strMsg := strMsg + #13 + #10;
if tempAry.DataType = 'IN' then
strMsg := strMsg + 'The ' + IntToStr(I + 1) + ' element, Integer Data, Value:' + IntToStr(Integer(tempAry.DataValue^));
if tempAry.DataType = 'ST' then
strMsg := strMsg + 'The ' + IntToStr(I + 1) + ' element, string Data, Value:' + PChar(tempAry.DataValue);
if tempAry.DataType = 'AR' then
begin
SQDataArray := tempAry.DataValue;
strMsg := strMsg + 'The ' + IntToStr(I + 1) + ' element, array Data, Value:' + #13 + #10;
for J := Low(SQDataArray^) to High(SQDataArray^) do
begin
strMsg := strMsg + 'Array element ' + IntToStr(J + 1) + ', ItemTag:' + IntToStr(SQDataArray^[J].ItemTag) + ', ItemLength:' + IntToStr(SQDataArray^[J].ItemLength) + #13 + #10;
if SQDataArray^[J].ItemValue <> nil then
FreeMem(SQDataArray^[J].ItemValue);
end;
end;
// 释放 tempAry
FreeMem(tempAry.DataValue);
end;
ShowMessage(strMsg);
end;
end.
====================================================================
说明:
1、上面的代码,在传过程参数array时都是用的一个pointer,并传入一个数组长度(我这个Demo中并未用到数组长度)。
2、照朋友的建议,我的Record中的DataValue字段是用的Pointer。另一个可以嵌套的array的元素数据类型,也是一个record,其字段ItemValue也是用的Pointer。
3、在那个过程中,把DataValue字段生成一个Array也用了两种方式,一种是如上楼所说的类型强制转换,一种是GetMem方式。
4、在调入过程的时候,处理DataValue为数组值时也用了两种方式,一种是TSQDataArray,一种是PSQDataArray。PSQDataArray的处理方式如下:
===================
procedure TForm1.Button1Click(Sender: TObject);
var
tempAry : TDataArray;
ArrayLen: integer;
I, J : integer;
P : Pointer;
strMsg : string;
SQDataArray : PSQDataArray;
begin
ArrayLen := 0;
SetLength(tempAry, 0);
P := Pointer(@tempAry);
//本单元过程
//TempProc(P, ArrayLen);
//调用Dll过程
try
TempProcDll(P, ArrayLen);
except
ShowMessage('Dll error!');
Exit;
end;
strMsg := 'Pointer parameter, array length: ' + IntToStr(Length(tempAry)) + #13 + #10;
for I := Low(tempAry) to High(tempAry) do
begin
strMsg := strMsg + #13 + #10;
if tempAry.DataType = 'IN' then
begin
strMsg := strMsg +'The ' + IntToStr(I + 1) + ' element, Integer Data, Value:' + IntToStr(Integer(tempAry.DataValue^));
end;
if tempAry.DataType = 'ST' then
begin
strMsg := strMsg +'The ' + IntToStr(I + 1) + ' element, string Data, Value:' + PChar(tempAry.DataValue);
end;
//SetLength(SQDataArray, 0);
if tempAry.DataType = 'AR' then
begin
SQDataArray := tempAry.DataValue;
//SQDataArray := TSQDataArray(tempAry.DataValue);
//ShowMessage(IntToStr(Length(SQDataArray)));
strMsg := strMsg + 'The ' + IntToStr(I + 1) + ' element, array Data, Value:' + #13 + #10;
for J := Low(SQDataArray^) to High(SQDataArray^) do
begin
strMsg := strMsg + 'Array element ' + IntToStr(J + 1) + ', ItemTag:' + IntToStr(SQDataArray^[J].ItemTag) + ', ItemLength:' + IntToStr(SQDataArray^[J].ItemLength) + #13 + #10;
if SQDataArray^[J].ItemValue <> nil then
FreeMem(SQDataArray^[J].ItemValue);
end;
end;
// 释放 tempAry.DataValue
//if tempAry.DataType = 'AR' then
// SetLength(SQDataArray, 0)
//else
FreeMem(tempAry.DataValue);
end;
ShowMessage(strMsg);
end;
===============
可以看出,上面的代码用了两种方式:本单元中的Procdure和DLL中的Procedure。两个Procedure中的代码一样的。
我的问题:调用本单元中的Porcedure不会出错,调用DLL中的在第二次或是以上就要出错,出错信息是指针错误;
只要第一个数组的数组元素的DataValue不是'AR'(即Array),就没有问题;所以,请大家主要想一想在Record的DataValue字段中,套一个动态数组时的情况(在DLL中)。
谢谢。