⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form_tmysqltest.pas

📁 通过Tmysql来访问MSQL Server数据库的应用案例.
💻 PAS
字号:
unit form_tmysqltest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls,

  mySQLClient,
  mySQLCommon,
  mySQLAuthDialog;

const
  {Last Modification Information}
  TMYSQLTEST_VERSION       = '2.0c';
  TMYSQLTEST_LAST_MODIFIED = '08.11.2001';
  TMYSQLTEST_LAST_AUTHOR   = 'jpy';

type
  TF_Main = class(TForm)
    PC_All: TPageControl;
    TS_CreateDatabase: TTabSheet;
    TS_PopulateDatabase: TTabSheet;
    TS_QueryDatabase: TTabSheet;
    TS_RemoveAll: TTabSheet;
    TS_Connect: TTabSheet;
    E_ServerHostname: TEdit;
    L_ServerHostname: TLabel;
    B_Connect: TButton;
    L_ThreadedConnect: TLabel;
    L_NonThreadedConnect: TLabel;
    B_CreateDatabase: TButton;
    M_CreateDatabase: TMemo;
    M_Status: TMemo;
    L_PopulateDatabase: TLabel;
    B_NonThreadedExample: TButton;
    LB_Populate: TListBox;
    CB_DoAppProcMesg: TCheckBox;
    L_Query: TLabel;
    LB_Query1: TListBox;
    B_Query: TButton;
    E_Query: TEdit;
    M_Remove: TMemo;
    B_Remove: TButton;
    M_Instructions: TMemo;
    L_QueryDatabase: TLabel;
    LB_Query2: TListBox;
    LB_Query3: TListBox;
    L_CreateUseDatabase: TLabel;
    L_RemoveAll: TLabel;
    mySQLClientThreaded: TmySQLClient;
    mySQLClientNonThreaded: TmySQLClient;
    procedure B_ConnectClick(Sender: TObject);
    procedure mySQLClientThreadedConnect(Sender: TObject);
    procedure mySQLClientNonThreadedConnect(Sender: TObject);
    procedure mySQLClientThreadedConnectError(Sender: TObject;
      Msg: String);
    procedure mySQLClientNonThreadedConnectError(Sender: TObject;
      Msg: String);
    procedure B_CreateDatabaseClick(Sender: TObject);
    procedure AnyThreadedError(Sender: TObject; Msg: String);
    procedure AnyNonthreadedError(Sender: TObject; Msg: String);
    procedure FormCreate(Sender: TObject);
    procedure mySQLClientThreadedStatus(Sender: TObject;
      Status: TmySQLClientTask_StatusType; TaskName: String;
      TasksLeft: Integer);
    procedure mySQLClientNonThreadedStatus(Sender: TObject;
      Status: TmySQLClientTask_StatusType; TaskName: String;
      TasksLeft: Integer);
    procedure B_NonThreadedExampleClick(Sender: TObject);
    procedure B_QueryClick(Sender: TObject);
    procedure B_RemoveClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    FmySQLAuthDialog : TFmySQLAuthDialog;
    CurrentIndex : integer;

    procedure BeginConnect(Sender: TObject);
    procedure CancelConnect(Sender: TObject);

    procedure Query1Finished(Sender: TObject);
    procedure Query2Finished(Sender: TObject);
    procedure Query3Finished(Sender: TObject);
  end;

var
  F_Main: TF_Main;

implementation

{$R *.DFM}

//
// FormCreate
//

procedure TF_Main.FormCreate(Sender: TObject);
var
  R : TRect;
begin
  SystemParametersInfo( SPI_GETWORKAREA, 0, @R, 0 );

  Left:=R.Left+((R.Right-R.Left) div 2) - (Width div 2);
  Top :=R.Top+ ((R.Bottom-R.Top) div 2) - (Height div 2);

  PC_All.ActivePageIndex:=0;
end;

//
// GetRandomString -- Produces a  1 to 255 character string
// of mixed case (a-z and A-Z) characters, for this example application.
//

function GetRandomString : string;
var
  bCase : boolean;
  sTemp : string;
  iLen, i : integer;
begin
  sTemp:='';
  iLen:=Random(254)+1;
  for i:=1 to iLen do begin
    bCase:=(Random(2)=1);
    if bCase then
      sTemp:=sTemp+Chr(Random(25)+Ord('A'))
    else
      sTemp:=sTemp+Chr(Random(25)+Ord('a'));
  end;
  Result:=sTemp;
end;

//
// Connect/Error/Status Procedures - Used to display activity
// on the screen and handle error conditions.
//

procedure TF_Main.AnyThreadedError(Sender: TObject;
  Msg: String);
begin
  M_Status.Lines.Add('Threaded - ERROR '+Msg);
end;

procedure TF_Main.AnyNonThreadedError(Sender: TObject;
  Msg: String);
begin
  M_Status.Lines.Add('Nonthreaded - ERROR '+Msg);
end;

procedure TF_Main.mySQLClientThreadedStatus(Sender: TObject;
  Status: TmySQLClientTask_StatusType; TaskName: String;
  TasksLeft: Integer);
begin
  M_Status.Lines.Add('Threaded - STATUS '+mySQLClientTask_Status[Ord(Status)]+' '+TaskName+' '+IntToStr(TasksLeft));
end;

procedure TF_Main.mySQLClientNonThreadedStatus(Sender: TObject;
  Status: TmySQLClientTask_StatusType; TaskName: String;
  TasksLeft: Integer);
begin
  M_Status.Lines.Add('NonThreaded - STATUS '+mySQLClientTask_Status[Ord(Status)]+' '+TaskName+' '+IntToStr(TasksLeft));
end;

//
// First Example Tab - "Connect" - Procedures
//

procedure TF_Main.B_ConnectClick(Sender: TObject);
begin
  if E_ServerHostname.Text='' then exit;

  B_Connect.Enabled:=FALSE;

  mySQLClientThreaded.Hostname:=E_ServerHostname.Text;

  mySQLClientNonThreaded.Hostname:=E_ServerHostname.Text;

  FmySQLAuthDialog:=TFmySQLAuthDialog.Create(Self);
  FmySQLAuthDialog.Setup(
    'TmySQL Test Application',
    mySQLClientThreaded.Username,
    mySQLClientThreaded.Password,
    BeginConnect,
    CancelConnect,
    []
  );
end;

procedure TF_Main.BeginConnect;
begin
  mySQLClientThreaded.Username:=FmySQLAuthDialog.Username.Text;
  mySQLClientThreaded.Password:=FmySQLAuthDialog.Password.Text;

  mySQLClientThreaded.Connect;

  mySQLClientNonThreaded.Username:=FmySQLAuthDialog.Username.Text;
  mySQLClientNonThreaded.Password:=FmySQLAuthDialog.Password.Text;

  mySQLClientNonThreaded.Connect;
end;

procedure TF_Main.CancelConnect;
begin
  B_Connect.Enabled:=TRUE;
end;

procedure TF_Main.mySQLClientNonThreadedConnect(Sender: TObject);
begin
  L_NonThreadedConnect.Font.Color:=clGreen;
  L_NonThreadedConnect.Caption:='Non-threaded instance: Connected!';
end;

procedure TF_Main.mySQLClientThreadedConnect(Sender: TObject);
begin
  L_ThreadedConnect.Font.Color:=clGreen;
  L_ThreadedConnect.Caption:='Threaded instance: Connected!';

  B_CreateDatabase.Enabled:=TRUE;
end;

procedure TF_Main.mySQLClientThreadedConnectError(Sender: TObject;
  Msg: String);
begin
  M_Status.Lines.Add('Threaded - ERROR '+Msg);
  B_Connect.Enabled:=TRUE;
end;

procedure TF_Main.mySQLClientNonThreadedConnectError(Sender: TObject;
  Msg: String);
begin
  M_Status.Lines.Add('NonThreaded - ERROR '+Msg);
  B_Connect.Enabled:=TRUE;
end;

//
// Second Example Tab - "Create/Use Database" - Procedures
//

procedure TF_Main.B_CreateDatabaseClick(Sender: TObject);
begin
  with mySQLClientNonThreaded do begin
    Utility.PrepareCreateDatabase('tmysqltestdb','Create Database');
    Utility.PrepareSelectDatabase('tmysqltestdb','Use Database');
    Query.Prepare(PChar(M_CreateDatabase.Lines[2]),'Create Table');
    Execute;
  end;

  with mySQLClientThreaded do begin
    Utility.PrepareSelectDatabase('tmysqltestdb','Use Database');
    Execute;
  end;
end;

//
// Third Example Tab - "Populate Database" - Procedures
//

procedure TF_Main.B_NonThreadedExampleClick(Sender: TObject);
var
  i : integer;
  sTemp : string;
begin
  B_NonThreadedExample.Enabled:=FALSE;

  Randomize;

  with MySQLClientNonThreaded do begin
    Query.Prepare('delete from testtable','Delete All Entries');

    LB_Populate.Items.Clear;

    for i:=1 to 2048 do begin
      sTemp:=GetRandomString;

      Modify.Reset;
      Modify.Add('name',PChar(''''+sTemp+''''));
      Modify.PrepareInsertTask('testtable','Add Entry',nil,AnyNonThreadedError);
      Execute;

//
// Here is an example of a way to add strings when you need to accurately
// quote them:
//
// var
//      pTemp : array[0..258] of char;
//      iLen : integer;
// ...
//      iLen:=Length(sTemp);
//      Modify.Add('name',Quote(pTemp,PChar(sTemp),iLen,[]));
//

      LB_Populate.Items.Add(IntToStr(i)+': '+sTemp);
      LB_Populate.ItemIndex:=LB_Populate.Items.Count-1;

//
// A 'hack' to keep the interface _somewhat_ in sync when using TmySQL in
// a non-threaded fashion is to call the TApplication.ProcessMessages method.
// You can test this by clicking on the checkbox in the "Populate Database"
// example.  On Windows 2000 (and others, I'm sure), you'll notice that while
// you have the left mouse button held down on the title bar, the population
// of the database will cease.
//
// Note: for large sequential activities (such as mass-inserts or updates),
// it is wise to use the NON-THREADED mode of TmySQL within your own custom
// TThread.
//
// Also, if you intend to do 'piggy back' tasks -- after a task finishing
// (OnComplete) you add a new task and Execute -- you may run into problems
// with TmySQL's TThread getting stuck in a suspended state.  Instead of
// doing this, write your own TThread and call a NON-THREADED instance of
// TmySQL.
//
// The built-in THREADED mode of TmySQL is best used for interactive use
// of a mySQL database, as you'll see in the "Query Database" example.
//

      if CB_DoAppProcMesg.Checked then
        Application.ProcessMessages;

    end;
  end;

  B_NonThreadedExample.Enabled:=TRUE;
end;

//
// Fourth Example Tab - "Query Database" - Procedures
//

procedure TF_Main.B_QueryClick(Sender: TObject);
var
  pQueryCondition : array[0..258] of char;
begin
  LB_Query1.Items.Clear;
  LB_Query2.Items.Clear;
  LB_Query3.Items.Clear;

  B_Query.Enabled:=FALSE;

  StrPCopy(pQueryCondition,'');

  if E_Query.Text='' then
    StrCopy(pQueryCondition,PChar(' where name like '+QuoteString('%'+E_Query.Text+'%',[])));

  //
  // Here is an example where three queries are sent to the 'Task Queue'
  // to be handled in order.  Note: only use the Execute command once after
  // the last entry (as shown below).
  //

  MySQLClientThreaded.Query.PrepareTask(
    PChar('select id, md5(name) from testtable'+pQueryCondition),
    'Search 1',
    Query1Finished,
    AnyThreadedError);

  MySQLClientThreaded.Query.PrepareTask(
    PChar('select id, substring(name,1,10) as sub2 from testtable'+pQueryCondition+' order by sub2'),
    'Search 2',
    Query2Finished,
    AnyThreadedError);

  MySQLClientThreaded.Query.PrepareTask(
    PChar('select id, substring(name,1,10) as sub3 from testtable'+pQueryCondition+' order by sub3 desc'),
    'Search 3',
    Query3Finished,
    AnyThreadedError);

  MySQLClientThreaded.Execute;
end;

procedure TF_Main.Query1Finished(Sender: TObject);
var
  i : integer;
begin
  with MySQLClientThreaded do begin
    for i:=0 to Query.DataCount-1 do begin
      LB_Query1.Items.Add(Query.Data(i,0)+': '+Query.Data(i,1));
    end;
  end;

  B_Query.Enabled:=TRUE;
end;

procedure TF_Main.Query2Finished(Sender: TObject);
var
  i : integer;
begin
  with MySQLClientThreaded do begin
    for i:=0 to Query.DataCount-1 do begin
      LB_Query2.Items.Add(Query.Data(i,0)+': '+Query.Data(i,1));
    end;
  end;

  B_Query.Enabled:=TRUE;
end;

procedure TF_Main.Query3Finished(Sender: TObject);
var
  i : integer;
begin
  with MySQLClientThreaded do begin
    for i:=0 to Query.DataCount-1 do begin
      LB_Query3.Items.Add(Query.Data(i,0)+': '+Query.Data(i,1));
    end;
  end;

  B_Query.Enabled:=TRUE;
end;

//
// Fifth Example Tab - "Remove All" - Procedure
//

procedure TF_Main.B_RemoveClick(Sender: TObject);
begin
  with mySQLClientNonThreaded do begin
    Modify.PrepareDelete('testtable','','Delete All');
    Modify.PrepareDropTable('testtable','Drop Table');
    Utility.PrepareDropDatabase('tmysqltestdb','Drop Database');
    Execute;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -