Crlab公司用来连接MySQL数据库的控件
源代码在线查看: command.pas
unit Command;
interface
uses
{$IFNDEF LINUX}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, ToolWin, ComCtrls, MyDacVcl, Buttons,
{$ELSE}
SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls,
QButtons, QDBCtrls, QComCtrls, QExtCtrls, QGrids, QDBGrids,
{$ENDIF}
Db, DAScript, DBAccess, MyAccess, DemoFrame, MyScript, MyDacDemoForm;
type
TCommandFrame = class(TDemoFrame)
ToolBar: TPanel;
meSQL: TMemo;
Label1: TLabel;
Splitter1: TSplitter;
meResult: TMemo;
Panel1: TPanel;
btExecute: TSpeedButton;
MyCommand: TMyCommand;
btBreakExec: TSpeedButton;
btExecInThread: TSpeedButton;
procedure btExecuteClick(Sender: TObject);
procedure MySQLAfterExecute(Sender: TObject; Result: Boolean);
procedure btBreakExecClick(Sender: TObject);
procedure btExecInThreadClick(Sender: TObject);
private
{ Private declarations }
public
// Demo management
procedure Initialize; override;
procedure SetDebug(Value: boolean); override;
end;
{ TExecThread }
TExecThread = class(TThread)
protected
procedure Execute; override;
procedure Terminate;
end;
var
CommandFrame: TCommandFrame;
implementation
{$IFDEF CLR}
{$R *.nfm}
{$ENDIF}
{$IFDEF WIN32}
{$R *.dfm}
{$ENDIF}
{$IFDEF LINUX}
{$R *.xfm}
{$ENDIF}
procedure LogError(EMessage: string);
begin
CommandFrame.meResult.Lines.Add('An error with the following message has beein raised during query execution:' + #13#10 + EMessage);
end;
{ TExecThread }
procedure TExecThread.Execute;
begin
if CommandFrame.MyCommand nil then
try
CommandFrame.btBreakExec.Enabled := True;
CommandFrame.MyCommand.Execute;
except
on e: Exception do begin
LogError(e.Message);
end;
end;
Terminate;
end;
procedure TExecThread.Terminate;
begin
inherited;
CommandFrame.btBreakExec.Enabled := False;
end;
{ TCommandFrame }
procedure TCommandFrame.btExecuteClick(Sender: TObject);
begin
MyCommand.SQL := meSQL.Lines;
MyDACForm.StatusBar.Panels[2].Text := 'Executing...';
meResult.Lines.Clear;
try
MyCommand.Execute;
except
on e: Exception do begin
LogError(e.Message);
end;
end;
end;
procedure TCommandFrame.btBreakExecClick(Sender: TObject);
begin
MyCommand.BreakExec;
end;
procedure TCommandFrame.btExecInThreadClick(Sender: TObject);
begin
MyCommand.SQL := meSQL.Lines;
MyDACForm.StatusBar.Panels[2].Text := 'Executing...';
meResult.Lines.Clear;
TExecThread.Create(False);
end;
procedure TCommandFrame.MySQLAfterExecute(Sender: TObject; Result: Boolean);
var
s: string;
begin
if Result then
s := 'Success' + ' (' + IntToStr(MyCommand.RowsAffected) + ' rows processed)'
else
s := 'Execution failed';
meResult.Lines.Add(s);
MyDACForm.StatusBar.Panels[2].Text := s;
end;
// Demo management
procedure TCommandFrame.Initialize;
begin
CommandFrame := self;
MyCommand.Connection := Connection as TCustomMyConnection;
MyCommand.SQL := meSQL.Lines;
end;
procedure TCommandFrame.SetDebug(Value: boolean);
begin
MyCommand.Debug := Value;
end;
end.