msgdatabaseaccuracer.pas

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

   if (FDatabase.TableExists(MessagesTableName)) then
    s := 'DROP TABLE '+MessagesTableName+';'+crlf
   else
    s := '';
   s := s+'CREATE TABLE '+MessagesTableName + ' ('+ crlf+
        // Message unique ID
        'ID AutoInc, '+ crlf+
        // Sender UserID
        'SenderID Integer, '+ crlf+
        // Recipient UserID
        'RecipientID Integer, '+ crlf+
        // Delivered or no
        'Delivered Boolean, '+ crlf+
        // Delivery date
        'DeliveryDate DateTime,'+ crlf+
        // Date of sending
        'SendingDate DateTime,'+ crlf+
        // message type: binary, stream, text, command
        'MessageType Byte,'+ crlf+
        // if sent by SendCommand
        'Command Integer,'+ crlf+
        // size of data
        'MessageDataSize Integer,'+ crlf+
        // message data if not text message
        'MessageData BLOB '+DataBlobParams+','+ crlf+
        // for text messages or for custom translation of binary messages
        'MessageText Memo '+MemoBlobParams+','+ crlf+
        // for text messages or for custom translation of binary messages
        'MessageUnicodeText WideMemo '+MemoBlobParams+','+ crlf+
        'PRIMARY KEY MessagesPK (ID)'+ crlf+
        ');';
    FQuery.SQL.Text := s;
    FQuery.ExecSQL;
 finally
   FQuery.Free;
 end;
end; // CreateTables


//------------------------------------------------------------------------------
// OpenDatabase
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.OpenDatabase;
begin
  if (FDatabase = nil) then
   raise EMsgException.Create(11353,ErrorLDatabaseIsNotAssigned);
  if (not FDatabase.Connected) then
   begin
    if (not FDatabase.Exists) then
     FDatabase.CreateDatabase;
    FDatabase.Open;
    FCloseDB := True;
   end
  else
   FCloseDB := False;
end; // OpenDatabase


//------------------------------------------------------------------------------
// create session database
//------------------------------------------------------------------------------
function TMsgDatabaseAccuracer.CreateSessionDatabase: TACRDatabase;
begin
  Result := TACRDatabase.Create(nil);
  Inc(FCounter);
  Result.DatabaseName := 'DB_'+IntToStr(FCounter)+'_'+IntToStr(Integer(Result));
  Result.DatabaseFileName := FDatabase.DatabaseFileName;
  Result.LocalDatabase := FDatabase.LocalDatabase;
  Result.CryptoParams.Assign(FDatabase.CryptoParams);
  Result.LockParams.Assign(FDatabase.LockParams);
  Result.ConnectionParams.Assign(FDatabase.ConnectionParams);
  Result.Options.Assign(FDatabase.Options);
  Result.Exclusive := FDatabase.Exclusive;
end; // CreateSessionDatabase


//------------------------------------------------------------------------------
// Start transaction
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.StartTransaction(aDatabase: TACRDatabase);
var bOK: Boolean;
begin
  bOK := False;
  while (not bOK) do
   begin
    if (not aDatabase.InTransaction) then
     try
       aDatabase.StartTransaction;
       bOK := True;
     except
       bOK := False;
     end;
    if (not bOK) then
     Sleep(FDatabase.LockParams.Delay);
   end;
end; // StartTransaction


//------------------------------------------------------------------------------
// Create SQL script for adding user
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.GetInsertUserSQL(
                                Query:    TACRQuery;
                                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 TMsgDatabaseAccuracer.GetUpdateUserSQL(
                      Query:          TACRQuery;
                      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 TMsgDatabaseAccuracer.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 TMsgDatabaseAccuracer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCounter := 0;
end; // Create


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


//------------------------------------------------------------------------------
// Close database
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.CloseDatabase;
begin
  if (FCloseDB) then
    FDatabase.Close;
end; // CloseDatabase


//------------------------------------------------------------------------------
// Close database
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.AddUser(UserInfo: TMsgUserInfo; PasswordHeader: TMsgCryptoHeader);
var DB:     TACRDatabase;
    Query:  TACRQuery;
    bOK:    Boolean;
    cnt:    Integer;
begin
  if (UserInfo.UserID = MSG_INVALID_USER_ID) then
   raise EMsgException.Create(11365,ErrorLInvalidUserID,[UserInfo.UserID]);
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    Query.DatabaseName := DB.DatabaseName;
    GetInsertUserSQL(Query,UserInfo,PasswordHeader);
    bOK := False;
    cnt := DB.LockParams.RetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      StartTransaction(DB);
      if (UserExists(UserInfo.UserID)) then
       begin
         DB.Rollback;
         raise EMsgException.Create(11359,ErrorLUserAlreadyExists,[UserInfo.UserID]);
       end;
      try
       Query.ExecSQL;
       DB.Commit(True);
       bOK := True;
      except
       DB.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11360,ErrorLAddUserTransactionFailed,
       [UserInfo.UserID,DB.LockParams.RetryCount,DB.LockParams.Delay]);
  finally
    Query.Free;
    DB.Free;
  end;
end; // AddUser


//------------------------------------------------------------------------------
// Close database
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.RemoveUser(const UserID: Cardinal);
var DB:     TACRDatabase;
    Query:  TACRQuery;
    bOK:    Boolean;
    cnt:    Integer;
begin
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    Query.DatabaseName := DB.DatabaseName;
    bOK := False;
    cnt := DB.LockParams.RetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      StartTransaction(DB);
      if (not UserExists(UserID)) then
       begin
         DB.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;
       DB.Commit(True);
       bOK := True;
      except
       DB.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11362,ErrorLRemoveUserTransactionFailed,
       [UserID,DB.LockParams.RetryCount,DB.LockParams.Delay]);
  finally
    Query.Free;
    DB.Free;
  end;
end; // RemoveUser


//------------------------------------------------------------------------------
// change user info and optionally password
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.ChangeUserInfo(UserInfo: TMsgUserInfo; ChangePassword: Boolean; PasswordHeader: TMsgCryptoHeader);
var DB:     TACRDatabase;
    Query:  TACRQuery;
    bOK:    Boolean;
    cnt:    Integer;
begin
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    Query.DatabaseName := DB.DatabaseName;
    GetUpdateUserSQL(Query,UserInfo,ChangePassword,PasswordHeader);
    bOK := False;
    cnt := DB.LockParams.RetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      StartTransaction(DB);
      if (not UserExists(UserInfo.UserID)) then
       begin
         DB.Rollback;
         raise EMsgException.Create(11363,ErrorLUserDoesNotExist,[UserInfo.UserID]);
       end;
      try
       Query.ExecSQL;
       DB.Commit(True);
       bOK := True;
      except
       DB.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11364,ErrorLChangeUserInfoTransactionFailed,
       [UserInfo.UserID,DB.LockParams.RetryCount,DB.LockParams.Delay]);
  finally
    Query.Free;
    DB.Free;
  end;
end; // ChangeUserInfo