msgdatabasemysql.pas

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

{$IFDEF D6H}
     and (FSQLConnection = nil)
{$ENDIF}
     then
   raise EMsgException.Create(11584,ErrorLMySQLDatabaseIsNotAssigned);
 FQuery := TMsgMySQLQuery.Create(Self,False);
 try
   if (not HistoryOnly) then
    begin
     if (FQuery.TableExists(UsersTableName)) then
      begin
       FQuery.SQL.Text := 'DROP TABLE '+UsersTableName+';'+crlf;
       FQuery.ExecSQL;
      end;
     s := 'CREATE TABLE '+UsersTableName + ' ('+crlf+
          // User unique ID
          'ID Integer NOT NULL, '+ crlf+
          'UserName Char(255),'+crlf+
          'FirstName Char(255),'+crlf+
          'LastName Char(255),'+crlf+
          'Organization Char(255),'+crlf+
          'Department Char(255),'+crlf+
          'Status TinyInt Unsigned,'+crlf+
          'Host Char(255),'+crlf+
          'Port Integer,'+crlf+
          'Application Char(255),'+crlf+
          'CryptoHeader BLOB,'+crlf+
          'PRIMARY KEY UsersPK (ID)'+ crlf+
          ') Type='+FTableType+';'+crlf;
     FQuery.SQL.Text := s;
     FQuery.ExecSQL;
     FQuery.SQL.Text := 'CREATE INDEX UserNameIndex ON '+UsersTableName+' (UserName);'+crlf;
     FQuery.ExecSQL;
     FQuery.SQL.Text := 'CREATE INDEX FirstNameIndex ON '+UsersTableName+' (FirstName);'+crlf;
     FQuery.ExecSQL;
     FQuery.SQL.Text := 'CREATE INDEX LastNameIndex ON '+UsersTableName+' (LastName);'+crlf;
     FQuery.ExecSQL;
     FQuery.SQL.Text := 'CREATE INDEX OrganizationIndex ON '+UsersTableName+' (Organization);'+crlf;
     FQuery.ExecSQL;
     FQuery.SQL.Text := 'CREATE INDEX DepartmentIndex ON '+UsersTableName+' (Department);'+crlf;
     FQuery.ExecSQL;
     FQuery.SQL.Text := 'CREATE INDEX HostIndex ON '+UsersTableName+' (Host);'+crlf;
     FQuery.ExecSQL;
     FQuery.SQL.Text := 'CREATE INDEX PortIndex ON '+UsersTableName+' (Port);'+crlf;
     FQuery.ExecSQL;
     FQuery.SQL.Text := 'CREATE INDEX ApplicationIndex ON '+UsersTableName+' (Application);'+crlf;
     FQuery.ExecSQL;
     FQuery.SQL.Text := 'CREATE INDEX StatusIndex ON '+UsersTableName+' (Status);';
     FQuery.ExecSQL;

     if (FQuery.TableExists(ContactsTableName)) then
      begin
       FQuery.SQL.Text :=  'DROP TABLE '+ContactsTableName+';';
       FQuery.ExecSQL;
      end;
     s := 'CREATE TABLE '+ContactsTableName + ' ('+crlf+
          // id in Users of the contact list owner
          'OwnerID Integer NOT NULL,'+crlf+
          // id in Users of the person in contact list
          'ContactID Integer NOT NULL,'+crlf+
          // source of the name: UserName, FirstName, LastName, FirstName LastName, Custom,  etc.
          'ContactNameSource TinyInt Unsigned,'+crlf+
          // contact custom name
          'ContactCustomName Varchar(255),'+crlf+
          'PRIMARY KEY ContactsPK (OwnerID,ContactID)'+ crlf+
          ');'+crlf;
     FQuery.SQL.Text := s;
     FQuery.ExecSQL;
     FQuery.SQL.Text := 'CREATE INDEX ContactIDIndex ON '+ContactsTableName+' (ContactID);'+crlf;
     FQuery.ExecSQL;
    end;
   if (FQuery.TableExists(MessagesTableName)) then
    begin
     FQuery.SQL.Text := 'DROP TABLE '+MessagesTableName+';';
     FQuery.ExecSQL;
    end;
   s := 'CREATE TABLE '+MessagesTableName + ' ('+ crlf+
        // Message unique ID
        'ID Integer AUTO_INCREMENT NOT NULL, '+ crlf+
        // Sender UserID
        'SenderID Integer, '+ crlf+
        // Recipient UserID
        'RecipientID Integer, '+ crlf+
        // Delivered or no
        'Delivered TinyInt Unsigned, '+ crlf+
        // Delivery date
        'DeliveryDate DateTime,'+ crlf+
        // Date of sending
        'SendingDate DateTime,'+ crlf+
        // message type: binary, stream, text, command
        'MessageType TinyInt Unsigned,'+ crlf+
        // if sent by SendCommand
        'Command Integer,'+ crlf+
        // size of data
        'MessageDataSize Integer,'+ crlf+
        // message data if not text message
        'MessageData LONGBLOB,'+ crlf+
        // for text messages or for custom translation of binary messages
        'MessageText LONGTEXT,'+ crlf+
        // for text messages or for custom translation of binary messages
//        'MessageUnicodeText WideMemo '+MemoBlobParams+','+ crlf+
        'PRIMARY KEY MessagesPK (ID)'+ crlf+
         ');'+crlf;
    FQuery.SQL.Text := s;
    FQuery.ExecSQL;
//    FQuery.SQL.Text := 'CREATE FULLTEXT INDEX MessageTextIndex ON '+ContactsTableName+' (MessageText);'+crlf;
//    FQuery.ExecSQL;
 finally
   FQuery.Free;
 end;
end; // CreateTables


//------------------------------------------------------------------------------
// OpenDatabase
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.OpenDatabase;
begin
  FCloseDB := False;
  if (FDatabase = nil)
{$IFDEF D6H}
     and (FSQLConnection = nil)
{$ENDIF}
     then
   raise EMsgException.Create(11585,ErrorLMySQLDatabaseIsNotAssigned);
 if (FDatabase <> nil) then
  if (not FDatabase.Connected) then
    begin
     FDatabase.Open;
     FCloseDB := True;
    end;
{$IFDEF D6H}
 if (FSQLConnection <> nil) then
  if (not FSQLConnection.Connected) then
    begin
     FSQLConnection.Open;
     FCloseDB := True;
    end;
{$ENDIF}
end; // OpenDatabase


//------------------------------------------------------------------------------
// Create SQL script for adding user
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.GetInsertUserSQL(
                                Query:    TMsgMySQLQuery;
                                UserInfo: TMsgUserInfo;
                                PasswordHeader: TMsgCryptoHeader);
begin
 Query.SQL.Text := 'INSERT INTO '+UsersTableName+
           ' (ID,UserName,FirstName,LastName,Organization,Department,'+
           'Status,CryptoHeader) '+
           ' VALUES ('+crlf+
           IntToStr(Integer(UserInfo.UserID))+','+crlf+
           AnsiQuotedStr(UserInfo.UserName,'''')+','+crlf+
           AnsiQuotedStr(UserInfo.FirstName,'''')+','+crlf+
           AnsiQuotedStr(UserInfo.LastName,'''')+','+crlf+
           AnsiQuotedStr(UserInfo.Organization,'''')+','+crlf+
           AnsiQuotedStr(UserInfo.Department,'''')+','+crlf+
           IntToStr(Byte(UserInfo.Status))+','+crlf+
           ':P_CryptoHeader'+crlf+
           ');';
 Query.Prepare;
 Query.ParamByName('P_CryptoHeader').SetBlobData(@PasswordHeader,SizeOf(PasswordHeader));
end; // GetInsertToUsersSQL


//------------------------------------------------------------------------------
// Create SQL script for updating user info
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.GetUpdateUserSQL(
                      Query:          TMsgMySQLQuery;
                      UserInfo:       TMsgUserInfo;
                      ChangePassword: Boolean;
                      PasswordHeader: TMsgCryptoHeader);
var s: String;
begin
 if (ChangePassword) then
  s := 'CryptoHeader = :P_CryptoHeader'+crlf
 else
  s := '';
 Query.SQL.Text := 'UPDATE '+UsersTableName+' SET '+crlf+
           'UserName = '+AnsiQuotedStr(UserInfo.UserName,'''')+','+crlf+
           'FirstName = '+AnsiQuotedStr(UserInfo.FirstName,'''')+','+crlf+
           'LastName = '+AnsiQuotedStr(UserInfo.LastName,'''')+','+crlf+
           'Organization = '+AnsiQuotedStr(UserInfo.Organization,'''')+','+crlf+
           'Department = '+AnsiQuotedStr(UserInfo.Department,'''')+','+crlf+
           s+
           'WHERE ID = '+IntToStr(Integer(UserInfo.UserID));
 if (ChangePassword) then
  begin
   Query.Prepare;
   Query.ParamByName('P_CryptoHeader').SetBlobData(@PasswordHeader,SizeOf(PasswordHeader));
  end;
end; // GetUpdateUserSQL


//------------------------------------------------------------------------------
// return user info
//------------------------------------------------------------------------------
function TMsgDatabaseMySQL.ExtractUserInfo(Dataset: TDataset): TMsgUserInfo;
begin
  Result.UserID := Cardinal(Dataset.FieldByName('ID').AsInteger);
  Result.UserName := Dataset.FieldByName('UserName').AsString;
  Result.FirstName := Dataset.FieldByName('FirstName').AsString;
  Result.LastName := Dataset.FieldByName('LastName').AsString;
  Result.Organization := Dataset.FieldByName('Organization').AsString;
  Result.Department := Dataset.FieldByName('Department').AsString;
  Result.Status := TMsgUserStatus(Dataset.FieldByName('Status').AsInteger);
  Result.Host := Dataset.FieldByName('Host').AsString;
  Result.Application := Dataset.FieldByName('Application').AsString;
  Result.Port := Dataset.FieldByName('Port').AsInteger;
end; // ExtractUserInfo


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMsgDatabaseMySQL.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDelay := 100;
  FRetryCount := 10;
  FTableType := 'MyISAM';
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgDatabaseMySQL.Destroy;
begin
  inherited;
end; // Destroy


//------------------------------------------------------------------------------
// Close database
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.CloseDatabase;
begin
  if (FCloseDB) then
   begin
    if (FDatabase <> nil) then
     FDatabase.Close;
    {$IFDEF D6H}
    if (FSQLConnection <> nil) then
     FSQLConnection.Close;
    {$ENDIF}
   end;
end; // CloseDatabase


//------------------------------------------------------------------------------
// Close database
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.AddUser(UserInfo: TMsgUserInfo; PasswordHeader: TMsgCryptoHeader);
var
    Query:  TMsgMySQLQuery;
    bOK:    Boolean;
    cnt:    Integer;
begin
  if (UserInfo.UserID = MSG_INVALID_USER_ID) then
   raise EMsgException.Create(11365,ErrorLInvalidUserID,[UserInfo.UserID]);
  Query := TMsgMySQLQuery.Create(Self,True);
  try
    GetInsertUserSQL(Query,UserInfo,PasswordHeader);
    bOK := False;
    cnt := FRetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      Query.StartTransaction;
      if (UserExists(UserInfo.UserID)) then
       begin
         Query.Rollback;
         raise EMsgException.Create(11359,ErrorLUserAlreadyExists,[UserInfo.UserID]);
       end;
      try
       Query.ExecSQL;
       Query.Commit;
       bOK := True;
      except
       Query.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11360,ErrorLAddUserTransactionFailed,
       [UserInfo.UserID,FRetryCount,FDelay]);
  finally
    Query.Free;
  end;
end; // AddUser


//------------------------------------------------------------------------------
// Close database
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.RemoveUser(const UserID: Cardinal);
var
    Query:  TMsgMySQLQuery;
    bOK:    Boolean;
    cnt:    Integer;
begin
  Query := TMsgMySQLQuery.Create(Self,True);
  try
    bOK := False;
    cnt := FRetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      Query.StartTransaction;
      if (not UserExists(UserID)) then
       begin
         Query.Rollback;
         raise EMsgException.Create(11361,ErrorLUserDoesNotExist,[UserID]);
       end;
      try
       Query.SQL.Text := 'DELETE FROM '+UsersTableName+' WHERE ID = '+IntToStr(Integer(UserID));
       Query.ExecSQL;
       Query.SQL.Text := 'DELETE FROM '+ContactsTableName+' WHERE (OwnerID = '+IntToStr(Integer(UserID))+
                         ') OR (ContactID = '+IntToStr(Integer(UserID))+')';
       Query.ExecSQL;
       Query.SQL.Text := 'DELETE FROM '+MessagesTableName+' WHERE (SenderID = '+IntToStr(Integer(UserID))+
                         ') OR (RecipientID = '+IntToStr(Integer(UserID))+')';
       Query.ExecSQL;
       Query.Commit;
       bOK := True;
      except
       Query.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11362,ErrorLRemoveUserTransactionFailed,
       [UserID,FRetryCount,FDelay]);
  finally
    Query.Free;
  end;
end; // RemoveUser


//------------------------------------------------------------------------------
// change user info and optionally password
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.ChangeUserInfo(UserInfo: TMsgUserInfo; ChangePassword: Boolean; PasswordHeader: TMsgCryptoHeader);
var DB:     TDatabase;
    Query:  TMsgMySQLQuery;
    bOK:    Boolean;
    cnt:    Integer;
begin
  Query := TMsgMySQLQuery.Create(Self,True);
  try
    GetUpdateUserSQL(Query,UserInfo,ChangePassword,PasswordHeader);
    bOK := False;
    cnt := FRetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      Query.StartTransaction;
      if (not UserExists(UserInfo.UserID)) then
       begin