求助:为何每次创建的对象地址都一样?在线等,问题解决马上结贴,谢谢! ( 积分: 17 )

  • 主题发起人 主题发起人 bbdz_1
  • 开始时间 开始时间
B

bbdz_1

Unregistered / Unconfirmed
GUEST, unregistred user!
在窗口中某按钮事件调用该函数,用来创建新的结点,TLink是一个结点类,tail是链表表尾指针。我用单步执行调程序,发现不管添加多少次结点,每次在这个函数中创建的对象的地址都是相同的(即:@tmp值都是一样的),这样的话根本就不能实现链表...请问程序问题出在哪里,应该如何修改,谢谢!
function TLList.Append(const elem: integer): boolean;
var
tmp: TLink;
begin
tmp := TLink.Create(elem);
tail^.next := @tmp;
tail := @tmp;
rightlen := rightlen+1;
result := true;
end;
其中TLink定义如下:
PLink = ^TLink;
TLink = class
private
val: integer;
next: PLink;
public
{method}
end;
难道Delphi中链表只能用record实现吗,应该不是的,请大家指教!
 
在窗口中某按钮事件调用该函数,用来创建新的结点,TLink是一个结点类,tail是链表表尾指针。我用单步执行调程序,发现不管添加多少次结点,每次在这个函数中创建的对象的地址都是相同的(即:@tmp值都是一样的),这样的话根本就不能实现链表...请问程序问题出在哪里,应该如何修改,谢谢!
function TLList.Append(const elem: integer): boolean;
var
tmp: TLink;
begin
tmp := TLink.Create(elem);
tail^.next := @tmp;
tail := @tmp;
rightlen := rightlen+1;
result := true;
end;
其中TLink定义如下:
PLink = ^TLink;
TLink = class
private
val: integer;
next: PLink;
public
{method}
end;
难道Delphi中链表只能用record实现吗,应该不是的,请大家指教!
 
请大家指教
 
你还不明白类就是指针的道理。用类实现链表的话更简单,应该是
TLink = class
private
val: integer;
next: TLink;
public
{method}
end;

function TLList.Append(const elem: integer): boolean;
var
tmp: TLink;
begin
tmp := TLink.Create(elem);
tail.next := tmp;
tail := tmp;
rightlen := rightlen+1;
result := true;
end;
 
也可以考虑用TList
 
做链表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;
 
试试,回来结贴~~
 
谢谢各位!
 
后退
顶部