msgdatabasemysql.pas

Delphi MsgCommunicator 2-10 component.I ve used, really good job. can be Server-Client message appl

//------------------------------------------------------------------------------
// Prepare
//------------------------------------------------------------------------------
procedure TMsgMySQLQuery.Prepare;
begin
 if (FQuery <> nil) then
  FQuery.Prepare;
end; // Prepare


//------------------------------------------------------------------------------
// Get param by name
//------------------------------------------------------------------------------
function TMsgMySQLQuery.ParamByName(const Value: string): TParam;
begin
  if (FQuery <> nil) then
    Result := FQuery.ParamByName(Value)
  else
   begin
    Result := nil;
{$IFDEF D6H}
    if (FSQLQuery <> nil) then
     Result := FSQLQuery.ParamByName(Value);
{$ENDIF}
   end;
end; // ParamByName


//------------------------------------------------------------------------------
// return dataset
//------------------------------------------------------------------------------
function TMsgMySQLQuery.GetDataset: TDataset;
begin
  if (FQuery <> nil) then
    Result := FQuery
  else
   begin
    Result := nil;
{$IFDEF D6H}
    if (FSQLQuery <> nil) then
     Result := FSQLQuery;
{$ENDIF}
   end;
end; // GetDataset


//------------------------------------------------------------------------------
// return true if table exists
//------------------------------------------------------------------------------
function TMsgMySQLQuery.TableExists(const TableName: string): Boolean;
var sl: TStringList;
begin
  sl := TStringList.Create;
  try
    if (FDatabase <> nil) then
     begin
      {$IFDEF D6H}
      FDatabase.GetTableNames(sl,False);
      {$ELSE}
      if (FDatabase.Session <> nil) then
       FDatabase.Session.GetTableNames(FDatabase.DatabaseName,'',True,True,sl);
      {$ENDIF}
     end
    else
     begin
      Result := False;
  {$IFDEF D6H}
     try
      if (FSQLConnection <> nil) then
       FSQLConnection.GetTableNames(sl,False);
     except
     end;
  {$ENDIF}
     end;
    FixTableNames(sl);
    Result := (sl.IndexOf(TableName) >= 0);
  finally
    sl.Free;
  end;
end; // TableExists


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMsgMySQLQuery.Create(
                       AOwner:           TComponent;
                       CreateNewSession: Boolean = False
                       );
begin
  inherited Create(AOwner);
  FNewSession := CreateNewSession;
  FDatabase := nil;
  FSession := nil;
  FQuery := nil;
  {$IFDEF D6H}
  FSQLConnection := nil;
  FSQLQuery := nil;
  FParams := nil;
  FSQL := nil;
  if (TMsgDatabaseMySQL(Owner).SQLConnection <> nil) then
   begin
    if (FNewSession) then
     begin
      FSQLConnection := TSQLConnection.Create(AOwner);
      FSQLConnection.ConnectionName := TMsgDatabaseMySQL(Owner).SQLConnection.ConnectionName;
      FSQLConnection.DriverName := TMsgDatabaseMySQL(Owner).SQLConnection.DriverName;
      FSQLConnection.GetDriverFunc := TMsgDatabaseMySQL(Owner).SQLConnection.GetDriverFunc;
      FSQLConnection.LibraryName := TMsgDatabaseMySQL(Owner).SQLConnection.LibraryName;
      FSQLConnection.VendorLib := TMsgDatabaseMySQL(Owner).SQLConnection.VendorLib;
      FSQLConnection.Params.Assign(TMsgDatabaseMySQL(Owner).SQLConnection.Params);
      FSQLConnection.LoginPrompt := TMsgDatabaseMySQL(Owner).SQLConnection.LoginPrompt;
     end
    else
     begin
      FSQLConnection := TMsgDatabaseMySQL(Owner).SQLConnection;
     end;
    FSQLQuery := TSQLQuery.Create(FSQLConnection);
    FSQLQuery.SQLConnection := FSQLConnection;
    FParams := FSQLQuery.Params;
    FSQL := FSQLQuery.SQL;
   end;
  {$ENDIF}
  if (TMsgDatabaseMySQL(Owner).Database <> nil) then
   begin
    if (FNewSession) then
     begin
      FDatabase := TDatabase.Create(AOwner);
      try
       if (TMsgDatabaseMySQL(Owner).Database.Directory <> '') then
        FDatabase.Directory := TMsgDatabaseMySQL(Owner).Database.Directory;
      except
      end;
      FDatabase.DatabaseName := 'TempDB_'+IntToStr(Random(MaxInt));
      if (TMsgDatabaseMySQL(Owner).Database.AliasName <> '') then
       FDatabase.AliasName := TMsgDatabaseMySQL(Owner).Database.AliasName;
      if (TMsgDatabaseMySQL(Owner).Database.DriverName <> '') then
       FDatabase.DriverName := TMsgDatabaseMySQL(Owner).Database.DriverName;
      FDatabase.LoginPrompt := TMsgDatabaseMySQL(Owner).Database.LoginPrompt;
      FDatabase.Params.Assign(TMsgDatabaseMySQL(Owner).Database.Params);
      FSession := TSession.Create(AOwner);
      FSession.SessionName := 'MsgSession_'+IntToStr(Random(MaxInt));
      FDatabase.SessionName := FSession.SessionName;
      FDatabase.Open;
     end
    else
     begin
      FDatabase := TMsgDatabaseMySQL(Owner).Database;
     end;
    FQuery := TQuery.Create(FDatabase);
    FQuery.DatabaseName := FDatabase.DatabaseName;
    if (FNewSession) then
     FQuery.SessionName := FSession.SessionName;
    FParams := FQuery.Params;
    FSQL := FQuery.SQL;
   end;
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgMySQLQuery.Destroy;
begin
  {$IFDEF D6H}
  if (FSQLConnection <> nil) then
   begin
    if (FSQLQuery <> nil) then
     FSQLQuery.Free;
    if (FNewSession) then
      FSQLConnection.Free;
    FSQLQuery := nil;
    FSQLConnection := nil;
   end;
  {$ENDIF}
  if (FDatabase <> nil) then
   begin
    if (FQuery <> nil) then
     begin
      FQuery.Free;
     end;
    if (FNewSession) then
     begin
      FDatabase.Free;
      FSession.Free;
     end;
    FQuery := nil;
    FDatabase := nil;
    FSession := nil;
    FSQL := nil;
   end;
  inherited;
end; // Destroy


//------------------------------------------------------------------------------
// Start transaction
//------------------------------------------------------------------------------
procedure TMsgMySQLQuery.StartTransaction;
var bOK:            Boolean;
    InTransacation: Boolean;
begin
  bOK := False;
  while (not bOK) do
   begin
    if (FDatabase <> nil) then
     InTransacation := FDatabase.InTransaction
    else
     begin
{$IFDEF D6H}
      InTransacation := FSQLConnection.InTransaction;
      FTransactionDesc.TransactionID := 1;
      FTransactionDesc.IsolationLevel := xilREADCOMMITTED;
{$ELSE}
      break;
{$ENDIF}
     end;
    if (not InTransacation) then
     try
       if (FDatabase <> nil) then
        FDatabase.StartTransaction
       else
        begin
{$IFDEF D6H}
         FSQLConnection.StartTransaction(FTransactionDesc);
{$ENDIF}
        end;
       bOK := True;
     except
       bOK := False;
     end;
    if (not bOK) then
     Sleep(TMsgDatabaseMySQL(Owner).Delay);
   end;
end; // StartTransaction


//------------------------------------------------------------------------------
// Commit
//------------------------------------------------------------------------------
procedure TMsgMySQLQuery.Commit;
begin
  if (FDatabase <> nil) then
   FDatabase.Commit
  else
   begin
{$IFDEF D6H}
    FSQLConnection.Commit(FTransactionDesc);
{$ENDIF}
   end;
end; // Commit


//------------------------------------------------------------------------------
// Rollback
//------------------------------------------------------------------------------
procedure TMsgMySQLQuery.Rollback;
begin
  if (FDatabase <> nil) then
   FDatabase.Rollback
  else
   begin
{$IFDEF D6H}
    FSQLConnection.Rollback(FTransactionDesc);
{$ENDIF}
   end;
end; // Rollback


//------------------------------------------------------------------------------
// Execute SQL script
//------------------------------------------------------------------------------
procedure TMsgMySQLQuery.ExecSQL;
begin
  if (FDatabase <> nil) then
   FQuery.ExecSQL
  else
   begin
{$IFDEF D6H}
    FSQLQuery.ExecSQL;
{$ENDIF}
   end;
end; // ExecSQL


////////////////////////////////////////////////////////////////////////////////
//
// TMsgDatabaseMySQL
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// Set Database
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.SetDatabase(Value: TDatabase);
begin
  FDatabase := Value;
{$IFDEF D6H}
  if (FDatabase <> nil) then
   FSQLConnection := nil;
{$ENDIF}
end; // SetDatabase


{$IFDEF D6H}
//------------------------------------------------------------------------------
// Set SQLConnection
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.SetSQLConnection(Value: TSQLConnection);
begin
  FSQLConnection := Value;
  if (FSQLConnection <> nil) then
   FDatabase := nil;
end; // SetSQLConnection
{$ENDIF}

//------------------------------------------------------------------------------
// Return true if all tables exists
//------------------------------------------------------------------------------
function TMsgDatabaseMySQL.GetTablesExists(HistoryOnly: Boolean): Boolean;
var sl: TStringList;
begin
  sl := TStringList.Create;
  try
   if (FDatabase <> nil) then
    {$IFDEF D6H}
    FDatabase.GetTableNames(sl,False);
    {$ELSE}
    if (FDatabase.Session <> nil) then
     FDatabase.Session.GetTableNames(FDatabase.DatabaseName,'',True,True,sl);
    {$ENDIF}
  {$IFDEF D6H}
    try
     if (FSQLConnection <> nil) then
      FSQLConnection.GetTableNames(sl,False);
    except
    end;
  {$ENDIF}
   FixTableNames(sl);
   Result := (sl.IndexOf(MessagesTableName) >= 0);
   if (Result and (not HistoryOnly)) then
     begin
      Result := (sl.IndexOf(UsersTableName) >= 0);
      if (Result) then
        Result := (sl.IndexOf(ContactsTableName) >= 0);
     end;
  finally
    sl.Free;
  end;
end; // GetTablesExists


//------------------------------------------------------------------------------
// Create Tables
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.CreateTables(HistoryOnly: Boolean);
var s:              String;
    FQuery:         TMsgMySQLQuery;
begin
  if (FDatabase = nil)