Delphi 7 在现在生产环境中的开发基本已经绝迹，所剩不多的人员也主要用于旧系统的维护与小功能的升级，还有很少的一部分人沿用旧有的技能线升级到 XE 等后续版本继续完成日常的开发工作。更多的系统要么升级到了 .NET 体系 ，要么就是用了 Java 体系。但不可否认的是在 Windows 桌面软件的开发的某些场合中，其实用它还是蛮快的。
一个项目最初的需求跟数据库毫无关系，在考虑需求的基础上选择了 Delphi 7 ，这样发布一个独立的可执行程序，依赖很少，使用比较方便，但需求总是变化的，有了使用数据库的需求，把单机的应用变成了一个网络的应用，以往在 Windows 系统上一般用微软自家的 SQL Server 多一些，但现在机器上没有，MySQL 倒是现成的，于是决定用它了。
Delphi 7 开发的快速性在于其基于组件的丰富性，在早期好像用过 MySQL，用的是基于 ODBC 的 MySQL 驱动，但相当不好用，具体不好用的细节倒是忘记了，想着这么些年过去了，有没有与时俱进的组件呢，搜了一下还真发现了一个，名称是 ZeosLib ，看介绍挺强大，几乎支持所有的数据库，用了一下除了有一点通常都会出现的编码的坑之外还不错，把基本的使用做个记录归档以便以后使用。
具体的操作系统是 Windows 10 家庭中文版，版本号是 20H2，操作系统内部版本是 19042.928，用的数据库是 MySQL Community Server 8.0.17 for Win64 on x86_64 。
我用的是 ZeosLib 是 7.2.10，可通过网址 https://sourceforge.net/projects/zeoslib/ 下载获得。
1. 组件的安装
这里只说 Delphi 7 的安装，下载组件压缩文件后解压缩 zeosdbo-7.2.10-stable.zip ，解压缩后的目录下有三个文件夹和两个文件，在其中的找到 packages 文件夹，进入该文件夹后找到 delphi7 文件夹进入，鼠标左键双击 ZeosDbo.bpg 文件，在 Delphi 7 打开后选择菜单栏 Project 中的 Compile All Projects 菜单项，编译完成后选择 OK 按钮。在 Library Path 中增加该组件的路径，路径指向 delphi7 文件夹下的 build 文件夹。在 delphi7 文件夹中找到 ZComponentDesign.dpk 文件，鼠标双击打开，选择 install ，这样组件就会安装好了。
2. 数据库的访问与操作
MySQL 数据库的安装就不再详述了，在 Windows 系统上安装也比较简单，通常一路「下一步」即可安装完毕。我们这里写一个简单的登录示例，成功登录后记录一条登录信息，大概梳理一下流程。
1. 用户打开程序；
1.1. 如果发现没有数据库配置信息，启动数据库配置界面；
1.2 如果有数据库配置信息，启动用户登录界面；
2. 用户完成数据库连接配置
……
3. 用户完成登录
……
4. 记录登录信息
数据库的准备工作
# 数据库脚本
# 创建 examples 数据库
CREATE DATABASE IF NOT EXISTS `examples`
DEFAULT CHARACTER SET utf8mb4 COLLATE utf8mb4_general_ci;
# 创建用户数据表
CREATE TABLE `users` (
`id` int(11) UNSIGNED NOT NULL AUTO_INCREMENT,
`loginname` varchar(50) COLLATE utf8mb4_general_ci NOT NULL,
`pwd` varchar(255) COLLATE utf8mb4_general_ci NOT NULL,
`isadmin` tinyint(1) NOT NULL DEFAuLT '0',
PRIMARY KEY(`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_general_ci;
# 创建用户登录信息表
CREATE TABLE `user_logins` (
`id` int(11) UNSIGNED NOT NULL AUTO_INCREMENT,
`user_id` int(11) NOT NULL,
`login_desc` varchar(150) COLLATE utf8mb4_general_ci NOT NULL,
`login_time` datetime NOT NULL,
PRIMARY KEY(`id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_general_ci;
在 Delphi 7 中新建一个 Application ，再添加一个 Data Module 和两个 Form，将 Data Module 命名为 DataBox，将 Application 自带的 Form 和添加的两个 Form 分别命名为 frm_main 、 frm_login 、frm_dbset，保存工程文件为 LoginExample ，代码如下。
LoginExample.dpr 工程文件
program LoginExample;
uses
Forms,
u_main in 'u_main.pas' {frm_main},
u_databox in 'u_databox.pas' {DataBox : TDataModule},
u_login in 'u_login.pas' {frm_login},
u_dbset in 'u_dbset.pas' {frm_dbset};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TDataBox, DataBox);
if show_FormLogin then
begin
Application.CreateForm(Tfrm_main, frm_main);
end;
Application.Run;
end.
u_databox.pas 单元文件
unit u_databox;
interface
uses
Windows,SysUtils, Classes, ZAbstractConnection, ZConnection, DB,
ZAbstractRODataset, ZAbstractDataset, ZDataset,Registry,
Forms, DCPcrypt2, DCPsha256,Dialogs;
type
TDataBox = class(TDataModule)
ZQOper: TZQuery;
ZC: TZConnection;
ZQLogs: TZQuery;
DCP_sha2561: TDCP_sha256;
procedure DataModuleCreate(Sender: TObject);
private
{ Private declarations }
FDBHost : String;
FDBPort : Integer;
FDBName : String;
FDBConUser : String;
FDBConPwd : String;
public
{ Public declarations }
procedure GetDBConStr;
function GetSha256(s:String):String;
end;
var
DataBox: TDataBox;
OperID: Integer;
Operator: string;
LogsID:string;
CurDir:string;
isAdmin:Boolean;
procedure WriteLogs(sOper:Integer;funid:Integer;funName:string);
implementation
uses u_dbset, DateUtils;
{$R *.dfm}
procedure WriteLogs(sOper:Integer;login_desc:string);
begin
with DataBox.ZQLogs do
begin
Close;
SQL.Clear;
SQL.Add('INSERT INTO user_logins(user_id,login_desc,log_time) VALUES(:uid,:desc,:logtime)');
ParamByName('uid').Value:=sOper;
ParamByName('desc').Value:=funName;
ParamByName('logtime').Value:=Now;
ExecSQL;
end;
end;
procedure TDataBox.GetDBConStr;
var
myReg : TRegistry;
begin
myReg := TRegistry.Create;
with myReg do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey('SOFTWARE\ExampleProg\DBConParam\', False) then
begin
FDBHost := ReadString('DBIP');
FDBPort := StrToInt(ReadString('DBPort'));
FDBName := ReadString('DBName');
FDBConUser := ReadString('DBUser');
FDBConPwd := ReadString('DBPwd');
end;
finally
myReg.CloseKey;
myReg.Free;
end;
end;
procedure TDataBox.DataModuleCreate(Sender: TObject);
begin
GetDBConStr;
if FDBHost = '' then
begin
Application.CreateForm(TfrmDbSet, frmDbSet);
frmDbSet.ShowModal;
end;
GetDBConStr;
with ZC do
begin
Disconnect;
Protocol := 'mysql';
LibraryLocation := ExtractFilePath(Application.ExeName)+'libmysql.dll';
HostName := FDBHost;
Port := FDBPort;
User := FDBConUser;
Password := FDBConPwd;
Database := FDBName;
Connect;
end;
with ZQOper do
begin
Close;
SQL.Text := 'SELECT Count(*) as OperCount FROM users';
Open;
if FieldByName('OperCount').Value = 0 then
begin
Close;
SQL.Text := 'INSERT INTO users(loginname,name,pwd,isAdmin) VALUES(:loginname,:name,:pwd,:isAdmin)';
ParamByName('loginname').Value := 'admin';
ParamByName('name').Value := 'admin';
ParamByName('pwd').Value := GetSha256('admin'); //sha256 admin
ParamByName('isAdmin').Value := 1;
try
ExecSQL;
finally
Close;
end;
end;
end;
end;
function TDataBox.GetSha256(s: String): String;
var
Hash : TDCP_sha256;
Digest : array[0..31] of byte;
Source : String;
i : Integer;
str1 : String;
begin
Source := s; //get s string sha256
if Source <> '' then
begin
Hash := TDCP_sha256.Create(nil); //create the hash
Hash.Init;
Hash.UpdateStr(Source);
Hash.Final(Digest);
str1 := '';
for i:=0 to 31 do
str1 := str1 + IntToHex(Digest[i],2);
end;
Result := str1;
end;
end.
u_dbset.pas 单元文件
unit u_dbset;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Mask, Registry,ZAbstractConnection, ZConnection;
type
TfrmDbSet = class(TForm)
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Bevel1: TBevel;
Label6: TLabel;
lblStatus: TLabel;
edt_ServerName: TEdit;
edt_DBName: TEdit;
edt_ConnUser: TEdit;
edt_Pwd: TEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Panel1: TPanel;
Label1: TLabel;
Image1: TImage;
Panel2: TPanel;
Label1: TLabel;
edt_Port: TEdit;
ZC: TZConnection;
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure BitBtn3Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BitBtn1Click(Sender: TObject);
procedure ZCAfterConnect(Sender: TObject);
procedure ZCAfterDisconnect(Sender: TObject);
procedure RzBitBtn2Click(Sender: TObject);
private
{ Private declarations }
DBConStr: string;
FMacineName: string;
FDBName: string;
FPwd: string;
FConnUser: string;
procedure SetDBConStr;
public
{ Public declarations }
end;
var
frmDbSet: TfrmDbSet;
implementation
uses u_databox,comobj;
{$R *.dfm}
{ TfrmDbSet }
procedure TfrmDbSet.SetDBConStr;
var
myReg:TRegistry;
begin
myReg:=TRegistry.Create;
with myReg do
try
RootKey:=HKEY_CURRENT_USER;
if OpenKey('SOFTWARE\ExampleProg\DBConParam\',True) then
begin
WriteString('DBIP',edt_ServerName.Text);
WriteString('DBPort',edt_Port.Text);
WriteString('DBName',edt_DBName.Text);
WriteString('DBUser',edt_ConnUser.Text);
WriteString('DBPwd', edt_Pwd.Text);
end;
finally
myReg.CloseKey;
myReg.Free;
end;
end;
procedure TfrmDbSet.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_F8) and (ssCtrl in Shift) then
begin
edt_ConnUser.Color := clWhite;
edt_ConnUser.Enabled := True;
edt_ConnUser.SetFocus;
end;
end;
procedure TfrmDbSet.BitBtn3Click(Sender: TObject);
begin
Close;
end;
procedure TfrmDbSet.FormShow(Sender: TObject);
begin
edt_ServerName.SetFocus;
end;
procedure TfrmDbSet.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ZC.Disconnect;
Action:=caFree;
frmDbSet:=nil;
end;
procedure TfrmDbSet.BitBtn1Click(Sender: TObject);
begin
with ZC do
begin
Disconnect;
Protocol := 'mysql';
LibraryLocation := ExtractFilePath(Application.ExeName)+'libmysql.dll';
HostName := edt_ServerName.Text;
Port := StrToInt(edt_Port.Text);
User := edt_ConnUser.Text;
Password := edt_Pwd.Text;
Database := edt_DBName.Text;
Connect;
RzBitBtn2.Enabled := True;
end;
lblStatus.Caption := '连接状态：测试连接成功，已连接！';
end;
procedure TfrmDbSet.ZCAfterConnect(Sender: TObject);
begin
lblStatus.Caption := '连接状态：已连接！';
end;
procedure TfrmDbSet.ZCAfterDisconnect(Sender: TObject);
begin
lblStatus.Caption := '连接状态：未连接！';
end;
procedure TfrmDbSet.BitBtn2Click(Sender: TObject);
begin
SetDBConStr;
Close;
end;
end.
u_login.pas 单元文件
unit u_login;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, ZAbstractRODataset, ZAbstractDataset, ZDataset;
type
Tfrm_login = class(TForm)
Label1: TLabel;
edt_pwd: TEdit;
cbo_username: TComboBox;
Label2: TLabel;
btnLogin: TButton;
ZQUser: TZQuery;
procedure FormCreate(Sender: TObject);
procedure btnLoginClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure cbo_usernameKeyPress(Sender: TObject; var Key: Char);
procedure edt_pwdKeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ZQUserAfterOpen(DataSet: TDataSet);
procedure edt_pwdEnter(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function Show_FormLogin:Boolean;
implementation
uses u_databox;
var
PasswordOK : Boolean;
{$R *.dfm}
function Show_FormLogin:Boolean;
var
frm_login : Tfrm_login;
begin
PasswordOK := False;
frm_login := Tfrm_login.Create(Application);
try
frm_login.ShowModal;
finally
frm_login.Free;
end;
Result := PasswordOK;
end;
procedure Tfrm_login.FormCreate(Sender: TObject);
begin
ZQUser.Close;
ZQUser.Open;
end;
procedure Tfrm_login.btnLoginClick(Sender: TObject);
begin
if ZQUser.Locate('loginname;pwd',
VarArrayOf([cbo_username.Text, DataBox.GetSha256(edt_pwd.Text)]), [loCaseInsensitive]) then
begin
OperID := ZQUser.FieldByName('id').AsInteger;
Operator := cbo_username.Text;
isAdmin := (ZQUser.FieldByName('isAdmin').AsInteger=1);
Application.MessageBox(PChar(Operator + '登录成功'), '登录提示', MB_OK+MB_ICONINFORMATION);
PasswordOK := True;
WriteLogs(OperID,'登录');
if PasswordOK then
Close;
end
else
Application.MessageBox('用户名或密码不正确，登录失败，如忘记密码，请联系管理员！', '错误提示', MB_OK+MB_ICONWARNING);
end;
procedure Tfrm_login.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if not PasswordOK then
begin
CanClose := Application.MessageBox('你真的要退出该软件吗？', '信息提示', MB_YESNO+MB_ICONQUESTION)=IDYES;
WriteLogs(OperID, '退出系统');
end;
end;
procedure Tfrm_login.cbo_usernameKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
edt_pwd.Text := '';
edt_pwd.SetFocus;
end;
end;
procedure Tfrm_login.edt_pwdKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
btnLoginClick(Self);
end;
end;
procedure Tfrm_login.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure Tfrm_login.ZQUserAfterOpen(DataSet: TDataSet);
begin
cbo_username.Items.Clear;
with ZQUser do
begin
First;
while not Eof do
begin
cbo_username.Items.Add(FieldByName('loginname').AsString);
Next;
end;
end;
end;
procedure Tfrm_login.edt_pwdEnter(Sender: TObject);
begin
edt_pwd.Text := '';
end;
end.
完成上述的步骤，这个小的 Demo 就算完成了，有三个地方需要注意一下：
第一，我看我的 IED 中安装了 DCPcrypt2 加密解密组件，随手引用了对密码做哈希处理，这部分如果用于练习的时候可以去掉。
第二，访问 MySQL 数据库需要动态链接库 libmysql.dll ，这个需要注意一下，不管你用 32 位的操作系统还是 64 位的操作系统，同时它也跟你安装的 MySQL 是 32 位的还是 64 位的也没有关系，在 Delphi 7 中使用 MySQL 的时候只能使用这个动态链接库的 32 位版本。
第三，编码问题，Delphi 7 会碰到编码问题，比如向 MySQL 数据库中写入中文会显示乱码，此时在 TZConnection 的 Properties 中添加 codepage=gbk 。另一种处理方式是在使用 TZQuery 等时，在运行 SQL 插入数据语句前，要先运行 set names gbk 。
begin
{这里的 zq1 是一个 TZQuery 控件}
with zq1 do
begin
Close;
SQL.Text := 'set names gbk';
ExecSQL;
SQL.Text := 'INSERT INTO Test(UName) VALUES("张三")';
ExecSQL;
end;
end;
因为是直接在项目中使用后，手工直接在 Notion 中码出来的，并没有写这个 Demo ，所以无法附上 Demo 的源码，对于现在还使用 Delphi 的人来说应该是比较简单的，我其实更多的是给自己做个笔记。但如果有任何问题，可直接通过「关于我」中提供的联系方式与我联系。
– EOF –
