做链表TList完全可以了。
给你个管理类或其他较复杂对象的链表基类,其实直接用TList做基类也是可以的。
unit BaseListUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs
//大部分没用可以去掉
type
TBaseList = class
private
FList: TList;
function GetCount: Cardinal
function GetItem(index: integer): Pointer
virtual;
protected
function DoAllocMem(Item: Pointer): Pointer
virtual
abstract;
procedure DoFreeMem(index: integer)
virtual
abstract;
public
constructor Create;
destructor Destroy
override;
function Add(Item: Pointer): Pointer;
function Insert(Index: Integer
Item: Pointer): Pointer;
procedure delete(index: integer);
procedure Sort(Compare: TListSortCompare);
procedure Clear;
procedure Assign(ListA: TBaseList);
property Count: Cardinal read GetCount
property Items[index: integer]: Pointer read GetItem
default;
end;
implementation
constructor TBaseList.Create;
begin
inherited;
FList := TList.Create;
end;
destructor TBaseList.Destroy;
begin
Clear;
FList.Free;
inherited;
end;
function TBaseList.Add(Item: Pointer): Pointer;
begin
result := Insert(Count, Item);
end;
procedure TBaseList.delete(index: integer);
begin
DoFreeMem(index);
FList.Delete(index);
end;
function TBaseList.Insert(Index: Integer
Item: Pointer): Pointer;
var
Ptr: Pointer;
begin
Ptr := DoAllocMem(Item);
FList.Insert(Index, Ptr);
result := Ptr;
end;
procedure TBaseList.Clear;
var
i: integer;
begin
if Count = 0 then exit;
for i := Count - 1 downto 0 do
Delete(i);
end;
procedure TBaseList.Sort(Compare: TListSortCompare);
begin
FList.Sort(Compare);
end;
function TBaseList.GetCount: Cardinal;
begin
result := FList.Count;
end;
function TBaseList.GetItem(index: integer): Pointer;
begin
if (index > Count - 1) or (Count = 0) or (index < 0) then
Raise Exception.Create('index out of range!');
result := FList[index];
end;
procedure TBaseList.Assign(ListA: TBaseList);
var
i: integer;
begin
for i := 0 to ListA.Count - 1 do
begin
Add(ListA);
end;
end;
end.
应用示例:
//管理复杂Record
uses BaseListUnit;
type
PExport = ^TExport;
TExport = record
Orindal: WORD;
Name: PChar;
FuncRVA: DWORD;
ForwardFunc: PChar;
end;
type
TExportList = class(TBaseList)
private
protected
function DoAllocMem(Item: Pointer): Pointer
override;
procedure DoFreeMem(index: integer)
override;
public
end;
.....
function TExportList.DoAllocMem(Item: Pointer): Pointer;
var //复制一份Item,返指针
tmpExp: PExport;
l : integer;
begin
tmpExp := AllocMem(SizeOf(TExport));
tmpExp^.FuncRVA := PExport(Item)^.FuncRVA;
tmpExp^.Orindal := PExport(Item)^.Orindal;
if PExport(Item)^.Name <> nil then
begin
l := length(PExport(Item)^.Name) + 1;
tmpExp^.Name := AllocMem(l);
CopyMemory(tmpExp^.Name, PExport(Item)^.Name, l);
end
else
begin
tmpExp^.Name := nil;
end;
if PExport(Item)^.ForwardFunc <> nil then
begin
l := length(PExport(Item)^.ForwardFunc) + 1;
tmpExp^.ForwardFunc := AllocMem(l);
CopyMemory(tmpExp^.ForwardFunc, PExport(Item)^.ForwardFunc, l);
end
else
tmpExp^.ForwardFunc := nil;
result := tmpExp;
end;
procedure TExportList.DoFreeMem(index: integer);
var
tmpExp: PExport;
begin
tmpExp := Items[index];
if tmpExp^.Name <> nil then
FreeMem(tmpExp^.Name);
if tmpExp^.ForwardFunc <> nil then
FreeMem(tmpExp^.ForwardFunc);
FreeMem(tmpExp);
end;
//管理类
type
TImportList = class(TBaseList)
private
protected
function DoAllocMem(Item: Pointer): Pointer
override;
procedure DoFreeMem(index: integer)
override;
public
end;
...
function TImportList.DoAllocMem(Item: Pointer): Pointer;
var
tmpImpMod: TImportModule;
begin
tmpImpMod := TImportModule.Create;
tmpImpMod.ImportDescriptor := Item;
result := tmpImpMod;
end;
procedure TImportList.DoFreeMem(index: integer)
var
tmpImpMod: TImportModule;
begin
tmpImpMod := Items[index];
tmpImpMod.Free;
end;