mysqlclient.pas

通过Tmysql来访问MSQL Server数据库的应用案例.

  FModify.Free;
  FQuery.Free;
  FUtility.Free;

  inherited Destroy;
end;

function TCustom_mySQLClient.CreateQuery : TmySQLClientQuery;
var
  Q : TmySQLClientQuery;
begin
  Result:=nil;

  if ((libmysql_status<>LIBMYSQL_READY) and (libmysql_status<>LIBMYSQL_INCOMPATIBLE)) or (not FConnected) then exit;

  Q:=TmySQLClientQuery.Create;
  Q.TaskHandler       :=FTaskHandler;
  with Q do begin
    Default_OnComplete:=FOnQuery;
    Default_OnError   :=FOnQueryError;
  end;

  Result:=Q;
end;

function TCustom_mySQLClient.CreateModify : TmySQLClientModify;
var
  M : TmySQLClientModify;
begin
  Result:=nil;

  if ((libmysql_status<>LIBMYSQL_READY) and (libmysql_status<>LIBMYSQL_INCOMPATIBLE)) or (not FConnected) then exit;

  M:=TmySQLClientModify.Create;
  M.TaskHandler       :=FTaskHandler;
  with M do begin
    Default_OnComplete:=FOnModify;
    Default_OnError   :=FOnModifyError;
  end;

  Result:=M;
end;

//----------------------------------------------------------------------------
//----------------------------------------------------------------------------

procedure TCustom_mySQLClient.Connect;
begin
  if FConnected then exit;

  if (libmysql_status<>LIBMYSQL_READY) and (libmysql_status<>LIBMYSQL_INCOMPATIBLE) then begin
    if FDLLPath='' then
      libmysql_load(nil)
    else
      libmysql_load(PChar(FDLLPath));
  end;

  if (libmysql_status<>LIBMYSQL_READY) and (Assigned(FOnConnectError)) then
    case libmysql_status of
      LIBMYSQL_MISSING: begin
        FOnConnectError(Self,'DLL not found - please make sure libmysql.dll is available.');
        exit;
      end;
      LIBMYSQL_INCOMPATIBLE: begin
        FOnConnectError(Self,'DLL compability issue, problems may result. Client DLL Info: '+mysql_get_client_info);
      end;
      else begin
        FOnConnectError(Self,'DLL problem - please make sure the correct libmysql.dll is available.');
        exit;
      end;
    end;

  FTaskHandler.Thread.OnStatus:=OnStatus;

  if Assigned(FOnStatus) then
    FOnStatus(Self,mysql_Status_Connecting,'[Connect]',0);

  FCap:=0;
  if (_CLIENT_LONG_PASSWORD   in FCapabilities) then FCap:=FCap+CLIENT_LONG_PASSWORD;
  if (_CLIENT_FOUND_ROWS      in FCapabilities) then FCap:=FCap+CLIENT_FOUND_ROWS;
  if (_CLIENT_LONG_FLAG       in FCapabilities) then FCap:=FCap+CLIENT_LONG_FLAG;
  if (_CLIENT_CONNECT_WITH_DB in FCapabilities) then FCap:=FCap+CLIENT_CONNECT_WITH_DB;
  if (_CLIENT_NO_SCHEMA       in FCapabilities) then FCap:=FCap+CLIENT_NO_SCHEMA;
  if (_CLIENT_COMPRESS        in FCapabilities) then FCap:=FCap+CLIENT_COMPRESS;
  if (_CLIENT_ODBC            in FCapabilities) then FCap:=FCap+CLIENT_ODBC;
  if (_CLIENT_LOCAL_FILES     in FCapabilities) then FCap:=FCap+CLIENT_LOCAL_FILES;
  if (_CLIENT_IGNORE_SPACE    in FCapabilities) then FCap:=FCap+CLIENT_IGNORE_SPACE;

  with FUtility do begin
    Default_OnSelectDatabase     :=FOnSelectDatabase;
    Default_OnSelectDatabaseError:=FOnSelectDatabaseError;

    Default_OnCreateDatabase     :=FOnCreateDatabase;
    Default_OnCreateDatabaseError:=FOnCreateDatabaseError;

    Default_OnDropDatabase       :=FOnDropDatabase;
    Default_OnDropDatabaseError  :=FOnDropDatabaseError;

    Default_OnListDatabases      :=FOnListDatabases;
    Default_OnListDatabasesError :=FOnListDatabasesError;

    Default_OnListTables         :=FOnListTables;
    Default_OnListTablesError    :=FOnListTablesError;

    Default_OnListFields         :=FOnListFields;
    Default_OnListFieldsError    :=FOnListFieldsError;

    Default_OnListProcesses      :=FOnListProcesses;
    Default_OnListProcessesError :=OnListProcessesError;

    Default_OnPing               :=FOnPing;
    Default_OnPingError          :=FOnPingError;

    Default_OnShutdown           :=FOnShutdown;
    Default_OnShutdownError      :=FOnShutdownError;

    Default_OnKill               :=FOnKill;
    Default_OnKillError          :=FOnKillError;

    Default_OnOptions            :=FOnOptions;
    Default_OnOptionsError       :=FOnOptionsError;

    Default_OnRefresh            :=FOnRefresh;
    Default_OnRefreshError       :=FOnRefreshError;
  end;

  Utility.PrepareConnectTask(
    PChar(FHost),
    PChar(FUser),
    PChar(FPasswd),
    PChar(FDb),
    FPort,nil,FCap,
    'Connect to mySQL Server',
    _OnConnect,
    FOnConnectError
  );

  Execute;
end;

procedure TCustom_mySQLClient.ForceClose;
begin
  if FConnected then begin
    BlockOnClose                :=TRUE;

    OnClose                     :=nil;
    OnConnectError              :=nil;
    OnStatus                    :=nil;
    FTaskHandler.Thread.OnStatus:=nil;

    FTaskHandler.DumpTasks;

    Close;
  end;
end;

procedure TCustom_mySQLClient.Close;
var
  ThreadedTemp : boolean;
begin
  if ((libmysql_status<>LIBMYSQL_READY) and (libmysql_status<>LIBMYSQL_INCOMPATIBLE)) or (not FConnected) then exit;

  if FTimedOut then begin
    _OnClose(Self);
    exit;
  end;

  StopTimer;

  ThreadedTemp:=Threaded;

  if BlockOnClose then
    Threaded:=FALSE;

  FTaskHandler.Thread.OnStatus:=nil;

  Utility.PrepareCloseTask(
    '[Session Closed]',
    _OnClose,
    nil
  );

  if FTaskHandler<>nil then
    FTaskHandler.StartTasks;

  if BlockOnClose then
    Threaded:=ThreadedTemp;

  FTimedOut:=FALSE;
  FConnected:=FALSE;
end;

procedure TCustom_mySQLClient.Execute;
begin
  if FConnected then
    StopTimer;

  if FTimedOut then begin
    if Assigned(FOnStatus) then
      FOnStatus(Self,mysql_Status_Reconnecting,'[Reconnect]',0);

    Utility.PrepareConnectTask(
      PChar(FHost),
      PChar(FUser),
      PChar(FPasswd),
      PChar(FDb),
      FPort,nil,FCap,
      'Connect to mySQL Server',
      nil,
      FOnConnectError
    );
    FTimedOut:=FALSE;
  end;

  if FTaskHandler<>nil then
    FTaskHandler.StartTasks;
end;

procedure TCustom_mySQLClient.StartTimer;
begin
  if FConnectedTimer=nil then exit;

  if FConnectedTimer.Enabled=FALSE then begin
    FConnectedTimer.Interval:=FConnectedTimeOutInterval;
    FConnectedTimer.OnTimer :=_OnTimeout;
    FTimedOut               :=FALSE;
    FConnectedTimer.Enabled :=TRUE;
  end;
end;

procedure TCustom_mySQLClient.StopTimer;
begin
  if FConnectedTimer=nil then exit;

  if FConnectedTimer.Enabled=TRUE then
    FConnectedTimer.Enabled:=FALSE;
end;

procedure TCustom_mySQLClient._OnConnect(Sender: TObject);
begin
  FConnected:=TRUE;

  Query :=CreateQuery;
  Modify:=CreateModify;

  if Assigned(FOnConnect) then
    FOnConnect(Self);
end;

procedure TCustom_mySQLClient._OnTimeout(Sender: TObject);
var
  ThreadedTemp : boolean;
begin
  FTimedOut:=TRUE;
  StopTimer;

  ThreadedTemp:=Threaded;

  if BlockOnClose then
    Threaded:=FALSE;

  Utility.PrepareCloseTask(
    '[Time Out: '+IntToStr(FConnectedTimeOutInterval)+']',
    nil,
    nil
  );

  if FTaskHandler<>nil then
    FTaskHandler.StartTasks;

  if BlockOnClose then
    Threaded:=ThreadedTemp;
end;

procedure TCustom_mySQLClient._OnTaskFinished(Sender: TObject);
begin
  if FConnectedTimer=nil then exit;

  if (not FTimedOut) and (FConnected) then begin
    StopTimer;
    StartTimer;
  end;
end;

procedure TCustom_mySQLClient._OnClose(Sender: TObject);
begin
  FConnected:=FALSE;
  FTimedOut:=FALSE;

  StopTimer;

  if Assigned(FOnClose) then
    FOnClose(Self);

  if (not FTimedOut) and (Assigned(FOnStatus)) then
    FOnStatus(Self,mysql_Status_NotConnected,'[Not Connected]',0);

  Query.Free;
  Query:=nil;

  Modify.Free;
  Modify:=nil;
end;

//----------------------------------------------------------------------------
//----------------------------------------------------------------------------

procedure TCustom_mySQLClient.SetDLLPath(const S : string);
begin
  FDLLPath:=S;
end;

function  TCustom_mySQLClient.GetDLLPath : string;
begin
  Result:=FDLLPath;
end;

procedure TCustom_mySQLClient.SetHostname(const S : string);
begin
  FHost:=S;
end;

function  TCustom_mySQLClient.GetHostname : string;
begin
  Result:=FHost;
end;

procedure TCustom_mySQLClient.SetUsername(const S : string);
begin
  FUser:=S;
end;

function  TCustom_mySQLClient.GetUsername : string;
begin
  Result:=FUser;
end;

procedure TCustom_mySQLClient.SetPassword(const S : string);
begin
  FPasswd:=S;
end;

function  TCustom_mySQLClient.GetPassword : string;
begin
  Result:=FPasswd;
end;

procedure TCustom_mySQLClient.SetDatabase(const S : string);
begin
  Fdb:=S;
end;

function  TCustom_mySQLClient.GetDatabase : string;
begin
  Result:=Fdb;
end;

procedure TCustom_mySQLClient.SetPort(const i : integer);
begin
  FPort:=i;
end;

function  TCustom_mySQLClient.GetPort : integer;
begin
  Result:=FPort;
end;

procedure TCustom_mySQLClient.SetCapabilities (const C : TSetClientCapabilities);
begin
  FCapabilities:=C;
end;

function  TCustom_mySQLClient.GetCapabilities : TSetClientCapabilities;
begin
  Result:=FCapabilities;
end;

procedure TCustom_mySQLClient.SetOnStatus(OS : TmySQLClientTask_OnStatus);
begin
  FOnStatus:=OS;
  FTaskHandler.Thread.OnStatus:=OS;
end;

function  TCustom_mySQLClient.GetOnStatus : TmySQLClientTask_OnStatus;
begin
  Result:=FOnStatus;
end;

function  TCustom_mySQLClient.GetThreaded : boolean;
begin
  Result:=FThreaded;
end;

procedure TCustom_mySQLClient.SetThreaded(const b : boolean);
begin
  FThreaded:=b;
  FTaskHandler.Threaded:=b;
end;

procedure Register;
begin
  RegisterComponents('mySQLClient', [TmySQLClient]);
end;

//
// Copyright (c) 1999 Justin P. Yunke and others...(see top)
//

end.