mysqlthread.pas

MYSQL 连接控件 MYSQL 连接控件

//	Author:			Jacques Venter, [e-mail]
//	Copyright:		1999,2000,2001,2002,2003,2004 SciBit - Scientific Bitware (Pty) Ltd
//	Version:			2004.1.1.0
//	Comments:		The MySQLDatasetThread, descendants and utility classes
//	History:
//						2002.1.0.0
//							First release, Windows/Delphi only for first release
//
//   Licensing
//
//       Copyright (c) 1998-2004 SciBit - Scientific Bitware (Pty) Ltd
//       ALL RIGHTS RESERVED
//
//  The entire contents of this file is protected by South African and
//  International Copyright Laws. Unauthorized reproduction,
//  reverse-engineering, and distribution of all or any portion of
//  the code contained in this file is strictly prohibited and may
//  result in severe civil and criminal penalties and will be
//  prosecuted to the maximum extent possible under the law.
//
//  RESTRICTIONS
//
//  THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES
//  (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE
//  SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS
//  LICENSED TO DISTRIBUTE THE SOURCECODE AND ALL
//  ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY.
//
//  THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED
//  FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE
//  COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE
//  AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT
//  AND PERMISSION FROM SciBit - Scientific Bitware (Pty) Ltd
//
//  CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON
//  ADDITIONAL RESTRICTIONS.
//
//*******************************************************************

unit MySQLThread;

interface
{$I product.inc}
uses
	DB,Classes,Messages,SyncObjs,SysUtils,
{$IFDEF MSWINDOWS}
  Windows,
	{$IFNDEF CONSOLEAPP}
	Controls,
	{$ENDIF}
  {$IFDEF DELPHI5}
  	Forms,
  {$ENDIF}
  {$IFDEF DELPHI6UP}
  	Variants,
  {$ENDIF}
{$ENDIF}
{$IFDEF LINUX}
	Libc,Variants,WinUtils,
	{$IFNDEF CONSOLEAPP}
	QControls,
	{$ENDIF}
{$ENDIF}
	MySQLServer,MySQLDataset;
const
	MYSQL_START = WM_USER + $00BB;

	MYSQL_NOTIFY_START   = MYSQL_START;
	MYSQL_NOTIFY_EXCEPT 	= MYSQL_NOTIFY_START + 0;
	MYSQL_NOTIFY_MSG	 	= MYSQL_NOTIFY_START + 1;
	MYSQL_NOTIFY_STATUS 	= MYSQL_NOTIFY_START + 2;
	MYSQL_NOTIFY_TASK	 	= MYSQL_NOTIFY_START + 3;
	MYSQL_PROGRESS			= MYSQL_NOTIFY_START + 4;
	MYSQL_PROGRESS_POS	= MYSQL_NOTIFY_START + 5;
	MYSQL_PROGRESS_SPEED	= MYSQL_NOTIFY_START + 6;

  stNone				= $00;
  stIdle				= $01;
  stError				= $02;
  stConnected			= $10;
  stDisconnected		= $11;

  stSQL					= $20;

type
	TMySQLThreadNotifyEvent = procedure (Sender: TObject; const ID: integer; const Value: string; var Continue: boolean) of object;
	TMySQLThreadStatusEvent = procedure (Sender: TObject; const ID: integer; const Status: integer; const Value: string; var Continue: boolean) of object;
	TMySQLThreadProgressEvent = procedure (Sender: TObject; const ID: integer; const Total,Current: integer; const Speed: single; var Continue: boolean) of object;

  TMySQLThread = class(TThread)
  private
  	FNotifier: TSimpleEvent;
     FSync: TCriticalSection;
  	FProps: string;
    	FLastException: Exception;
     FLastStatus: byte;
     FStatus: byte;
     FLastContinue: boolean;
     //FLastTotal,
     //FLastCurrent: integer;
     //FLastSpeed: single;
     FTimeOut: integer;
    	FWndHandle: HWND;
     FOnFin: TNotifyEvent;
  protected
     // Notifies
     procedure 	NotifyException(E: Exception);
		procedure 	NotifyClient(const Value: string);
     procedure	SetStatus(NewStatus: byte=0);
     function		GetStatus: byte;
  	procedure 	Progress(Sender: TObject; const Total,Current: integer; const Speed: single);
     procedure	SetNotifyTask;
     procedure   DoFin(Sender: TObject);

     // Thread
    	procedure 	Execute; override;

     // Protocol
     procedure	Idle; virtual;
     function		GetEvent: boolean; virtual;
     procedure	HandleEvent; virtual;

     property		WndHandle: HWND read FWndHandle write FWndHandle;
     property		Props: string read FProps write FProps;
     property		Sync: TCriticalSection read FSync write FSync;
     property		TimeOut: integer read FTimeOut write FTimeOut;
     property		Continue: boolean read FLastContinue write FLastContinue;
  public
  	// Creation
  	constructor Create(Props: string;AWndHandle: HWND=0;FOT: boolean=False);
    	destructor 	Destroy; override;
     // Thread
     function	ThreadExecute: boolean; virtual;
     // Status
     property		Status: byte read GetStatus write SetStatus;
  	property		Notifier: TSimpleEvent read FNotifier;
     property    OnFin: TNotifyEvent read FOnFin write FOnFin;
  end;

  TMySQLThreadedSQL = class(TMySQLThread)
  private
  	FSQL: string;
     FServer: TMySQLServer;
  	FDataset: TMySQLDataset;
     FMsgType: longword;
     FRef: longword;
  protected
     function		GetEvent: boolean; override;
     procedure	HandleEvent; override;
  public
     function		ThreadExecute(AServer: TMySQLServer; const SQL: string; AWaitFor: boolean=True): boolean; reintroduce;
	end;

  TMySQLThreadedOpen = class(TMySQLThread)
  private
  	FDataset: TMySQLDatasetBase;
  protected
     function		GetEvent: boolean; override;
     procedure	HandleEvent; override;
  public
     function		ThreadExecute(ADataset: TMySQLDatasetBase; AWaitFor: boolean=True): boolean; reintroduce;
	end;

  EMySQLThreadException = class(Exception)
  end;

  TMySQLThreaded = class(TComponent)
  private
     FOwnHandle: HWND;
     FIntervals: word;
     FTimeOut: integer;
     FLastContinue: boolean;
     FLastTotal,
     FLastCurrent: integer;
     FLastSpeed: single;
     FOnNotify: TMySQLThreadNotifyEvent;
     FOnStatus: TMySQLThreadStatusEvent;
     FOnProgress: TMySQLThreadProgressEvent;
     FOnError: TMySQLThreadStatusEvent;
     FOnTask: TMySQLThreadStatusEvent;
     FOnTimeOut: TMySQLThreadStatusEvent;
     FOnIdle: TMySQLThreadStatusEvent;
     procedure	SetIntervals(Value: word);
  protected
		procedure 	OwnProc(var M :TMessage); virtual;
  public
  	// Creation
    	constructor Create(AOwner: TComponent); override;
    	destructor 	Destroy; override;
     // Methods
		procedure	ExecSQL(AServer: TMySQLServer; const ASQL: string='');
  published
     property		TimeOut: integer read FTimeOut write FTimeOut;
     property		Intervals: word read FIntervals write SetIntervals;
     // Events
     property		OnNotify: TMySQLThreadNotifyEvent read FOnNotify write FOnNotify;
     property		OnProgress: TMySQLThreadProgressEvent read FOnProgress write FOnProgress;
     property		OnError: TMySQLThreadStatusEvent read FOnError write FOnError;
     property		OnStatus: TMySQLThreadStatusEvent read FOnStatus write FOnStatus;
     property		OnTask: TMySQLThreadStatusEvent read FOnTask write FOnTask;
     property		OnTimeOut: TMySQLThreadStatusEvent read FOnTimeOut write FOnTimeOut;
     property		OnIdle: TMySQLThreadStatusEvent read FOnIdle write FOnIdle;
	end;

function ThreadWaitSQLFree(AServer: TMySQLServer; const ASQL: string; AHandle: HWND = 0): boolean;
function ThreadSQLFree(AServer: TMySQLServer; const ASQL: string;ANotify: TNotifyEvent=nil; AHandle: HWND=0): cardinal;

procedure ThreadSQLAnswer(AServer: TMySQLServer; const ASQL: string; AHandle: HWND=0; AMsgType: integer=0; ARef: integer=0);
procedure ThreadDatasetOpen(ADataset: TMySQLDatasetBase; ANotify: TNotifyEvent=nil; AWaitFor: boolean=False);

implementation
uses MySQLStrUtils;

constructor TMySQLThread.Create;
begin
  FNotifier:= TSimpleEvent.Create;
  FNotifier.ResetEvent;
  FSync := TCriticalSection.Create;
  FWndHandle := AWndHandle;
  FProps := Props;
  FTimeOut := ReadIniInteger(Props,'MySQL','TimeOut',30000);
  FStatus := stNone;
  FreeOnTerminate := FOT;
  OnTerminate := DoFin;
  inherited Create(True);
end;

procedure TMySQLThread.DoFin(Sender: TObject);
begin
  if Assigned(FOnFin) then FOnFin(Self);
end;

destructor TMySQLThread.Destroy;
begin
  FStatus := stNone;
  if Suspended then begin
  	Resume;
     Sleep(1);
  end;
  inherited Destroy;
  FreeAndNil(FSync);
  FreeAndNil(FNotifier);
end;

procedure TMySQLThread.NotifyException(E: Exception);
var
	Info: PChar;
begin
	FLastException := E;
  if (FWndHandle=0) then exit;
  GetMem(Info, length(E.Message)+1);
  StrLCopy(Info,PChar(E.Message),length(E.Message));
	if (FWndHandle>0) and ReadIniBoolean(FProps,'Main','SilentExceptions',True) then PostMessage(FWndHandle, MYSQL_NOTIFY_EXCEPT, ThreadID, LPARAM(Info))
  else FreeMem(Info);
end;

procedure TMySQLThread.NotifyClient;
var
	Info: PChar;
begin
  if (FWndHandle=0) then exit;
  GetMem(Info, length(Value)+1);
  StrLCopy(Info,PChar(Value),length(Value));
	if (FWndHandle>0) and ReadIniBoolean(FProps,'Main','SilentNotifies',True) then PostMessage(FWndHandle, MYSQL_NOTIFY_MSG, 0, LPARAM(Info))
  else FreeMem(Info);
end;

procedure TMySQLThread.SetStatus;
begin
  if NewStatus<>FStatus then begin