数据库的存取速度!Thanks(sujm@public1.sz.js.cn)

来源：互联网发布：网络扑克牌出牌机制编辑：程序博客网时间：2024/05/17 03:16

以下代码可以提高树. 数据库的存取速度。。。。。。。。。。。
sujm@public1.sz.js.cn
*****************************************************

unit FamilySet;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Menus, ImgList, Db, DBTables;

type
TVillage=record file://村记录
vid:string; file://村ID
vname:string; file://村名
end;
PVillage=^TVillage; file://村指针

TTeam=record file://组记录
vid:string; file://村ID
tid:string; file://组ID
tname:string file://组名
end;
PTeam=^TTeam; file://组指针

TFamily=record file://用户记录
id:string; file://有线编号
vid:string; file://村镇编号
tid:string; file://组街编号
fname:string; file://户名
address:string; file://地址
tel:string; file://电话
terms:integer; file://终端数
sid:string; file://用户类别
bankid:string; file://银行帐号
regdate:TDate; file://开户日期
isvalid:boolean; file://有效否
end;
PFamily=^TFamily;

TfmFamily = class(TForm)
tv: TTreeView;
MainMenu: TMainMenu;
mmProcess: TMenuItem;
mmAppend: TMenuItem;
mmEdit: TMenuItem;
mmDelete: TMenuItem;
ImageList: TImageList;
N1: TMenuItem;
sqlVillage: TQuery;
sqlTeam: TQuery;
sqlFamily: TQuery;
mmRefresh: TMenuItem;
PopupMenu: TPopupMenu;
pmAppend: TMenuItem;
pmEdit: TMenuItem;
pmDelete: TMenuItem;
N6: TMenuItem;
pmRefresh: TMenuItem;
N2: TMenuItem;
mmExpandAll: TMenuItem;
mmCollapseAll: TMenuItem;
N3: TMenuItem;
pmExpandAll: TMenuItem;
pmCollapseAll: TMenuItem;
N4: TMenuItem;
mmUnValid: TMenuItem;
mmValid: TMenuItem;
N5: TMenuItem;
pmValid: TMenuItem;
pmUnvalid: TMenuItem;
mmUserPrint: TMenuItem;
mmPrintUsers: TMenuItem;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure mmAppendClick(Sender: TObject);
procedure tvGetImageIndex(Sender: TObject; Node: TTreeNode);
procedure tvGetSelectedIndex(Sender: TObject; Node: TTreeNode);
procedure FormCreate(Sender: TObject);
procedure tvDeletion(Sender: TObject; Node: TTreeNode);
procedure mmEditClick(Sender: TObject);
procedure mmDeleteClick(Sender: TObject);
procedure mmRefreshClick(Sender: TObject);
procedure pmAppendClick(Sender: TObject);
procedure pmEditClick(Sender: TObject);
procedure pmDeleteClick(Sender: TObject);
procedure pmRefreshClick(Sender: TObject);
procedure mmExpandAllClick(Sender: TObject);
procedure mmCollapseAllClick(Sender: TObject);
procedure pmExpandAllClick(Sender: TObject);
procedure pmCollapseAllClick(Sender: TObject);
procedure mmUnValidClick(Sender: TObject);
procedure mmValidClick(Sender: TObject);
procedure pmUnvalidClick(Sender: TObject);
procedure pmValidClick(Sender: TObject);
procedure tvMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure mmPrintUsersClick(Sender: TObject);
private
{ Private declarations }
procedure ExpandTreeAll; file://镇、村、组、户 ,可能受机器限制，该函数不能成功。
public
{ Public declarations }
end;

var
fmFamily: TfmFamily;

implementation

uses NewVillage, NewTeam, NewFamily, catv_vars, ReportUser, UserPrint;
var tn0,tn1,tn2,tn3:TTreeNode; file://镇、村、组、户节点
aVillage:PVillage; file://一个村指针（市镇）
aTeam:PTeam; file://一个组指针（街道）
aFamily:PFamily; file://一个户指针
{$R *.DFM}

procedure TfmFamily.ExpandTreeAll;
begin
tv.Items.Clear;
tn0:=tv.Items.Add(nil,_AreaName);
with sqlVillage do
begin
Close;
SQL.Clear;
SQL.Add('select vid,vname from village order by vid ') ;
Open;
while not eof do
begin
New(aVillage);
aVillage.vid:=FieldByName('vid').asstring;
aVillage.vname:=FieldByName('vname').asstring;
tn1:=tv.Items.AddChildObject(tn0,aVillage.vname,aVillage);
with sqlTeam do
begin
Close;
SQL.Clear;
SQL.Add('select vid,tid,tname from team where vid=:vid order by tid ');
ParamByName('vid').asstring:=aVillage.vid;
Open;
while not eof do
begin
New(aTeam);
aTeam.vid:=aVillage.vid;
aTeam.tid:=FieldByName('tid').asstring;
aTeam.tname:=FieldByName('tname').asstring;
tn2:=tv.Items.AddChildObject(tn1,aTeam.tname,aTeam);
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add('select * from family where vid=:vid and tid=:tid order by id ');
ParamByName('vid').asstring:=aVillage.vid;
ParamByName('tid').asstring:=aTeam.tid;
Open;
while not eof do
begin
New(aFamily);
aFamily.id:=FieldByName('id').asstring;
aFamily.vid:=aVillage.vid;
aFamily.tid:=aTeam.tid;
aFamily.fname:=FieldByName('fname').asstring;
aFamily.address:=FieldByName('address').asstring;
aFamily.tel:=FieldByName('tel').asstring;
aFamily.bankid:=FieldByName('bankid').asstring;
aFamily.sid:=FieldByName('sid').asstring;
aFamily.terms:=FieldByName('terms').asinteger;
aFamily.regdate:=FieldByName('regdate').asdatetime;
aFamily.isvalid:=FieldByName('isvalid').asboolean;
tn3:=tv.Items.AddChildObject(tn2,aFamily.fname,aFamily);
Next;
end;
Close;
end;
Next;
end;
Close;
end;
Next;
end;
Close;
end;

end;

procedure TfmFamily.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;

procedure TfmFamily.mmAppendClick(Sender: TObject);
var tn:TTreeNode;
id:string;
i:integer;
begin
tn:=tv.Selected;
if (tn=nil) then tn:=tn0; file://根节点：乡镇名称
if (tn.Level=3) then tn:=tn.Parent; file://选定户时取得所在组节点
case tn.Level of
0: file://选定乡镇，增加村
with TfmNewVillage.Create(nil) do
try
Caption:='增加新村/镇';
if not tn.HasChildren then
edtVid.Text:='01'
else
begin
id:=PVillage(tn.GetLastChild.Data)^.vid;
edtVid.Text:=Copy(IntToStr(StrToInt(id)+1+100),2,2);
end;
edtVname.Text:='';
ShowModal;
if (ModalResult=mrOK) then
begin
if (length(edtVid.Text)=1) then edtVid.Text:=Copy(IntToStr(StrToInt(edtVid.text)+100),2,2); file://补前导0
with sqlVillage do
begin
Close;
SQL.Clear;
SQL.Add('insert into village (vid,vname) values (:vid,:vname) ');
ParambyName('vid').asstring:=edtVid.Text;
ParamByName('vname').asstring:=edtVname.Text;
try
ExecSQL; file://先插入表中
New(aVillage); file://再增加树节点
aVillage.vid:=edtVid.Text;
aVillage.vname:=edtVname.Text;
tv.Items.AddChildObject(tn,edtVname.text,aVillage);
except
MessageDlg('增加新村/镇失败！',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;

1: file://选定村，增加组
with TfmNewTeam.Create(nil) do
try
Caption:='增加新组/街（'+PVillage(tn.data)^.vname+'）';
if not tn.HasChildren then
edtTid.Text:='01'
else
begin
id:=PTeam(tn.GetLastChild.Data)^.tid;
edtTid.Text:=Copy(IntToStr(StrToInt(id)+1+100),2,2);
end;
edtTname.Text:='';
ShowModal;
if (ModalResult=mrOK) then
begin
if (length(edtTid.Text)=1) then edtTid.Text:=Copy(IntToStr(StrToInt(edtTid.text)+100),2,2); file://补前导0
with sqlTeam do
begin
Close;
SQL.Clear;
SQL.Add('insert into team (vid,tid,tname) values (:vid,:tid,:tname) ');
ParambyName('vid').asstring:=PVillage(tn.data)^.vid;
ParamByName('tid').asstring:=edtTid.Text;
ParamByName('tname').asstring:=edtTname.Text;
try
ExecSQL; file://先插入表中
New(aTeam); file://再增加树节点
aTeam.vid:=PVillage(tn.data)^.vid;
aTeam.tid:=edtTid.Text;
aTeam.tname:=edtTname.Text;
tv.Items.AddChildObject(tn,edtTname.text,aTeam);
except
MessageDlg('增加新组/街失败！',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;

2: file://选定组，增加户
with TfmNewFamily.Create(nil) do
try
Caption:='增加新用户（'+PTeam(tn.data)^.tname+'）';
edtId.Text:='';
edtFname.Text:='';
edtAddress.Text:='';
edtTel.Text:='';
edtBankId.Text:='';
for i:=0 to Length(_sname)-1 do
cbSid.Items.Add(_sname[i]); file://选择类别名称
cbSid.ItemIndex:=0;
edtTerms.Text:='1';
dtpRegDate.DateTime:=Date;
ShowModal;
if (ModalResult=mrOK) then
begin
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add('insert into family (id,vid,tid,fname,address,tel,bankid,sid,terms,regdate,isvalid) values (:id,:vid,:tid,:fname,:address,:tel,:bankid,:sid,:terms,:regdate,:isvalid) ');
ParamByName('id').asstring:=edtId.Text;
ParambyName('vid').asstring:=PTeam(tn.data)^.vid;
ParambyName('tid').asstring:=PTeam(tn.data)^.tid;
ParamByName('fname').asstring:=edtFname.Text;
ParamByName('address').asstring:=edtAddress.Text;
ParamByName('tel').asstring:=edtTel.Text;
ParamByName('bankid').asstring:=edtBankId.Text;
ParamByName('sid').asstring:=_sid[cbSid.itemindex]; file://保存类别编号
ParamByName('terms').asinteger:=StrTOIntDef(edtTerms.text,1);
ParamByName('regdate').asstring:=DateToStr(dtpRegDate.Date); file://不直接用日期型，防止错误
ParamByName('isvalid').asboolean:=True;
try
ExecSQL; file://先插入表中
New(aFamily); file://再增加树节点
aFamily.id:=edtId.Text;
aFamily.vid:=PVillage(tn.Parent.data)^.vid;
aFamily.tid:=PTeam(tn.data)^.tid;
aFamily.fname:=edtFname.Text;
aFamily.address:=edtAddress.Text;
aFamily.tel:=edtTel.Text;
aFamily.bankid:=edtBankId.Text;
aFamily.sid:=_sid[cbSid.itemindex];
aFamily.terms:=StrTOIntDef(edtTerms.text,1);
aFamily.regdate:=dtpRegDate.Date;
aFamily.isvalid:=True;
tv.Items.AddChildObject(tn,edtFname.text,aFamily);
except
MessageDlg('增加新用户失败！',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;

end;

end;

procedure TfmFamily.tvGetImageIndex(Sender: TObject; Node: TTreeNode);
begin
If (Node.Level=3) then file://户 0:地区 1：村 2：组 3：户
if PFamily(Node.Data)^.isvalid then
Node.ImageIndex:=2 file://有效用户
else
Node.ImageIndex:=3 file://已注销用户
else if Node.Expanded then
Node.ImageIndex:=1
else Node.ImageIndex:=0;

end;

procedure TfmFamily.tvGetSelectedIndex(Sender: TObject; Node: TTreeNode);
begin
Node.SelectedIndex:=Node.ImageIndex;
end;

procedure TfmFamily.FormCreate(Sender: TObject);
begin
// InitTree;
ExpandTreeAll;
end;

procedure TfmFamily.tvDeletion(Sender: TObject; Node: TTreeNode);
begin
if Assigned(Node.Data) then
case Node.Level of
1:
Dispose(PVillage(Node.Data));
2:
Dispose(PTeam(Node.Data));
3:
Dispose(PFamily(Node.Data));
end;
end;

procedure TfmFamily.mmEditClick(Sender: TObject);
var tn:TTreeNode; //
i:integer;
begin
tn:=tv.Selected;
if ((tn=nil) or (tn.level=0)) then
begin
MessageDlg('请选定村组(镇街)或用户！',mtInformation,[mbOk],0);
Exit;
end;
case tn.Level of
1: file://选定村，修改村
with TfmNewVillage.Create(nil) do
try
Caption:='修改村/镇名';
edtVid.Text:=PVillage(tn.data)^.vid;
edtVname.Text:=PVillage(tn.data)^.vname;
edtVid.ReadOnly:=True;
ShowModal;
if (ModalResult=mrOK) then
begin
with sqlVillage do
begin
Close;
SQL.Clear;
SQL.Add('update village set vname=:vname where vid=:vid ');
ParambyName('vid').asstring:=edtVid.Text;
ParamByName('vname').asstring:=edtVname.Text;
try
ExecSQL; file://先更新表
tn.Text:=edtVName.Text; file://再修改树节点
PVillage(tn.data)^.vname:=edtVname.Text;
except
MessageDlg('修改村/镇名失败！',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;

2: file://选定组，修改组
with TfmNewTeam.Create(nil) do
try
Caption:='修改组/街名（'+tn.Parent.Text+'）';
edtTid.Text:=PTeam(tn.data)^.tid;
edtTname.Text:=PTeam(tn.data)^.tname;
edtTid.ReadOnly:=True;
ShowModal;
if (ModalResult=mrOK) then
begin
with sqlTeam do
begin
Close;
SQL.Clear;
SQL.Add('update team set tname=:tname where vid=:vid and tid=:tid ');
ParambyName('vid').asstring:=PVillage(tn.Parent.data)^.vid;
ParamByName('tid').asstring:=edtTid.Text;
ParamByName('tname').asstring:=edtTname.Text;
try
ExecSQL; file://先修改表
tn.text:=edtTName.Text; file://再修改树节点
PTeam(tn.data)^.tname:=edtTname.Text;
except
MessageDlg('修改组/街名失败！',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;

3: file://选定户，修改户
with TfmNewFamily.Create(nil) do
try
Caption:='修改用户（'+tn.Parent.Text+'）';
edtId.ReadOnly:=True;
for i:=0 to Length(_sname)-1 do
cbSid.Items.Add(_sname[i]); file://选择类别名称

edtId.Text:=PFamily(tn.data)^.id;
edtFname.Text:=PFamily(tn.data)^.fname;
edtAddress.Text:=PFamily(tn.data)^.address;
edtTel.Text:=PFamily(tn.data)^.tel;
edtBankId.Text:=PFamily(tn.data)^.bankid;
edtTerms.Text:=IntToStr(PFamily(tn.data)^.terms);
dtpRegDate.DateTime:=PFamily(tn.data)^.regdate;
for i:=0 to Length(_sid)-1 do
if Pfamily(tn.data)^.sid=_sid[i] then break;
cbSid.ItemIndex:=i;

ShowModal;
if (ModalResult=mrOK) then
begin
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add('update family set fname=:fname,address=:address,tel=:tel,');
SQL.Add('bankid=:bankid,sid=:sid,terms=:terms,regdate=:regdate where id=:id');

ParamByName('id').asstring:=edtId.Text;
ParamByName('fname').asstring:=edtFname.Text;
ParamByName('address').asstring:=edtAddress.Text;
ParamByName('tel').asstring:=edtTel.Text;
ParamByName('bankid').asstring:=edtBankId.Text;
ParamByName('sid').asstring:=_sid[cbSid.itemindex]; file://保存类别编号
ParamByName('terms').asinteger:=StrTOIntDef(edtTerms.text,1);
ParamByName('regdate').asstring:=DateToStr(dtpRegDate.Date); file://不直接用日期型，防止错误

try
ExecSQL; file://修改表
tn.Text:=edtFname.Text; file://再修改树节点
PFamily(tn.data)^.fname:=edtFname.Text;
PFamily(tn.data)^.address:=edtAddress.Text;
PFamily(tn.data)^.tel:=edtTel.Text;
PFamily(tn.data)^.bankid:=edtBankid.Text;
PFamily(tn.data)^.sid:=_sid[cbSid.itemindex];
PFamily(tn.data)^.terms:=StrTOIntDef(edtTerms.text,1);
PFamily(tn.data)^.regdate:=dtpRegDate.Date;
except
MessageDlg('修改用户信息失败！',mtInformation,[mbOk],0);
end;
end;
end;
finally
free;
end;

end;

end;

procedure TfmFamily.mmDeleteClick(Sender: TObject);
var tn:TTreeNode;
begin
tn:=tv.Selected;
if ((tn=nil) or (tn.level=0)) then
begin
MessageDlg('请选定村组(镇街)或用户！',mtInformation,[mbOk],0);
Exit;
end;
if tn.HasChildren then
begin
MessageDlg('请先删除下级！',mtInformation,[mbOk],0);
Exit;
end;

if MessageDlg('是否删除"'+tn.text+'"？',mtConfirmation,[mbYes,mbNo],0)<>mrYes then Exit;

case tn.Level of
1: file://删除村
with sqlVillage do
begin
Close;
SQL.Clear;
SQL.Add('delete from village where vid=:vid ');
ParambyName('vid').asstring:=PVillage(tn.data)^.vid;
try
ExecSQL; file://先从表中删除
tn.Delete; file://再删除树节点
except
MessageDlg('删除失败！',mtInformation,[mbOk],0);
end;
end;

2: file://删除组
with sqlTeam do
begin
Close;
SQL.Clear;
SQL.Add('delete from team where vid=:vid and tid=:tid ');
ParambyName('vid').asstring:=PTeam(tn.data)^.vid;
ParamByName('tid').asstring:=PTeam(tn.data)^.tid;
try
ExecSQL; file://从表删除
tn.delete; file://再删除树节点
except
MessageDlg('删除失败！',mtInformation,[mbOk],0);
end;
end;

3: file://删除户
if MessageDlg('删除用户将丢失该用户的收费信息，是否删除？',mtWarning,[mbYes,mbNo],0)=mrYes then
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add('delete from family where id=:id');
ParambyName('id').asstring:=PFamily(tn.data)^.id;
try
ExecSQL; file://从表删除
tn.delete; file://再删除树节点
except
MessageDlg('删除失败！',mtInformation,[mbOk],0);
end;
end;

end;

end;

procedure TfmFamily.mmRefreshClick(Sender: TObject);
begin
ExpandTreeAll;
end;

procedure TfmFamily.pmAppendClick(Sender: TObject);
begin
mmAppend.Click;
end;

procedure TfmFamily.pmEditClick(Sender: TObject);
begin
mmEdit.Click;
end;

procedure TfmFamily.pmDeleteClick(Sender: TObject);
begin
mmDelete.Click;
end;

procedure TfmFamily.pmRefreshClick(Sender: TObject);
begin
mmRefresh.Click;
end;

procedure TfmFamily.mmExpandAllClick(Sender: TObject);
begin
tv.FullExpand;
end;

procedure TfmFamily.mmCollapseAllClick(Sender: TObject);
begin
tv.FullCollapse;
end;

procedure TfmFamily.pmExpandAllClick(Sender: TObject);
begin
mmExpandALl.Click;
end;

procedure TfmFamily.pmCollapseAllClick(Sender: TObject);
begin
mmCollapseAll.Click;
end;

procedure TfmFamily.mmUnValidClick(Sender: TObject);
var tn:TTreeNode;
begin
tn:=tv.Selected;
if (tn=nil) or (tn.Level<3) or Pfamily(tn.data)^.isvalid=false then file://只处理未注销用户
Exit;
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add(' update family set isvalid=false where id=:id') ;
ParamByName('id').asstring:=Pfamily(tn.data)^.id;
try
ExecSQL; file://先更新表
Pfamily(tn.data)^.isvalid:=false;
tv.Selected:=nil;tv.Selected:=tn; file://以改变图标
except
MessageDlg('注销用户失败！',mtInformation,[mbOk],0);
end;
end;

end;

procedure TfmFamily.mmValidClick(Sender: TObject);
var tn:TTreeNode;
begin
tn:=tv.Selected;
if (tn=nil) or (tn.Level<3) or Pfamily(tn.data)^.isvalid=True then file://只处理已注销用户
Exit;
with sqlFamily do
begin
Close;
SQL.Clear;
SQL.Add(' update family set isvalid=true where id=:id') ;
ParamByName('id').asstring:=Pfamily(tn.data)^.id;
try
ExecSQL; file://先更新表
Pfamily(tn.data)^.isvalid:=true;
tv.Selected:=nil;tv.Selected:=tn; file://以改变图标
except
MessageDlg('收回用户失败！',mtInformation,[mbOk],0);
end;
end;

end;

procedure TfmFamily.pmUnvalidClick(Sender: TObject);
begin
mmUnvalid.Click;
end;

procedure TfmFamily.pmValidClick(Sender: TObject);
begin
mmValid.Click;
end;

procedure TfmFamily.tvMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var tn:TTreeNode;
begin
tn:=tv.GetNodeAt(x,y);
if (tn=nil) or (tn.Level<3) then
tv.Hint:=''
else
tv.Hint:= '编号:'+Pfamily(tn.data)^.id
+' 户名:'+Pfamily(tn.data)^.fname
+' 端数:'+IntToStr(Pfamily(tn.data)^.terms)
+' 开户:'+DateToStr(Pfamily(tn.data)^.regdate)
+' 类别:'+GetSname(Pfamily(tn.data)^.sid)
+' 帐号:'+Pfamily(tn.data)^.bankid
+' 地址:'+Pfamily(tn.data)^.address
+' 电话:'+Pfamily(tn.data)^.tel;
end;

procedure TfmFamily.mmPrintUsersClick(Sender: TObject);
begin
with TfmUserPrint.Create(nil) do
try
ShowModal;
finally
Free;
end;

end;

end.