分类目录归档：Delphi/Pascal

这个分类中归类 Delphi/Pascal 的内容

Delphi 7 操作 MySQL 数据库一例

发表评论

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 –