「11.Lazarus数据库编程」10.ZeosDBO与FireBird embedded综合示例
wptr33 2025-01-06 15:49 18 浏览
10.ZeosDBO与FireBird embedded综合示例
对于 FireBird embedded 开发时,因其需要一些 FireBird embedded 版本的 dll 及相关文件,我们需要在项目创建后做一些工作,具体可参照下面本节中 10.1 的步骤来完成。
10.1 项目准备
1.首先创建一个应用程序项目
2.将 FireBird embedded 版本的文件复制到应用程序项目所在目录,具体文件包括:
fbembed.dll
firebird.msg
ib_util.dll
icudt30.dll
icuin30.dll
icuuc30.dll
IDPLicense.txt
IPLicense.txt
Microsoft.VC80.CRT.manifest
msvcp80.dll
msvcr80.dll
3.将同版本号的 FireBird C/S 版本的 isql.exe 文件复制到Lazarus 应用所在目录
4.复制 fbembed.dll 文件并重命名为 fbclient.dll
5.在命令提示符下执行如下命令:
> cd <Lazarus 应用所在目录>
> isql
Use CONNECT or CREATE DATABASE to specify a database
SQL>
6.创建数据库:
SQL> create database 'testdb.fdb' user 'SYSDBA' password 'admin' page_size 16384 default character set UTF8;
SQL>
7.退出 isql
SQL> exit;
10.2 数据准备
进入 isql,并连接数据库
> isql
Use CONNECT or CREATE DATABASE to specify a database
SQL> connect testdb.fdb user 'SYSDBA' password 'admin';
SQL>
在 isql 下执行创建表的脚本:
create table c_dep (
dep_id varchar(64) primary key,
dep_name varchar(16)
);
create table d_dep_staff (
staff_id varchar(64) primary key,
dep_id varchar(64),
name varchar(32),
sex varchar(8),
birthday date,
edu_level varchar(16),
school varchar(64),
speciality varchar(32),
native_place varchar(256)
);
-- 由于演示应用程序不涉及部门表的数据操作,所以事先在数据表上插入几条数据
insert into c_dep (dep_id, dep_name)
values ('yfb', 'YanFaBU');
insert into c_dep (dep_id, dep_name)
values ('xsb', 'XiaoShouBu');
insert into c_dep (dep_id, dep_name)
values ('jszcb', 'JiShuZhiChiBu');
insert into c_dep (dep_id, dep_name)
values ('cwb', 'CaiWuBu');
insert into c_dep (dep_id, dep_name)
values ('xzb', 'XingZhengBu');
-- 之所以使用英文字母而不使用汉字是因为 isql 在命令提示符下使用汉字不识别
10.3 数据模块
在 Lazarus 环境下新建一个数据模块,并拖放 TZConnection、TZReadOnlyQuery 组件到数据模块中,设置组件属性如下:
- ZConnection1 的属性设置:
属性 | 值 |
Protocol | firebirdd-2.5 |
User | sysdba |
Password | admin(创建数据库时设置的) |
Database | E:\workspace_of_lazarus\laz1109\TESTDB.FDB (刚才创建的数据库) |
LibraryLocation | E:\workspace_of_lazarus\laz1109\fbembed.dll |
Connected | True |
【备注】必须设置 LibraryLocation 属性为 fbembed.dll 文件。
- ZReadOnlyQuery 1 的属性设置:
属性 | 值 |
Connection | ZConnection1 |
SQL | SELECT staff_id, s.dep_id, name, sex, birthday, edu_level, school, speciality, native_place, d.dep_name FROM d_dep_staff s left join c_dep d on s.dep_id = d.dep_id |
Active | True |
数据模块声明代码:
TDataModule1 = class(TDataModule)
// 数据库组件
ZConnection1: TZConnection;
ZReadOnlyQuery1: TZReadOnlyQuery;
// 字段声明
ZReadOnlyQuery1_BIRTHDAY: TDateField;
ZReadOnlyQuery1_DEP_ID: TStringField;
ZReadOnlyQuery1_DEP_NAME: TStringField;
ZReadOnlyQuery1_EDU_LEVEL: TStringField;
ZReadOnlyQuery1_NAME: TStringField;
ZReadOnlyQuery1_NATIVE_PLACE: TStringField;
ZReadOnlyQuery1_SCHOOL: TStringField;
ZReadOnlyQuery1_SEX: TStringField;
ZReadOnlyQuery1_SPECIALITY: TStringField;
ZReadOnlyQuery1_STAFF_ID: TStringField;
private
public
end;
10.4 主窗体组件
主窗体组件设计如下图:
数据组件及其属性设置:
- DataSource1
属性 | 值 |
DataSet | DataModule1.ZReadOnlyQuery1 |
- DBGrid1
属性 | 值 |
DataSource | DataSource1 |
Options | dgRowSelect=True |
Align | alClient |
- DBNavigator1
属性 | 值 |
DataSource | DataSource1 |
VisibleButtons | [nbFirst,nbPrior,nbNext,nbLast] |
Align | alRight |
主窗体组件声明代码:
TForm1 = class(TForm)
// 按钮
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
// 数据组件
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
// 按钮及数据导航组件的容器
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure DBGrid1DblClick(Sender: TObject);
private
public
end;
10.5 表单窗体组件
表单窗体设计如下图所示:
表单窗体声明代码:
TForm2 = class(TForm)
// 确定和取消按钮
Button1: TButton;
Button2: TButton;
// 数据控件
BirthdayDateTimePicker: TDateTimePicker;
NativePlaceEdit: TEdit;
SpecialityEdit: TEdit;
SchoolEdit: TEdit;
EduLevelComboBox: TComboBox;
DepComboBox: TComboBox;
NameEdit: TEdit;
SexRadioGroup: TRadioGroup;
// 标签
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
GroupBox4: TGroupBox;
GroupBox5: TGroupBox;
GroupBox6: TGroupBox;
GroupBox7: TGroupBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
public
isNew: Boolean; // 标识是否为新增数据记录
end;
10.6 功能实现
- 主窗体代码:
uses unit2, unit3;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
// 新建
Form2.isNew := True;
if Form2.ShowModal = mrOk then
begin
DataModule1.ZReadOnlyQuery1.Refresh;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
// 编辑
if DataModule1.ZReadOnlyQuery1.BOF then
if DataModule1.ZReadOnlyQuery1.RecordCount > 0 then
DataModule1.ZReadOnlyQuery1.First
else
Exit;
if DataModule1.ZReadOnlyQuery1.EOF then
if DataModule1.ZReadOnlyQuery1.RecordCount > 0 then
DataModule1.ZReadOnlyQuery1.Last
else
Exit;
Form2.isNew := False;
if Form2.ShowModal = mrOk then
begin
DataModule1.ZReadOnlyQuery1.Refresh;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
Query: TZQuery;
begin
// 删除
if DataModule1.ZReadOnlyQuery1.BOF then
if DataModule1.ZReadOnlyQuery1.RecordCount > 0 then
DataModule1.ZReadOnlyQuery1.First
else
Exit;
if DataModule1.ZReadOnlyQuery1.EOF then
if DataModule1.ZReadOnlyQuery1.RecordCount > 0 then
DataModule1.ZReadOnlyQuery1.Last
else
Exit;
Query := TZQuery.Create(Self);
try
Query.Connection := DataModule1.ZConnection1;
Query.Close;
Query.SQL.Text := 'DELETE FROM d_dep_staff where staff_id = :staffId';
Query.Params.ParamByName('staffId').AsString := DataModule1.ZReadOnlyQuery1_STAFF_ID.Value;
Query.ExecSQL;
except
on D: EDatabaseError do
MessageDlg('Error', 'A database error has occurred. Technical error message: ' + D.Message, mtError, [mbOK], 0);
end;
Query.Destroy;
DataModule1.ZReadOnlyQuery1.Refresh;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
DataModule1.ZReadOnlyQuery1.Refresh;
end;
procedure TForm1.DBGrid1DblClick(Sender: TObject);
begin
// 双击修改
Button2Click(Sender);
end;
- 表单窗体代码:
uses unit2;
procedure TForm2.FormActivate(Sender: TObject);
var
Query: TZQuery;
index: Integer;
begin
// 初始化部门选项
try
Query := TZQuery.Create(Self);
Query.Connection := DataModule1.ZConnection1;
Query.Close;
Query.SQL.Text := 'SELECT dep_id, dep_name FROM c_dep';
Query.Open;
DepComboBox.Items.Clear;
while not Query.EOF do
begin
DepComboBox.Items.AddObject(
Query.FieldByName('dep_name').AsString,
TObject(NewStr(Query.FieldByName('dep_id').AsString))
);
Query.Next;
end;
except
on D: EDatabaseError do
MessageDlg('Error', 'A database error has occurred. Technical error message: ' + D.Message, mtError, [mbOK], 0);
end;
// 初始化数据项
if isNew then
begin
NameEdit.Text:='';
SexRadioGroup.ItemIndex:=0;
SchoolEdit.Text:='';
SpecialityEdit.Text:='';
NativePlaceEdit.Text:='';
end
else
with DataModule1 do
begin
NameEdit.Text:=ZReadOnlyQuery1_NAME.Value;
if ZReadOnlyQuery1_SEX.Value = '男' then
SexRadioGroup.ItemIndex:=0
else
SexRadioGroup.ItemIndex:=1;
index := DepComboBox.Items.IndexOf(ZReadOnlyQuery1_DEP_NAME.Value);
DepComboBox.ItemIndex:=index;
BirthdayDateTimePicker.Date := ZReadOnlyQuery1_BIRTHDAY.Value;
EduLevelComboBox.Text := ZReadOnlyQuery1_EDU_LEVEL.Value;
SchoolEdit.Text := ZReadOnlyQuery1_SCHOOL.Value;
SpecialityEdit.Text:=ZReadOnlyQuery1_SPECIALITY.Value;
NativePlaceEdit.Text:= ZReadOnlyQuery1_NATIVE_PLACE.Value;
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
// 取消
ModalResult := mrCancel;
end;
procedure TForm2.Button2Click(Sender: TObject);
var
Query: TZQuery;
index: Integer;
depId: String;
begin
// 确定
if NameEdit.Text = '' then
begin
MessageDlg('提示', '请输入姓名!', mtError, [mbOK], 0);
Exit;
end;
if DepComboBox.ItemIndex < 0 then
begin
MessageDlg('提示', '请选择所在部门!', mtError, [mbOK], 0);
Exit;
end;
index := DepComboBox.ItemIndex;
depId := PAnsiString(DepComboBox.Items.Objects[index])^;
Query := TZQuery.Create(Self);
try
Query.Connection := DataModule1.ZConnection1;
Query.Close;
if isNew then
begin
Query.SQL.Text := 'INSERT INTO d_dep_staff (staff_id, dep_id, name, sex, birthday, edu_level, school, speciality, native_place) VALUES(uuid_to_char(gen_uuid()), :depId, :name, :sex, :birthday, :eduLevel, :school, :speciality, :nativePlace)';
Query.Params.ParamByName('depId').AsString := depId;
Query.Params.ParamByName('name').AsString := NameEdit.Text;
if SexRadioGroup.ItemIndex = 0 then
Query.Params.ParamByName('sex').AsString := '男'
else
Query.Params.ParamByName('sex').AsString := '女';
Query.Params.ParamByName('birthday').AsDate := BirthdayDateTimePicker.Date;
Query.Params.ParamByName('eduLevel').AsString := EduLevelComboBox.Text;
Query.Params.ParamByName('school').AsString := SchoolEdit.Text;
Query.Params.ParamByName('speciality').AsString := SpecialityEdit.Text;
Query.Params.ParamByName('nativePlace').AsString := NativePlaceEdit.Text;
Query.ExecSQL;
end
else
begin
Query.SQL.Text := 'UPDATE d_dep_staff SET dep_id=:depId, name=:name, sex=:sex, birthday=:birthday, edu_level=:eduLevel, school=:school, speciality=:speciality, native_place=:nativePlace WHERE staff_id=:staffId';
Query.Params.ParamByName('depId').AsString := depId;
Query.Params.ParamByName('name').AsString := NameEdit.Text;
if SexRadioGroup.ItemIndex = 0 then
Query.Params.ParamByName('sex').AsString := '男'
else
Query.Params.ParamByName('sex').AsString := '女';
Query.Params.ParamByName('birthday').AsDate := BirthdayDateTimePicker.Date;
Query.Params.ParamByName('eduLevel').AsString := EduLevelComboBox.Text;
Query.Params.ParamByName('school').AsString := SchoolEdit.Text;
Query.Params.ParamByName('speciality').AsString := SpecialityEdit.Text;
Query.Params.ParamByName('nativePlace').AsString := NativePlaceEdit.Text;
Query.Params.ParamByName('staffId').AsString := DataModule1.ZReadOnlyQuery1_STAFF_ID.Value;
Query.ExecSQL;
end;
except
on D: EDatabaseError do
MessageDlg('Error', 'A database error has occurred. Technical error message: ' + D.Message, mtError, [mbOK], 0);
end;
Query.Destroy;
ModalResult := mrOk;
end;
F9 运行程序,执行效果如下:
相关推荐
- 抢先体验Windows 10 20H2新功能,该怎样操作呢?
-
Win10系统通常会在一年当中进行两次重大更新,分别于上下半年分别推出。上半年的更新主要针对功能的变化,而下半年则是提升系统稳定性。最近Win10下半年最重要的更新Windows1020H2已经开...
- 教程:如何关闭Win10/Win8.1/Win7管理共享
-
教程:如何关闭Win10/Win8.1/Win7管理共享出处:IT之家原创(晨风)默认情况下,Windows会创建一些隐藏的共享文件夹,这些文件夹在名称的末尾都有美元“$”标志。当用户在文件资源管理...
- Win11学院:如何强制让Windows 11设备蓝屏
-
IT之家12月15日消息,在Win11系统中蓝屏(BSoD)也称为“停止错误”(StopError)和“错误检查”(BugCheck),通常情况下只有在遇到关键问题的时候才会出现。显然...
- 微软承认Windows 10新BUG:错误显示没有网络连接
-
来源:cnBeta.COM在7月补丁星期二活动中,微软发布的累积更新已经修复Windows10系统中的大量BUG。不过近日,微软承认了存在于Windows10May2020(20H...
- 一课译词:双标(双标英文怎么写)
-
PhotobyMarkusSpiskeonUnsplash“双标[shuāngbiāo]”,网络流行语,完整说法是“双重标准”,翻译为“doublestandard”。“双标”是指“对同...
- 知识科普:USB端口如何禁用和解锁?
-
2015-07-3005:32:00作者:赵为民经常有人会说,我要保护我的笔记本电脑的USB端口,在未经授权的情况下不能够访问。是否有专业的软件可以将USB端口锁死,然后在需要的时候解锁呢?是的,...
- 小迈科技 X Hologres:高可用的百亿级广告实时数仓建设
-
通过本文,我们将会介绍小迈科技如何通过Hologres搭建高可用的实时数仓。一、业务介绍...
- Modbus-RTU通信(modbus rtu rtu over tcp)
-
通常情况下我们做Modbus通信的时候,都会先用测试软件进行测试,等通信测试通过之后,我们才会进行移植,我这边主要讲的是移植到PLC上,我现在这边还没有开始做PLC程序,那先把前期的用测试软件如何测...
- 警惕!利用Github进行水坑攻击安全风险通告
-
2022年5月19日,亚信安全CERT监测发现Github账户为rkxxz的用户发布了CVE-2022-26809和CVE-2022-24500的项目,项目内容介绍为:CVE-2022-26809...
- 手机越用越慢?小编教你如何用黑狱冰箱调教它!
-
看完智趣狗昨天推送的《看完秒懂!这就是Android手机越用越卡的原因!》一文后,我们不难知晓手机越用越慢多是体量更大的APP,以及APP之间相互唤醒而导致资源过度消耗引起的。所以,想让手机恢复高效率...
- 秒杀系统—3.第二版升级优化的技术文档一
-
大纲1.秒杀系统的服务细分和服务定位...
- Redis命令介绍(二十五)HSET & HSETNX
-
HSET将上送的键值对保存在key中存储的哈希表中。如果key不存在则创建一个新的哈希表。如果key已存在,则覆盖。在4.0版本后,HSET支持同时上送多键值对。...
- IDEA用上这十大插件就很舒服(intellij idea插件推荐)
-
本文翻译自国外论坛medium,原文地址:https://medium.com/@xjpp22/top-10-plugins-for-intellij-idea-you-dont-want-to-m...
-
- 常用 Git 命令清单(git常用命令速查表)
-
下面是整理的常用Git命令清单。几个专用名词的译名如下。...
-
2025-07-07 23:38 wptr33
- GitHub|清晰理解本地目录、暂存区、本地仓库、远程仓库的交互
-
GitHub是一个在线平台,旨在促进在一个共同项目上工作的个人之间的代码托管、版本控制和协作。通过该平台,无论何时何地,都可以对项目进行操作(托管和审查代码,管理项目和与世界各地的其他开发者共同开发...
- 一周热门
-
-
C# 13 和 .NET 9 全知道 :13 使用 ASP.NET Core 构建网站 (1)
-
因果推断Matching方式实现代码 因果推断模型
-
git pull命令使用实例 git pull--rebase
-
面试官:git pull是哪两个指令的组合?
-
git 执行pull错误如何撤销 git pull fail
-
git pull 和git fetch 命令分别有什么作用?二者有什么区别?
-
git fetch 和git pull 的异同 git中fetch和pull的区别
-
git pull 之后本地代码被覆盖 解决方案
-
还可以这样玩?Git基本原理及各种骚操作,涨知识了
-
git命令之pull git.pull
-
- 最近发表
- 标签列表
-
- git pull (33)
- git fetch (35)
- mysql insert (35)
- mysql distinct (37)
- concat_ws (36)
- java continue (36)
- jenkins官网 (37)
- mysql 子查询 (37)
- python元组 (33)
- mybatis 分页 (35)
- vba split (37)
- redis watch (34)
- python list sort (37)
- nvarchar2 (34)
- mysql not null (36)
- hmset (35)
- python telnet (35)
- python readlines() 方法 (36)
- munmap (35)
- docker network create (35)
- redis 集合 (37)
- python sftp (37)
- setpriority (34)
- c语言 switch (34)
- git commit (34)