S
steven7581
Unregistered / Unconfirmed
GUEST, unregistred user!
我的编译环境是D7+SQL2000+WinXP
DLL程序文件如下,是一个通过数据库生成树形结构的程序
library comm;
uses
ShareMem, Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs,
StdCtrls, ExtCtrls, ShellAPI, Inifiles, comobj, DB, ADODB, ComCtrls, Math,
DateUtils, ActiveX;
type //树形结构中所用的记录
TTreeItem = Record
ItemID : String;
ParentID : String;
DeepLen : Integer;
Caption : String;
end;
{$R *.res}
function GetNodeLevel(sFormat, sCode: ShortString): integer; stdcall;
var
i,level,iLen:integer;
FormatLength,CodeLength:integer;
begin
level:=-1 ;
iLen:=0;
formatlength:=length(sFormat);
codelength:=length(sCode);
if (sFormat<>'') and (sCode<>'') then
for i:=1 to FormatLength do //分析编码格式,找出当前代码层次
begin
iLen:=iLen+StrToInt(sFormat);
if CodeLength=iLen then
begin
level:=i;
break;
end;
end;
result:=level;
end;
function GetBM(Value:ShortString):ShortString; stdcall;
var
long:integer;
Str0,Str1:ShortString;
Temp_str:ShortString;
begin
Temp_str:='';
str0:=value;
while not(length(str0)=1) do
begin
long:=length(str0);
str1:=copy(str0,1,pos('-',str0)-1);
str0:=copy(str0,pos('-',str0)+1,long);
Temp_str:=Temp_str+str1;
end;
Temp_str:=Temp_str+str0;
Result:=Temp_str;
end;
procedure LoadTree_BM(treeDB:TADOQuery;N1,N2:integer;RootName:ShortString;BMFA:ShortString;var MyTree:TTreeView); stdcall;//由数据库生成树结构
var
BM:ShortString;
nodeID,nodeTxt:string;
mynode:array of TTreeNode;
level:integer;
Pnode:^TTreeItem;
begin
CoInitialize(Nil);
if not treeDB.Active then exit;
BM:=GetBM(BMFA);
setlength(mynode,length(BM)+1);
MyTree.Items.BeginUpdate ;
MyTree.Items.Clear;
//设置根节点
mynode[0]:=MyTree.Items.add(MyTree.Topitem,RootName);
mynode[0].Data:=nil;
mynode[0].ImageIndex:=0;
with treeDB do
begin
First;
while not eof do
begin
new(Pnode);
nodeID:=trim(Fields[N1].AsString);
nodeTxt:='【'+nodeID+'】 '+trim(Fields[N2].AsString);
level:=GetNodeLevel(BM,nodeID);
Pnode^.ItemID:=nodeID;
Pnode^.Caption:=trim(Fields[N2].AsString);
if level>0 then
begin
mynode[level]:=MyTree.items.addchild(mynode[level-1],nodeTxt);
mynode[level].Data:=Pnode;
mynode[level].ImageIndex:=0;
end;
Next;
end;
end;
MyTree.Items.Item[0].expand(false);
MyTree.Items.EndUpdate ;
CoUninitialize();
end;
procedure LoadTree_Qry(treeDB:TADOQuery;N1,N2,N3,N4:integer;RootName:ShortString;var MyTree:TTreeView); stdcall;
type
PRec = ^TRec;
TRec = Record
ItemID : String ;
ParentID : String ;
DeepLen : integer;
Caption : String;
RecNo : Integer ;
Added : Boolean ;
end;
var
ParentNode, selfNode:TTreeNode;
aRec : PRec ;
aList : TList ;
Pnode:^TTreeItem;
i, nAdded, nRecNo : Integer ;
lFindNode : Boolean ;
begin
CoInitialize(Nil);
if not treeDB.Active then exit;
MyTree.Items.BeginUpdate ;
MyTree.Items.Clear;
//根结点
new(Pnode);
Pnode^.ItemID:='0';
Pnode^.ParentID:='';
Pnode^.DeepLen:=0;
Pnode^.Caption:=RootName;
ParentNode:=MyTree.Items.AddChildObject(nil,Pnode^.Caption,Pnode);
ParentNode.ImageIndex:=0;
treeDB.Filtered:=false;
treeDB.Filter:=treeDB.Fields[N3].FieldName+'=0';
treeDB.Filtered:=true;
treeDB.First;
while not treeDB.Eof do
begin
new(Pnode);
Pnode^.ItemID:=treeDB.Fields[N1].AsString;
Pnode^.ParentID:=treeDB.Fields[N3].AsString;
Pnode^.DeepLen:=treeDB.Fields[N4].AsInteger;
Pnode^.Caption:=treeDB.Fields[N2].AsString;
selfNode:=MyTree.Items.AddChildObject(ParentNode,'【'+Pnode^.ItemID+'】 '+Pnode^.Caption,Pnode);
selfNode.ImageIndex:=0;
treeDB.Next;
end;
treeDB.Filtered:=false;
treeDB.Filter:=treeDB.Fields[N3].FieldName+'>0';
treeDB.Filtered:=true;
treeDB.First;
aList := TList.Create ;
nRecNo := 0 ;
while not TreeDB.Eof do
begin
new(aRec);
Inc(nRecNo) ;
aRec.ItemID:=treeDB.Fields[N1].AsString;
aRec.ParentID:=treeDB.Fields[N3].AsString;
aRec.DeepLen:=treeDB.Fields[N4].AsInteger;
aRec.Caption:=treeDB.Fields[N2].AsString;
aRec.Added := False ;
aRec.RecNo := nRecNo ;
aList.Add(aRec) ;
treeDB.Next;
end;
while true do
begin
nAdded := 0 ;
ParentNode := nil ;
for i := 0 to (aList.Count - 1) do
begin
if Not(PRec(aList.Items).Added) then
begin
lFindNode := False ;
if Not(Assigned(ParentNode)) then
lFindNode := True
else
begin
if PRec(aList.Items).ParentID <> TTreeItem(ParentNode.Data^).ItemID then
lFindNode := True ;
end;
if lFindNode then
begin
ParentNode := MyTree.Items.GetFirstNode ;
while Assigned(ParentNode) do
begin
if PRec(aList.Items).ParentID = TTreeItem(ParentNode.Data^).ItemID then
break ;
ParentNode := ParentNode.GetNext ;
end;
end;
TreeDB.RecNo := PRec(aList.Items).RecNo ;
New(PNode) ;
Pnode^.ItemID:=PRec(aList.Items).ItemID ;
Pnode^.ParentID:=PRec(aList.Items).ParentID ;
Pnode^.DeepLen:=PRec(aList.Items).DeepLen ;
Pnode^.Caption:=PRec(aList.Items).Caption ;
SelfNode := MyTree.Items.AddChildObject(ParentNode,'【'+Pnode^.ItemID+'】 '+Pnode^.Caption,Pnode);
SelfNode.ImageIndex := 0;
Inc(nAdded) ;
PRec(aList.Items).Added := True ;
end;
end;
if nAdded = 0 then break ;
if nAdded < aList.Count then
begin
for i := (aList.Count - 1) downto 0 do
begin
if PRec(aList.Items).Added then
begin
Dispose(PRec(aList.Items)) ;
aList.Delete(i);
end;
end;
end;
end;
for i := 0 to (aList.Count - 1) do
Dispose(PRec(aList.Items)) ;
aList.Clear ; aList.Free ;
MyTree.Items.Item[0].expand(false);
ParentNode := MyTree.Items.GetFirstNode ;
ParentNode.MakeVisible ;
MyTree.Items.EndUpdate ;
CoUninitialize();
end;
procedure ClearTreeData(MyTree:TTreeView);stdcall; //清除树结构
var
Pnode:^TTreeItem;
i:integer;
begin
for i:=MyTree.Items.Count-1 downto 0 do
begin
if MyTree.Items.Data=nil then
begin
MyTree.Items.Delete;
end
else
begin
Pnode:=MyTree.Items.Data;
MyTree.Items.Data:=nil;
MyTree.Items.Delete;
dispose(Pnode);
end;
end;
end;
exports
GetNodeLevel,
GetBM,
LoadTree_BM,
LoadTree_Qry,
ClearTreeData;
begin
end.
调用主程序如下:
unit Unit1;
interface
uses
ShareMem, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Grids, DBGrids, cxControls, cxContainer, cxTreeView,
ExtCtrls, DB, ADODB, StdCtrls;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
Panel1: TPanel;
Panel2: TPanel;
DBGrid1: TDBGrid;
ADOQuery1: TADOQuery;
DataSource1: TDataSource;
Button1: TButton;
TreeView1: TTreeView;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
ADOQuery2: TADOQuery;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure LoadTree_BM(treeDB:TADOQuery;N1,N2:integer;RootName:ShortString;BMFA:ShortString;var MyTree:TTreeView);stdcall;external 'comm.dll' name 'LoadTree_BM';
procedure LoadTree_Qry(treeDB:TADOQuery;N1,N2,N3,N4:integer;RootName:ShortString;var MyTree:TTreeView); stdcall;external 'comm.dll' name 'LoadTree_Qry';
function GetNodeLevel(sFormat, sCode: ShortString): integer; stdcall;external 'comm.dll' name 'GetNodeLevel';
procedure ClearTreeData(MyTree:TTreeView);stdcall;external 'comm.dll' name 'ClearTreeData';
procedure TForm1.Button1Click(Sender: TObject);
var
tStart, tEnd : TDateTime ;
begin
ADOQuery1.Open;
ADOQuery1.Filtered:=false;
tStart := Now ;
LoadTree_BM(ADOQuery1,0,1,'公司名称','4-4',TreeView1);
tEnd := Now ;
Label1.Caption:=FormatDateTime('hh:mm:ss.zz', tEnd - tStart) ;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
tStart, tEnd : TDateTime ;
begin
ADOQuery1.Open;
ADOQuery1.Filtered:=false;
tStart := Now ;
LoadTree_Qry(ADOQuery1,2,1,3,4,'公司名称',TreeView1);
tEnd := Now ;
Label2.Caption:=FormatDateTime('hh:mm:ss.zz', tEnd - tStart) ;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Label2.Caption:=inttostr(GetNodeLevel('22222','010101'));
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
ClearTreeData(TreeView1);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ClearTreeData(TreeView1);
end;
end.
我使用的是静态DLL调用方法,在程序正常运行的时候没有问题,一但退出程序就报“Runtime error 217 at 0041DCF0”的错误,是内存分配与回收上的问题,我一直没找到出问题的地方。请各位高手指教一二。
另:我在DLL模块中加上
initialization
CoInitialize(nil);
finalization
CoUninitialize;
语法检查就过不去,不知道是为什么?
DLL程序文件如下,是一个通过数据库生成树形结构的程序
library comm;
uses
ShareMem, Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs,
StdCtrls, ExtCtrls, ShellAPI, Inifiles, comobj, DB, ADODB, ComCtrls, Math,
DateUtils, ActiveX;
type //树形结构中所用的记录
TTreeItem = Record
ItemID : String;
ParentID : String;
DeepLen : Integer;
Caption : String;
end;
{$R *.res}
function GetNodeLevel(sFormat, sCode: ShortString): integer; stdcall;
var
i,level,iLen:integer;
FormatLength,CodeLength:integer;
begin
level:=-1 ;
iLen:=0;
formatlength:=length(sFormat);
codelength:=length(sCode);
if (sFormat<>'') and (sCode<>'') then
for i:=1 to FormatLength do //分析编码格式,找出当前代码层次
begin
iLen:=iLen+StrToInt(sFormat);
if CodeLength=iLen then
begin
level:=i;
break;
end;
end;
result:=level;
end;
function GetBM(Value:ShortString):ShortString; stdcall;
var
long:integer;
Str0,Str1:ShortString;
Temp_str:ShortString;
begin
Temp_str:='';
str0:=value;
while not(length(str0)=1) do
begin
long:=length(str0);
str1:=copy(str0,1,pos('-',str0)-1);
str0:=copy(str0,pos('-',str0)+1,long);
Temp_str:=Temp_str+str1;
end;
Temp_str:=Temp_str+str0;
Result:=Temp_str;
end;
procedure LoadTree_BM(treeDB:TADOQuery;N1,N2:integer;RootName:ShortString;BMFA:ShortString;var MyTree:TTreeView); stdcall;//由数据库生成树结构
var
BM:ShortString;
nodeID,nodeTxt:string;
mynode:array of TTreeNode;
level:integer;
Pnode:^TTreeItem;
begin
CoInitialize(Nil);
if not treeDB.Active then exit;
BM:=GetBM(BMFA);
setlength(mynode,length(BM)+1);
MyTree.Items.BeginUpdate ;
MyTree.Items.Clear;
//设置根节点
mynode[0]:=MyTree.Items.add(MyTree.Topitem,RootName);
mynode[0].Data:=nil;
mynode[0].ImageIndex:=0;
with treeDB do
begin
First;
while not eof do
begin
new(Pnode);
nodeID:=trim(Fields[N1].AsString);
nodeTxt:='【'+nodeID+'】 '+trim(Fields[N2].AsString);
level:=GetNodeLevel(BM,nodeID);
Pnode^.ItemID:=nodeID;
Pnode^.Caption:=trim(Fields[N2].AsString);
if level>0 then
begin
mynode[level]:=MyTree.items.addchild(mynode[level-1],nodeTxt);
mynode[level].Data:=Pnode;
mynode[level].ImageIndex:=0;
end;
Next;
end;
end;
MyTree.Items.Item[0].expand(false);
MyTree.Items.EndUpdate ;
CoUninitialize();
end;
procedure LoadTree_Qry(treeDB:TADOQuery;N1,N2,N3,N4:integer;RootName:ShortString;var MyTree:TTreeView); stdcall;
type
PRec = ^TRec;
TRec = Record
ItemID : String ;
ParentID : String ;
DeepLen : integer;
Caption : String;
RecNo : Integer ;
Added : Boolean ;
end;
var
ParentNode, selfNode:TTreeNode;
aRec : PRec ;
aList : TList ;
Pnode:^TTreeItem;
i, nAdded, nRecNo : Integer ;
lFindNode : Boolean ;
begin
CoInitialize(Nil);
if not treeDB.Active then exit;
MyTree.Items.BeginUpdate ;
MyTree.Items.Clear;
//根结点
new(Pnode);
Pnode^.ItemID:='0';
Pnode^.ParentID:='';
Pnode^.DeepLen:=0;
Pnode^.Caption:=RootName;
ParentNode:=MyTree.Items.AddChildObject(nil,Pnode^.Caption,Pnode);
ParentNode.ImageIndex:=0;
treeDB.Filtered:=false;
treeDB.Filter:=treeDB.Fields[N3].FieldName+'=0';
treeDB.Filtered:=true;
treeDB.First;
while not treeDB.Eof do
begin
new(Pnode);
Pnode^.ItemID:=treeDB.Fields[N1].AsString;
Pnode^.ParentID:=treeDB.Fields[N3].AsString;
Pnode^.DeepLen:=treeDB.Fields[N4].AsInteger;
Pnode^.Caption:=treeDB.Fields[N2].AsString;
selfNode:=MyTree.Items.AddChildObject(ParentNode,'【'+Pnode^.ItemID+'】 '+Pnode^.Caption,Pnode);
selfNode.ImageIndex:=0;
treeDB.Next;
end;
treeDB.Filtered:=false;
treeDB.Filter:=treeDB.Fields[N3].FieldName+'>0';
treeDB.Filtered:=true;
treeDB.First;
aList := TList.Create ;
nRecNo := 0 ;
while not TreeDB.Eof do
begin
new(aRec);
Inc(nRecNo) ;
aRec.ItemID:=treeDB.Fields[N1].AsString;
aRec.ParentID:=treeDB.Fields[N3].AsString;
aRec.DeepLen:=treeDB.Fields[N4].AsInteger;
aRec.Caption:=treeDB.Fields[N2].AsString;
aRec.Added := False ;
aRec.RecNo := nRecNo ;
aList.Add(aRec) ;
treeDB.Next;
end;
while true do
begin
nAdded := 0 ;
ParentNode := nil ;
for i := 0 to (aList.Count - 1) do
begin
if Not(PRec(aList.Items).Added) then
begin
lFindNode := False ;
if Not(Assigned(ParentNode)) then
lFindNode := True
else
begin
if PRec(aList.Items).ParentID <> TTreeItem(ParentNode.Data^).ItemID then
lFindNode := True ;
end;
if lFindNode then
begin
ParentNode := MyTree.Items.GetFirstNode ;
while Assigned(ParentNode) do
begin
if PRec(aList.Items).ParentID = TTreeItem(ParentNode.Data^).ItemID then
break ;
ParentNode := ParentNode.GetNext ;
end;
end;
TreeDB.RecNo := PRec(aList.Items).RecNo ;
New(PNode) ;
Pnode^.ItemID:=PRec(aList.Items).ItemID ;
Pnode^.ParentID:=PRec(aList.Items).ParentID ;
Pnode^.DeepLen:=PRec(aList.Items).DeepLen ;
Pnode^.Caption:=PRec(aList.Items).Caption ;
SelfNode := MyTree.Items.AddChildObject(ParentNode,'【'+Pnode^.ItemID+'】 '+Pnode^.Caption,Pnode);
SelfNode.ImageIndex := 0;
Inc(nAdded) ;
PRec(aList.Items).Added := True ;
end;
end;
if nAdded = 0 then break ;
if nAdded < aList.Count then
begin
for i := (aList.Count - 1) downto 0 do
begin
if PRec(aList.Items).Added then
begin
Dispose(PRec(aList.Items)) ;
aList.Delete(i);
end;
end;
end;
end;
for i := 0 to (aList.Count - 1) do
Dispose(PRec(aList.Items)) ;
aList.Clear ; aList.Free ;
MyTree.Items.Item[0].expand(false);
ParentNode := MyTree.Items.GetFirstNode ;
ParentNode.MakeVisible ;
MyTree.Items.EndUpdate ;
CoUninitialize();
end;
procedure ClearTreeData(MyTree:TTreeView);stdcall; //清除树结构
var
Pnode:^TTreeItem;
i:integer;
begin
for i:=MyTree.Items.Count-1 downto 0 do
begin
if MyTree.Items.Data=nil then
begin
MyTree.Items.Delete;
end
else
begin
Pnode:=MyTree.Items.Data;
MyTree.Items.Data:=nil;
MyTree.Items.Delete;
dispose(Pnode);
end;
end;
end;
exports
GetNodeLevel,
GetBM,
LoadTree_BM,
LoadTree_Qry,
ClearTreeData;
begin
end.
调用主程序如下:
unit Unit1;
interface
uses
ShareMem, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Grids, DBGrids, cxControls, cxContainer, cxTreeView,
ExtCtrls, DB, ADODB, StdCtrls;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
Panel1: TPanel;
Panel2: TPanel;
DBGrid1: TDBGrid;
ADOQuery1: TADOQuery;
DataSource1: TDataSource;
Button1: TButton;
TreeView1: TTreeView;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
ADOQuery2: TADOQuery;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure LoadTree_BM(treeDB:TADOQuery;N1,N2:integer;RootName:ShortString;BMFA:ShortString;var MyTree:TTreeView);stdcall;external 'comm.dll' name 'LoadTree_BM';
procedure LoadTree_Qry(treeDB:TADOQuery;N1,N2,N3,N4:integer;RootName:ShortString;var MyTree:TTreeView); stdcall;external 'comm.dll' name 'LoadTree_Qry';
function GetNodeLevel(sFormat, sCode: ShortString): integer; stdcall;external 'comm.dll' name 'GetNodeLevel';
procedure ClearTreeData(MyTree:TTreeView);stdcall;external 'comm.dll' name 'ClearTreeData';
procedure TForm1.Button1Click(Sender: TObject);
var
tStart, tEnd : TDateTime ;
begin
ADOQuery1.Open;
ADOQuery1.Filtered:=false;
tStart := Now ;
LoadTree_BM(ADOQuery1,0,1,'公司名称','4-4',TreeView1);
tEnd := Now ;
Label1.Caption:=FormatDateTime('hh:mm:ss.zz', tEnd - tStart) ;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
tStart, tEnd : TDateTime ;
begin
ADOQuery1.Open;
ADOQuery1.Filtered:=false;
tStart := Now ;
LoadTree_Qry(ADOQuery1,2,1,3,4,'公司名称',TreeView1);
tEnd := Now ;
Label2.Caption:=FormatDateTime('hh:mm:ss.zz', tEnd - tStart) ;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Label2.Caption:=inttostr(GetNodeLevel('22222','010101'));
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
ClearTreeData(TreeView1);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ClearTreeData(TreeView1);
end;
end.
我使用的是静态DLL调用方法,在程序正常运行的时候没有问题,一但退出程序就报“Runtime error 217 at 0041DCF0”的错误,是内存分配与回收上的问题,我一直没找到出问题的地方。请各位高手指教一二。
另:我在DLL模块中加上
initialization
CoInitialize(nil);
finalization
CoUninitialize;
语法检查就过不去,不知道是为什么?