百度360必应搜狗淘宝本站头条
当前位置:网站首页 > IT技术 > 正文

「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 &amp; 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 命令清单(git常用命令速查表)

下面是整理的常用Git命令清单。几个专用名词的译名如下。...

2025-07-07 23:38 wptr33

GitHub|清晰理解本地目录、暂存区、本地仓库、远程仓库的交互

GitHub是一个在线平台,旨在促进在一个共同项目上工作的个人之间的代码托管、版本控制和协作。通过该平台,无论何时何地,都可以对项目进行操作(托管和审查代码,管理项目和与世界各地的其他开发者共同开发...