登录 用户中心() [退出] 后台管理 注册
   
您的位置： 首页 >> 程序员学前班[不再更新，只读] >> 主题: [DGL/stl/delphi] DGL 的严重 bug 还是 delphi 的严重 bug ?     [回主站]     [分站链接]
标题
[DGL/stl/delphi] DGL 的严重 bug 还是 delphi 的严重 bug ?
clq
浏览(0) + 2009-12-04 11:45:19 发表 编辑

关键字:

[DGL/stl/delphi] DGL 的严重 bug 还是 delphi 的严重 bug ?

DGL 中这样的代码，对 tstringlist 是没有正确释放和，不能手工 free 也没有自动 free . 有严重的内存泄漏。

map:DHashMap;

list:tstringlist;

map.AddPair([path, list]);

换用一个 Pointer 类型中间变量才行。怪异的是只能用 Pointer 作指针，如果定义一个 tstringlist 的指针，如

type
PStringList = ^TStringList;

是不行的！！！

而且我在 delphi 7 中调试时发现两次 TStringList.Create 产生的指针值所居然是一样的！！但取出的值又不一样！不知 delphi 内部是如何实现的。感觉 Pointer 才是 delphi 的指针，而原来意义上的指针是对类的操作完全无效，要用到类的指针时必须用 Pointer ？？？
clq
2009-12-4 11:45:32 发表 编辑

unit uxml_decode;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
uDGL,
Dialogs, xmldom, XMLIntf, msxmldom, XMLDoc, StdCtrls;

type
PStringList = ^TStringList;

type
TXml_decode = class(TObject)
private
XMLDocument1: TXMLDocument;
m1:DHashMap;

StringList_arr:tlist;//生成的 TStringList


public
procedure DecodeXml_sub(map: DHashMap; path: string; node: IXMLNode);
procedure putOne(path: String; map: DHashMap; node: IXMLNode);
procedure DecodeXml(const data:string);
function getOneList(path:string):tstringlist;
function getOneString(path: string): string;

constructor Create;
destructor Destroy;override;//virtual;
end;

implementation



//代替 map.put((node_name).toLowerCase(), node.getTextContent());//取得一个值放入 hashmap 中
procedure TXml_decode.putOne(path:String ; map:DHashMap; node : IXMLNode);
var
list:tstringlist;
value:string;
obj:TObject;
iter:DIterator;
pl:PStringList;
p:Pointer;
begin
//paths += path + "\r\n";

path := LowerCase(path);

list := nil;
value := node.NodeValue;//取得节点的值

//取得以前保存的值列表,如果有的话
//GetObject(map.Find([path]));
iter := map.Find([path]);

//if iter.iAtEnd(iter) then
//obj := GetObject(map.Find([path]));
//if (obj = nil) then

if diMarkFinish in iter.flags then
begin//没找到
list := tstringlist.Create;
//list := tstringlist.Create;
pl := @list;
p := list;
StringList_arr.Add(list);//用于释放
//StringList_arr.Add(pl);
//showmessage(TStringList(StringList_arr.Items[0]).text);//用于释放

end
else
begin
//obj := GetObject(iter);
//list := tstringlist(obj);

//pl := GetPointer(iter);
//list := pl^;
p := GetPointer(iter);
list := p;
end;

//在列表中加入当前项目
list.add(value);
//map.put(path, list);
// map.AddPair([path, list]);
// map.AddPair([path, pl]);
map.AddPair([path, p]);

end;


procedure TXml_decode.DecodeXml_sub(map:DHashMap; path:string; node:IXMLNode);
var
i:integer;
childnode : IXMLNode;
begin
//

for i:=0 to node.ChildNodes.Count-1 do
begin
childnode := node.ChildNodes.Nodes[i];

//showmessage(childnode.NodeName);

if childnode.IsTextElement then
begin
//showmessage(path + '/' + childnode.NodeName + ':' + childnode.NodeValue);
putOne(path + '/' + childnode.NodeName, map, childnode);
end;

DecodeXml_sub(map, path + '/' + childnode.NodeName, childnode);
end;



end;


function TXml_decode.getOneList(path:string):tstringlist;
//不能用这个 procedure TXml_decode.getOneList(path:string; out1:tstringlist);
var
r:tstringlist;
begin

//r := tstringlist(GetObject(m1.Find(['BODY/Msisdn'])));
//out1 := tstringlist(GetObject(m1.Find(['body/msisdn'])));
//out1 := tstringlist(GetObject(m1.Find([path])));
r := tstringlist(GetPointer(m1.Find([path])));

//r := tstringlist(GetObject(m1.Find(['body/msisdn'])));

//showmessage(r.Text);

result := r;
end;


function TXml_decode.getOneString(path:string):string;
//不能用这个 procedure TXml_decode.getOneList(path:string; out1:tstringlist);
var
r:tstringlist;
begin

//r := tstringlist(GetObject(m1.Find(['BODY/Msisdn'])));
//r := tstringlist(GetObject(m1.Find(['body/msisdn'])));
//r := tstringlist(GetObject(m1.Find([path])));
r := tstringlist(GetPointer(m1.Find([path])));

//r := tstringlist(GetObject(m1.Find(['body/msisdn'])));

//showmessage(r.Text);

if r.Count>0
then result := r.Strings[0]
else result := '';
end;

procedure TXml_decode.DecodeXml(const data: string);
var
r,sl:tstringlist;
node : IXMLNode;
//m1:DHashMap;

begin

//m1:=DHashMap.Create;
//XMLDocument1 := TXMLDocument.Create(application);

XMLDocument1.XML.Text := data;
XMLDocument1.Active := true;

node := XMLDocument1.DocumentElement;

DecodeXml_sub(m1, node.NodeName, node);//有内存泄漏



{
//r := tstringlist(GetObject(m1.Find(['BODY/Msisdn'])));
r := tstringlist(GetObject(m1.Find(['body/msisdn'])));


showmessage(node.NodeName);
showmessage(r.Text);

node := node.ChildNodes.Nodes[0];
//}

end;

destructor TXml_decode.Destroy;
var
i:integer;
sl:TStringList;
pl:PStringList;
begin

for i:=0 to self.StringList_arr.Count-1 do
begin
//不用，DGL会自动释放容器类的东西
sl := TStringList(StringList_arr.Items[i]);
//pl := StringList_arr.Items[i];

//sl := pl^;

// showmessage(sl.Text);

sl.Free;
end;
StringList_arr.Clear;
StringList_arr.Free;

m1.Clear;
m1.Free;
XMLDocument1.Free;

end;

constructor TXml_decode.Create;
begin
StringList_arr := tlist.Create;


m1:=DHashMap.Create;
XMLDocument1 := TXMLDocument.Create(application);

end;

end.
clq
2009-12-4 11:46:20 发表 编辑

注意 destructor Destroy;override;//virtual; 不能少，否则不调用 free.

总数：2　页次：1/1　首页 尾页　　
总数：2　页次：1/1　首页 尾页　　


所在合集/目录



发表评论:
文本/html模式切换 插入图片 文本/html模式切换


附件:



NEWBT官方QQ群1: 276678893
可求档连环画,漫画;询问文本处理大师等软件使用技巧;求档softhub软件下载及使用技巧.
但不可"开车",严禁国家敏感话题,不可求档涉及版权的文档软件.
验证问题说明申请入群原因即可.

Copyright © 2005-2020 clq, All Rights Reserved
版权所有
桂ICP备15002303号-1