为什么一旦引用了Adodb,就会造成内存泄漏? ( 积分: 50 )

  • 主题发起人 GrassDragon
  • 开始时间
G

GrassDragon

Unregistered / Unconfirmed
GUEST, unregistred user!
我使用了盒子中的一个"内存泄漏检测"代码。我发现,只要我一旦uses了Adodb单元或DB单元,即便不做任何操作,"内存泄漏检测"程序都会报告有内存漏洞。
这是怎么回事,是"内存泄漏检测"程序有问题,还是Adodb单元或DB本身有漏洞,或者是其它什么原因?如果是真有漏洞,该如何处理。
示例如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Adodb,db
{只要引用了Adodb,db,就会有内存漏洞}
type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
end.

//内存检测单元
unit CheckMem
//Add it to the first line of project uses

interface

procedure SnapCurrMemStatToFile(Filename: string);

implementation

uses
Windows, SysUtils, TypInfo;

const
MaxCount = High(Word);

var
OldMemMgr: TMemoryManager;
ObjList: array[0..MaxCount] of Pointer;
FreeInList: Integer = 0;
GetMemCount: Integer = 0;
FreeMemCount: Integer = 0;
ReallocMemCount: Integer = 0;

procedure AddToList(P: Pointer);
begin
if FreeInList > High(ObjList) then
begin
MessageBox(0, '内存管理监视器指针列表溢出,请增大列表项数!', '内存管理监视器', mb_ok);
Exit;
end;
ObjList[FreeInList] := P;
Inc(FreeInList);
end;

procedure RemoveFromList(P: Pointer);
var
I: Integer;
begin
for I := 0 to FreeInList - 1 do
if ObjList = P then
begin
Dec(FreeInList);
Move(ObjList[I + 1], ObjList, (FreeInList - I) * SizeOf(Pointer));
Exit;
end;
end;

procedure SnapCurrMemStatToFile(Filename: string);
const
FIELD_WIDTH = 20;
var
OutFile: TextFile;
I, CurrFree, BlockSize: Integer;
HeapStatus: THeapStatus;
Item: TObject;
ptd: PTypeData;
ppi: PPropInfo;

procedure Output(Text: string
Value: integer);
begin
Writeln(OutFile, Text: FIELD_WIDTH, Value div 1024, ' KB(', Value, ' Byte)');
end;

begin
AssignFile(OutFile, Filename);
try
if FileExists(Filename) then
begin
Append(OutFile);
Writeln(OutFile);
end
else
Rewrite(OutFile);
CurrFree := FreeInList;
HeapStatus := GetHeapStatus
{ 局部堆状态 }
with HeapStatus do
begin
Writeln(OutFile, '===== ', ExtractFileName(ParamStr(0)), ',', DateTimeToStr(Now), ' =====');
Writeln(OutFile);
Output('可用地址空间 : ', TotalAddrSpace);
Output('未提交部分 : ', TotalUncommitted);
Output('已提交部分 : ', TotalCommitted);
Output('空闲部分 : ', TotalFree);
Output('已分配部分 : ', TotalAllocated);
Output('全部小空闲内存块 : ', FreeSmall);
Output('全部大空闲内存块 : ', FreeBig);
Output('其它未用内存块 : ', Unused);
Output('内存管理器消耗 : ', Overhead);
Writeln(OutFile, '地址空间载入 : ': FIELD_WIDTH, TotalAllocated div (TotalAddrSpace div 100), '%');
end;
Writeln(OutFile);
Writeln(OutFile, Format('当前出现 %d 处内存漏洞 :', [GetMemCount - FreeMemCount]));
for I := 0 to CurrFree - 1 do
begin
Write(OutFile, I: 4, ') ', IntToHex(Cardinal(ObjList), 16), ' - ');
BlockSize := PDWORD(DWORD(ObjList) - 4)^;
Write(OutFile, BlockSize: 4, '($' + IntToHex(BlockSize, 4) + ')字节', ' - ');
try
Item := TObject(ObjList);
if PTypeInfo(Item.ClassInfo).Kind <> tkClass then { type info technique }
write(OutFile, '不是对象')
else
begin
ptd := GetTypeData(PTypeInfo(Item.ClassInfo));
ppi := GetPropInfo(PTypeInfo(Item.ClassInfo), 'Name')
{ 如果是TComponent }
if ppi <> nil then
begin
write(OutFile, GetStrProp(Item, ppi));
write(OutFile, ' : ');
end
else
write(OutFile, '(未命名): ');
Write(OutFile, Item.ClassName, ' (', ptd.ClassType.InstanceSize,
' 字节) - In ', ptd.UnitName, '.pas');
end
except
on Exception do
write(OutFile, '不是对象');
end;
writeln(OutFile);
end;
finally
CloseFile(OutFile);
end;
end;

function NewGetMem(Size: Integer): Pointer;
begin
Inc(GetMemCount);
Result := OldMemMgr.GetMem(Size);
AddToList(Result);
end;

function NewFreeMem(P: Pointer): Integer;
begin
Inc(FreeMemCount);
Result := OldMemMgr.FreeMem(P);
RemoveFromList(P);
end;

function NewReallocMem(P: Pointer
Size: Integer): Pointer;
begin
Inc(ReallocMemCount);
Result := OldMemMgr.ReallocMem(P, Size);
RemoveFromList(P);
AddToList(Result);
end;

const
NewMemMgr: TMemoryManager = (
GetMem: NewGetMem;
FreeMem: NewFreeMem;
ReallocMem: NewReallocMem);

initialization
GetMemoryManager(OldMemMgr);
SetMemoryManager(NewMemMgr);

finalization
SetMemoryManager(OldMemMgr);
if (GetMemCount - FreeMemCount) <> 0 then
SnapCurrMemStatToFile(ExtractFileDir(ParamStr(0)) + '/CheckMemory.Log');
end.
 
没遇到过,我用 FastMM4
 
好像是ADO控件自身的问题,没关系,问题不大
 
我用DLL内置ADO,也出现以上提示。关注
 
ADO 就是连接 Access 内核的,你的程序虽然退出,但 Access 内核部分还在运行,
为下一次使用提供加速等方便,换言之资源还在使用,直到关机才正式撤出。
 
我听说有这方面的补丁的,好象就是解决你的说的这种情况的
 
cc_cn:
你有这方面的补丁吗?
 
多人接受答案了。
 
顶部