标签归档：Delphi

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 –

不支持replace的数据库的替换处理方式

15条回复

在写一个update SQL 语句的时候需要用到replace替换一部分数据，结果测试数据库选用的是Access，还不支持replace表达式，弄了半天，使用其支持的left，instr，right组合完成替换功能，只能替换一个字符串。

left(str1, instr(str1, str2)-1) + str3 + right(str1, len(str1) – instr(str1, str2) – len(str2)+1)

数据库建模

应用于零售小店的管理系统

35条回复

随着计算机技术的发展，现在PC电脑已经越来越普及了，很多小的零售店也开始逐步使用pc电脑来进行日常销售的管理，辅助于商品上的条码加上扫描枪能够很好的针对小的零售店销售开展工作，这样相比纸张记录来说来的方便很多，而且整体成本也比较低，于是最近开始针对这个应用进行设计与考虑，开始想的很简单，因为应用本身就很简单，但是随着设计的开展，增加了很多的辅助元素，才发现简单性是很难控制的，要想适用范围广就要舍去某些简单性，想象中一个很简单的应用到头来发现却不如想象中的简单。
整体功能预想：
1、能够完成数据字典的管理；
2、简单的权限管理；
3、能够进行简单的会员管理及会员卡管理（非必要)；
4、能够完成商品入库库存盘点的管理；
5、能够完成日常的营业的管理；
6、能够进行统计查询；
根据上面的预想，初步的数据建模图如下所示，仅仅是初始建模，尚需根据调研加深对其业务的理解后的需求进行完善。

数据库建模

数据库建模

一个小小小小工具的总结

25条回复

经常会因为重新做系统忘记备份Favorites目录中的链接，新做完系统后链接就丢失了，昨天晚上闲来就写了个很小小小的工具用于记录Favorites目录中的链接，保存在Xml文件中，并显示在TreeView中，并可打开TreeView中的链接节点。

1、当前用户的Favorites目录搜索获取链接信息

采用递归搜索，使用几个API函数就能完成，主要涉及的API函数为FindFirst、FindNext、GetPrivateProfilestring、ShGetSpecialFolderLocation、ShGetPathfromIDList等，具体使用可参照MSDN。

2、将链接信息保存在xml文件，可以将链接的信息保存在字符串中，直接保存成xml文件，注意保存的时候字符编码采用UTF8格式，否则TXMLDocument处理时会出错，默认的为Ansi，将String转换为UTF8保存即可。

<urls>
 <urlCategory Name="Category Name">
 <urlCategory Name="Category Name">
 <url Name="Url Title">urlPath(e.g. http://www.google.com)</url>
 …
 </urlCategory>
 <url Name="Url Title">urlPath(e.g. http://www.google.com)</url>
 …
 </urlCategory>
 …
 </urls>

3、读取xml文件显示在TreeView中，节点urlCategory为TreeView目录节点，只需获取其Name属性，url为TreeView超链接节点，需要获取Name属性及其节点的value，这里在TreeView显示的是Name属性。需要针对TTreeView进行小小的改造，针对TTreeNode定义TTreeHintNode如下。

TTreeHintNode=class(TTreeNode)
 public:
 constructor Create(AOwner: TTreeNodes);
 procedure Assign(Source: TPersistent); override;
 function GetNodeHint(Node:TTreeNode):string;
 procedure SetNodeHint(Node:TTreeNode;value:string);
 ……