「11.Lazarus数据库编程」12.嵌入式数据库管理工具开发案例(2)

科技 06-20 来源： IT职业教育

12.嵌入式数据库管理工具开发案例(2)

本节在上一节创建数据库的基础上完成在嵌入式数据库管理工具中执行 SQL 语句，也就是说本节将介绍的是数据库操作部分。

12.1 数据模块

数据模块的声明部分：

TEdbDM = class(TDataModule)
    ZDBConnection: TZConnection;
    ZDBSQLMonitor: TZSQLMonitor;
    ZDBQuery: TZQuery;
    procedure ZDBSQLMonitorLogTrace(Sender: TObject; Event: TZLoggingEvent);
    procedure ZDBSQLMonitorTrace(Sender: TObject; Event: TZLoggingEvent; var LogTrace: Boolean);
  private

  public
    DatabaseType: String;
    DatabaseFile: String;

  end;

在数据模块中，我们声明了：

TZConnection - 数据库连接组件
TZSQLMonitor - 数据库监控组件，用于记录数据库上的操作日志
TZQuery - 查询组件，用于查询数据

TZSQLMonitor 组件的属性设置：

Active - True
AutoSave - True
FileName - trace.log

TZQuery 组件的属性设置：

Connection - ZDBConnection

ZDBConnection 组件的属性不设置，因为是动态连接。

数据模块声明中的两个公共变量 DatabaseType 和 DatabaseFile，表示当前连接的数据库及数据库文件。

12.2 主窗体声明

主窗体界面如下图所示：

主窗体说明：

左侧的 Tab 中包含页：表和视图，分别用于显示数据库中已经存在的表及视图，双击或选择“表数据”和“视图数据”按钮可以查看数据。右侧上面的区域是 SQL 编辑器，可以在这里编写 SQL 语句，然后单击相应的按钮执行 SQL 语句。本节主要介绍内容为：

连接数据库
查看数据库对象
执行 SQL 语句
断开数据库连接

主窗体声明代码如下：

TMainForm = class(TForm)
    FileNameLabel: TLabel;
    SaveAsButton: TButton;
    NewButton: TButton;
    LogFileLabel: TLabel;
    SetupLogFileButton: TButton;
    CreateSpeedButton: TSpeedButton;
    SQLTemplateButton: TButton;
    SqlTemplateComboBox: TComboBox;
    ExecCommandButton: TButton;
    CleanSQLButton: TButton;
    OpenFileButton: TButton;
    ScriptFileSaveDialog: TSaveDialog;
    SaveFileButton: TButton;
    ExecScriptFileButton: TButton;
    ScriptFileOpenDialog: TOpenDialog;
    Panel9: TPanel;
    ConnectSpeedButton: TSpeedButton;
    DisconnectSpeedButton: TSpeedButton;
    SpeedButton3: TSpeedButton;
    CleanLogButton: TButton;
    LogMemo: TMemo;
    Panel8: TPanel;
    ResultPageControl: TPageControl;
    Panel7: TPanel;
    QuerySQLEdit: TEdit;
    DataTabSheet: TTabSheet;
    LogTabSheet: TTabSheet;
    ViewDataButton: TButton;
    TableDataButton: TButton;
    RefreshTableButton: TButton;
    RefreshViewButton: TButton;
    ExecQueryButton: TButton;
    ExecScriptButton: TButton;
    GridDataSource: TDataSource;
    QueryDBGrid: TDBGrid;
    CurrentDatabaseLabel: TLabel;
    TableListBox: TListBox;
    ViewListBox: TListBox;
    SqlMemo: TMemo;
    PageControl1: TPageControl;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    procedure CleanLogButtonClick(Sender: TObject);
    procedure CleanSQLButtonClick(Sender: TObject);
    procedure CreateSpeedButtonClick(Sender: TObject);
    procedure DisconnectSpeedButtonClick(Sender: TObject);
    procedure ExecCommandButtonClick(Sender: TObject);
    procedure ExecQueryButtonClick(Sender: TObject);
    procedure ExecScriptButtonClick(Sender: TObject);
    procedure ExecScriptFileButtonClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure NewButtonClick(Sender: TObject);
    procedure OpenFileButtonClick(Sender: TObject);
    procedure RefreshTableButtonClick(Sender: TObject);
    procedure RefreshViewButtonClick(Sender: TObject);
    procedure SaveAsButtonClick(Sender: TObject);
    procedure SaveFileButtonClick(Sender: TObject);
    procedure ConnectSpeedButtonClick(Sender: TObject);
    procedure SetupLogFileButtonClick(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SqlMemoChange(Sender: TObject);
    procedure SQLTemplateButtonClick(Sender: TObject);
    procedure TableDataButtonClick(Sender: TObject);
    procedure TableListBoxDblClick(Sender: TObject);
    procedure ViewDataButtonClick(Sender: TObject);
    procedure ViewListBoxDblClick(Sender: TObject);
  private
    // SQL 编辑器功能
    HasSaved: Boolean;     // 是否需要保存
    SavedFileName: String;   // 当前保存的文件名
    // 窗体 UI
    procedure UIEnable;
    procedure UIDisable;
    procedure SetupUI;
    // 读取已经建立的数据表和视图
    procedure ReadTables;
    procedure ReadViews;
    // 数据库操作
    procedure ReadSQLData(sSql: String);  // 执行SQL，读取数据
    procedure ExecSQLScript(sSql: String);   // 执行SQL脚本
    procedure ExecSQLCommand(sSql: String);   // 执行SQL指令
    // SQL 编辑器功能
    procedure NewFile;
    procedure OpenFile;
    procedure SaveFile;
    function SaveAsFile:Boolean;
  public

  end;

在主窗体打开后未连接数据库的情况下，需要对界面上的按钮进行控制，即所以操作 SQL 的按钮均不可用，当连接成功数据库后可以使用。这部分代码主要在如下过程中体现：

procedure UIEnable;
procedure UIDisable;
procedure SetupUI;

对数据库的操作也做了一些封装，读取数据库对象包括：

procedure ReadTables;
procedure ReadViews;

数据库操作包括：

procedure ReadSQLData(sSql: String);
procedure ExecSQLScript(sSql: String);
procedure ExecSQLCommand(sSql: String);

关于窗体组件的可用性代码如下：

procedure TMainForm.UIEnable;
begin
   // 连接
   ConnectSpeedButton.Enabled:=False;

   // 断开
   DisconnectSpeedButton.Enabled:=True;
   // 表列表上的按钮
   RefreshTableButton.Enabled:=True;
   TableDataButton.Enabled:=True;
   // 视图列表上的按钮
   RefreshViewButton.Enabled:=True;
   ViewDataButton.Enabled:=True;
   // SQL编辑器上的按钮
   ExecQueryButton.Enabled:=True;
   ExecCommandButton.Enabled:=True;
   ExecScriptButton.Enabled:=True;
   ExecScriptFileButton.Enabled:=True;
end;

procedure TMainForm.UIDisable;
begin
   // 连接
   ConnectSpeedButton.Enabled:=True;
   // 断开
   DisconnectSpeedButton.Enabled:=False;
   // 表列表上的按钮
   RefreshTableButton.Enabled:=False;
   TableDataButton.Enabled:=False;
   // 视图列表上的按钮
   RefreshViewButton.Enabled:=False;
   ViewDataButton.Enabled:=False;
   // SQL编辑器上的按钮
   ExecQueryButton.Enabled:=False;
   ExecCommandButton.Enabled:=False;
   ExecScriptButton.Enabled:=False;
   ExecScriptFileButton.Enabled:=False;

   TableListBox.Items.Clear;
   ViewListBox.Items.Clear;
   SqlMemo.Clear;
   QuerySQLEdit.Text:='';
   QueryDBGrid.Clear;
   LogMemo.Clear;
end;

procedure TMainForm.SetupUI;
begin
  // 对界面上的组件可用性进行设置
  if EdbDM.ZDBConnection.Connected then
    UIEnable
  else
    UIDisable;
end;

当窗体创建时，创建事件代码：

procedure TMainForm.FormCreate(Sender: TObject);
var
  ExeName, Path: String;
begin
  CurrentDatabaseLabel.Caption:='';
  FileNameLabel.Caption:='';

  UIDisable;
end;

12.3 连接数据库

连接数据库需要打开一个新的窗体，在窗体中设置好需要连接的数据库文件后建立连接，数据库连接窗体设计如下图所示：

窗体声明代码：

TConnForm = class(TForm)
    DBComboBox: TComboBox;
    Label1: TLabel;
    OpenButton: TButton;
    ConnectButton: TButton;
    CancelButton: TButton;
    DatabaseFileEdit: TEdit;
    DatabaseOpenDialog: TOpenDialog;
    Label3: TLabel;
    procedure CancelButtonClick(Sender: TObject);
    procedure ConnectButtonClick(Sender: TObject);
    procedure DBComboBoxChange(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure OpenButtonClick(Sender: TObject);
  private

  public

  end;

窗体中 DBComboBox 组件设置其选项 Items 的属性值为：

sqlite-3
firebird-2.5

由于 DBComboBox 组件的选择会影响 DatabaseOpenDialog 对话框的过滤器，以帮助用户过滤显示的文件，所以，需要 DBComboBox 组件的 OnChange事件，代码如下：

procedure TConnForm.DBComboBoxChange(Sender: TObject);
begin
  // 数据库选项改变时同时改变打开文件的过滤器
  if DBComboBox.Text = 'sqlite-3' then
     DatabaseOpenDialog.Filter:='SQLite|*.db';
  if DBComboBox.Text = 'firebird-2.5' then
     DatabaseOpenDialog.Filter:='FireBird|*.fdb';
end;

选择数据库文件的按钮的单击事件：

procedure TConnForm.OpenButtonClick(Sender: TObject);
begin
  // 选择打开数据库文件
  DatabaseOpenDialog.FileName:='';
  if DatabaseOpenDialog.Execute then
    DatabaseFileEdit.Text:=DatabaseOpenDialog.FileName;
end;

连接按钮的单击事件代码：

procedure TConnForm.ConnectButtonClick(Sender: TObject);
begin
  // 连接
  if DBComboBox.Text = '' then
  begin
    MessageDlg('提示', '请选择数据库！', mtError, [mbOK], 0);
    Exit;
  end;
  if DatabaseFileEdit.Text = '' then
  begin
    MessageDlg('提示', '请设置数据库文件！', mtError, [mbOK], 0);
    Exit;
  end;

  if not FileExists(DatabaseFileEdit.Text) then
  begin
    MessageDlg('提示', '您设置的数据库文件不存在，请重新设置！', mtError, [mbOK], 0);
    Exit;
  end;

  EdbDM.DatabaseType:=DBComboBox.Text;;
  EdbDM.DatabaseFile:=DatabaseFileEdit.Text;

  ModalResult := mrOk;
end;

可以看到在该窗体中并没有真正与数据库建立连接，而只是设置了数据模块的两个全局变量。真正建立连接的代码在主窗体的“连接”按钮的单击事件中，代码如下：

procedure TMainForm.ConnectSpeedButtonClick(Sender: TObject);
begin
  // 连接
  if ConnForm.ShowModal = mrOk then
  with EdbDM.ZDBConnection do
  begin
    if (EdbDM.DatabaseType <> 'sqlite-3') and (EdbDM.DatabaseType <> 'firebird-2.5') then
    begin
       MessageDlg('错误', '不支持的数据库！', mtError, [mbOK], 0);
       Exit;
    end;

    // 数据库文件
    Database := EdbDM.DatabaseFile;
    // 协议
    Protocol := EdbDM.DatabaseType;
    // dll 文件
    if EdbDM.DatabaseType = 'sqlite-3' then
       LibraryLocation := 'sqlite3.dll';
    if EdbDM.DatabaseType = 'firebird-2.5' then
       LibraryLocation := 'fbembed.dll';

    try
      Connected := True;
    except
       on E: EDatabaseError do
       begin
         ResultPageControl.ActivePageIndex:=1;
         LogMemo.Append('DB ERROR:' + E.ClassName + chr(13) + chr(10) + E.Message);
       end;
       on E: Exception do
       begin
         ResultPageControl.ActivePageIndex:=1;
         LogMemo.Append('ERROR:' + E.ClassName + chr(13) + chr(10) + E.Message);
       end;
    end;

    if Connected then
    begin
      CurrentDatabaseLabel.Caption:='['+EdbDM.DatabaseType+']'+EdbDM.DatabaseFile;
      MessageDlg('提示', '连接成功！', mtInformation, [mbOK], 0);
      SetupUI;
      ReadTables;
      ReadViews;
    end
    else
      MessageDlg('提示', '连接失败！', mtError, [mbOK], 0);
  end;
end;

可以看到，当连接成功后，我们对窗体的组件进行了可见性设置的调用，即调用了 SetupUI，同时调用 ReadTables 和 ReadViews 过程，以读取数据库上已经存在的数据表和视图。

12.4 查看数据库对象

查看数据库对象就是上面代码中调用的ReadTables 和 ReadViews 过程，在主窗体的左侧的 Tab 组件上显示的内容。首先我们来看一下 ReadTables 和 ReadViews 过程：

procedure TMainForm.ReadTables;
var
  Query: TZQuery;
  sSql: String;
begin
  // 读取数据库中所有的表
  if EdbDM.DatabaseType = 'sqlite-3' then
     sSql := 'select tbl_name as table_name from sqlite_master where type=''table''';
  if EdbDM.DatabaseType = 'firebird-2.5' then
     sSql := 'SELECT a.RDB$RELATION_NAME as table_name FROM RDB$RELATIONS a WHERE RDB$SYSTEM_FLAG = 0 AND RDB$RELATION_TYPE = 0';


  Query := TZQuery.Create(Self);
  try
    Query.Connection := EdbDM.ZDBConnection;

    Query.Close;
    Query.SQL.Text := sSql;
    Query.Open;

    TableListBox.Clear;
    while not Query.EOF do
    begin
      TableListBox.Items.Add(Query.FieldByName('table_name').AsString);
      Query.Next;
    end;
    Query.Close;
  except
     on E: EDatabaseError do
     begin
       ResultPageControl.ActivePageIndex:=1;
       LogMemo.Append('DB ERROR: '+sSql+chr(13)+chr(10)+E.ClassName+chr(13)+chr(10)+E.Message);
     end;
     on E: Exception do
     begin
       ResultPageControl.ActivePageIndex:=1;
       LogMemo.Append('ERROR: '+sSql+chr(13)+chr(10)+E.ClassName+chr(13)+chr(10)+E.Message);
     end;
  end;
  Query.Destroy;

end;

procedure TMainForm.ReadViews;
var
  Query: TZQuery;
  sSql: String;
begin
  // 读取数据库中所有的视图
  if EdbDM.DatabaseType = 'sqlite-3' then
     sSql := 'select tbl_name as view_name from sqlite_master where type=''view''';
  if EdbDM.DatabaseType = 'firebird-2.5' then
     sSql := 'SELECT a.RDB$RELATION_NAME as view_name FROM RDB$RELATIONS a WHERE RDB$SYSTEM_FLAG = 0 AND RDB$RELATION_TYPE = 1';

  Query := TZQuery.Create(Self);
  try
    Query.Connection := EdbDM.ZDBConnection;

    Query.Close;
    Query.SQL.Text := sSql;
    Query.Open;

    ViewListBox.Clear;
    while not Query.EOF do
    begin
      ViewListBox.Items.Add(Query.FieldByName('view_name').AsString);
      Query.Next;
    end;
    Query.Close;
  except
     on E: EDatabaseError do
     begin
       ResultPageControl.ActivePageIndex:=1;
       LogMemo.Append('DB ERROR: '+sSql+chr(13)+chr(10)+E.ClassName+chr(13)+chr(10)+E.Message);
     end;
     on E: Exception do
     begin
       ResultPageControl.ActivePageIndex:=1;
       LogMemo.Append('ERROR: '+sSql+chr(13)+chr(10)+E.ClassName+chr(13)+chr(10)+E.Message);
     end;
  end;
  Query.Destroy;
end;

读取表的 SQL 语句：

SQLite

select tbl_name as table_name from sqlite_master where type='table'

FireBird

SELECT a.RDB$RELATION_NAME as table_name FROM RDB$RELATIONS a WHERE RDB$SYSTEM_FLAG = 0 AND RDB$RELATION_TYPE = 0

读取视图的 SQL 语句：

SQLite

select tbl_name as view_name from sqlite_master where type='view''

FireBird

SELECT a.RDB$RELATION_NAME as view_name FROM RDB$RELATIONS a WHERE RDB$SYSTEM_FLAG = 0 AND RDB$RELATION_TYPE = 1

因为执行上面的 SQL 语句后，我们将数据读取出来并写入到对应的 ListBox，所以在读取数据库对象时我们没有使用数据模块中的 TZQuery 组件，而是使用了局部变量 Query: TZQuery 来执行查询语句。

在左侧的 Tab 页中可以查询表或视图的数据，对应的代码如下：

procedure TMainForm.TableDataButtonClick(Sender: TObject);
var
  TableName: String;
  sSql: String;
begin
  // 表数据
  if TableListBox.ItemIndex < 0 then
  begin
    MessageDlg('提示', '请选择数据表！', mtInformation, [mbOK], 0);
    Exit;
  end;

  TableName := TableListBox.Items[TableListBox.ItemIndex];
  sSql := 'SELECT * FROM ' + TableName;
  ReadSQLData(sSql);
end;       


procedure TMainForm.ViewDataButtonClick(Sender: TObject);
var
  ViewName: String;
  sSql: String;
begin
  // 视图数据
  if ViewListBox.ItemIndex < 0 then
  begin
    MessageDlg('提示', '请选择数据视图！', mtInformation, [mbOK], 0);
    Exit;
  end;

  ViewName := ViewListBox.Items[ViewListBox.ItemIndex];
  sSql := 'SELECT * FROM ' + ViewName;
  ReadSQLData(sSql);
end;

此处调用了封装好的 ReadSQLData 过程，传递的参数是 SQL 语句。

12.5 执行 SQL

对于执行 SQL 语句来说，由于都是统一的使用方法，所以我们针对执行的 SQL 情况进行分类封装：

procedure ReadSQLData(sSql: String); - 执行 select 语句并将结果显示在 DBGrid 中
procedure ExecSQLScript(sSql: String); - 执行 SQL 脚本
procedure ExecSQLCommand(sSql: String); - 执行select 以外的其他 SQL 语句

封装代码如下：

procedure TMainForm.ReadSQLData(sSql: String);
begin
  // 执行 SQL 语句，在 DBGrid 中显示
  try
     ResultPageControl.ActivePageIndex:=1;

     with EdbDM.ZDBQuery do
     begin
        Close;
        SQL.Clear;
        SQL.Text := sSql;
        Open;

        QuerySQLEdit.Text:=sSql;
        ResultPageControl.ActivePageIndex:=0;
     end;
  except
     on E: EDatabaseError do
     begin
       ResultPageControl.ActivePageIndex:=1;
       LogMemo.Append('DB ERROR: '+sSql+chr(13)+chr(10)+E.ClassName+chr(13)+chr(10)+E.Message);
     end;
     on E: Exception do
     begin
       ResultPageControl.ActivePageIndex:=1;
       LogMemo.Append('ERROR: '+sSql+chr(13)+chr(10)+E.ClassName+chr(13)+chr(10)+E.Message);
     end;
  end;
end;

procedure TMainForm.ExecSQLCommand(sSql: String);
var
  Query: TZQuery;
begin
  // 执行 SQL 命令语句
  try
     ResultPageControl.ActivePageIndex:=1;

     Query := TZQuery.Create(Self);

     with Query do
     begin
        Close;
        SQL.Clear;
        SQL.Text := sSql;
        ExecSQL;
     end;
     
     Query.Destroy; 
  except
     on E: EDatabaseError do
     begin
       ResultPageControl.ActivePageIndex:=1;
       LogMemo.Append('DB ERROR: '+sSql+chr(13)+chr(10)+E.ClassName+chr(13)+chr(10)+E.Message);
     end;
     on E: Exception do
     begin
       ResultPageControl.ActivePageIndex:=1;
       LogMemo.Append('ERROR: '+sSql+chr(13)+chr(10)+E.ClassName+chr(13)+chr(10)+E.Message);
     end;
  end;
end; 

procedure TMainForm.ExecSQLScript(sSql:String);
var
  Processor: TZSQLProcessor;
begin
  // 执行 SQL 脚本
  try
    ResultPageControl.ActivePageIndex:=1;

    Processor := TZSQLProcessor.Create(Self);
    Processor.Connection := EdbDM.ZDBConnection;
    Processor.Script.Clear;
    Processor.Script.Add(sSql);
    Processor.Execute;
    Processor.Destroy;
  except
     on E: EDatabaseError do
     begin
       ResultPageControl.ActivePageIndex:=1;
       LogMemo.Append('DB ERROR: '+sSql+chr(13)+chr(10)+E.ClassName+chr(13)+chr(10)+E.Message);
     end;
     on E: Exception do
     begin
       ResultPageControl.ActivePageIndex:=1;
       LogMemo.Append('ERROR: '+sSql+chr(13)+chr(10)+E.ClassName+chr(13)+chr(10)+E.Message);
     end;
  end;
end;

由于 ReadSQLData 过程执行 select 语句后要将数据显示到 DBGrid 中，所以使用了数据模块中的 TZQuery 组件，而其他两个过程不需要显示数据，所以使用局部变量来完成操作。

对于该工具来说，需要执行 SQL 语句的按钮包括：执行查询、执行命令、执行脚本、执行 SQL 文件，这些按钮的单击事件代码如下:

procedure TMainForm.ExecQueryButtonClick(Sender: TObject);
var
  sSql: String;
begin
  // 执行查询
  if SqlMemo.SelLength > 0 then sSql:=SqlMemo.SelText else sSql:=SqlMemo.Text;

  sSql := sSql.TrimLeft;
  sSql := sSql.TrimRight;

  if not UpperCase(sSql).StartsWith('SELECT') then
  begin
    MessageDlg('提示', '该操作只能执行 SQL SELECT 语句！', mtInformation, [mbOK], 0);
    Exit;
  end;
  ReadSQLData(sSql);
end;

procedure TMainForm.ExecCommandButtonClick(Sender: TObject);
var
  sSql: String;
begin
  // 执行命令
  if SqlMemo.SelLength > 0 then sSql:=SqlMemo.SelText else sSql:=SqlMemo.Text;

  sSql := sSql.TrimLeft;
  sSql := sSql.TrimRight;

  if UpperCase(sSql).StartsWith('SELECT') then
  begin
    MessageDlg('提示', '该操作不能执行 SQL SELECT 语句！', mtInformation, [mbOK], 0);
    Exit;
  end;

  ExecSQLCommand(sSql);
end;

procedure TMainForm.ExecScriptButtonClick(Sender: TObject);
var
  sSql: String;
begin
  // 执行脚本
  if SqlMemo.SelLength > 0 then sSql:=SqlMemo.SelText else sSql:=SqlMemo.Text;

  sSql := sSql.TrimLeft;
  sSql := sSql.TrimRight;

  ExecSQLScript(sSql);
end;

procedure TMainForm.ExecScriptFileButtonClick(Sender: TObject);
var
  F: TextFile;
  sSql: String;
  sLine: String;
begin
  // 执行脚本文件
  if not ScriptFileOpenDialog.Execute then Exit;

  sSql := '';

  AssignFile(F, ScriptFileOpenDialog.FileName);
  Reset(F);
  while not EOF(F) do
  begin
    Readln(F, sLine);
    sSql := sSql + sLine;
  end;
  CloseFile(F);

  ExecSQLScript(sSql);
end;

代码比较简单，不再赘述。

12.6 断开连接

断开数据库连接的代码非常简单，如下所示：

procedure TMainForm.DisconnectSpeedButtonClick(Sender: TObject);
begin
  // 断开连接
  if EdbDM.ZDBConnection.Connected then
  begin
    EdbDM.ZDBConnection.Connected := False;
    CurrentDatabaseLabel.Caption:='';
    SetupUI;
  end;
end;

断开数据库连接后做一些界面的可用性设置，同时将当前连接的数据库的显示 Label 设置为空。