msgdatabaseaccuracer.pas

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

      if (not UserExists(ContactUserID)) then
       begin
         DB.Rollback;
         raise EMsgException.Create(11369,ErrorLUserDoesNotExist,[ContactUserID]);
       end;
      try
       Query.ExecSQL;
       DB.Commit(True);
       bOK := True;
      except
       DB.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11370,ErrorLAddContactTransactionFailed,
       [OwnerUserID,ContactUserID,DB.LockParams.RetryCount,DB.LockParams.Delay]);
  finally
    Query.Free;
    DB.Free;
  end;
end; // AddUserToContacts


//------------------------------------------------------------------------------
// update user in contact list of another user
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.UpdateUserInContacts(
                            const OwnerUserID:        Cardinal;
                            const ContactUserID:      Cardinal;
                            const ContactNameSource:  TMsgContactNameSource = mcnsUserName;
                            const ContactCustomName:  ShortString = ''
                                                  );
var DB:     TACRDatabase;
    Query:  TACRQuery;
    bOK:    Boolean;
    cnt:    Integer;
begin
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    Query.DatabaseName := DB.DatabaseName;
    Query.SQL.Text := 'UPDATE '+ContactsTableName+' SET ContactNameSource = '+
                      IntToStr(Byte(ContactNameSource))+', ContactCustomName = '+
                      AnsiQuotedStr(ContactCustomName,'''')+crlf+
                      ' WHERE (OwnerID = '+IntToStr(Integer(OwnerUserID))+
                      ') AND (ContactID = '+IntToStr(Integer(ContactUserID))+');'+crlf;
    bOK := False;
    cnt := DB.LockParams.RetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      StartTransaction(DB);
      if (not UserExists(OwnerUserID)) then
       begin
         DB.Rollback;
         raise EMsgException.Create(11490,ErrorLUserDoesNotExist,[OwnerUserID]);
       end;
      if (not UserExists(ContactUserID)) then
       begin
         DB.Rollback;
         raise EMsgException.Create(11491,ErrorLUserDoesNotExist,[ContactUserID]);
       end;
      try
       Query.ExecSQL;
       DB.Commit(True);
       bOK := True;
      except
       DB.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11492,ErrorLUpdateContactTransactionFailed,
       [OwnerUserID,ContactUserID,DB.LockParams.RetryCount,DB.LockParams.Delay]);
  finally
    Query.Free;
    DB.Free;
  end;
end; // UpdateUserInContacts


//------------------------------------------------------------------------------
// Remove user from contact list of another user
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.RemoveUserFromContacts(
                                  const OwnerUserID: Cardinal;
                                  const ContactUserID: 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(OwnerUserID)) then
       begin
         DB.Rollback;
         raise EMsgException.Create(11371,ErrorLUserDoesNotExist,[OwnerUserID]);
       end;
      if (not UserExists(ContactUserID)) then
       begin
         DB.Rollback;
         raise EMsgException.Create(11372,ErrorLUserDoesNotExist,[ContactUserID]);
       end;
      try
       Query.SQL.Text := 'DELETE FROM '+ContactsTableName+' WHERE (OwnerID = '+
                         IntToStr(Integer(OwnerUserID))+
                         ') AND (ContactID = '+IntToStr(Integer(ContactUserID))+')';
       Query.ExecSQL;
       DB.Commit(True);
       bOK := True;
      except
       DB.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11373,ErrorLRemoveUserFromContactsTransactionFailed,
       [OwnerUserID,ContactUserID,DB.LockParams.RetryCount,DB.LockParams.Delay]);
  finally
    Query.Free;
    DB.Free;
  end;
end; // RemoveUserFromContacts


//------------------------------------------------------------------------------
// saves message to database and returns MessageID
//------------------------------------------------------------------------------
function TMsgDatabaseAccuracer.SaveMessage(
                     const Delivered:           Boolean; // for commands
                     const DeliveryDate:        TDateTime;
                     const SenderID,
                           RecipientID:         Cardinal;
                     const MessageType:         TMsgMessageType;
                     const SendingDate:         TDateTime;
                     const MessageData:         PChar; // binary o stream message data
                     const MessageDataSize:     Integer; // size of MessageData
                     const MessageText:         String; // text of the message
                     const MessageUnicodeText:  WideString; // unicode text of the message
                     const Command:             Cardinal = 0 // no command
                    ): Integer;

var DB:     TACRDatabase;
    Query:  TACRQuery;
    bOK:    Boolean;
    cnt:    Integer;
    s_del:  String;
    s_data: String;
    s_unicode: String;
    s_command: String;
    s_sending: String;
begin
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    Query.DatabaseName := DB.DatabaseName;
    if (Delivered) then
     s_del := 'TRUE,'+crlf+'TODATE('''+ConvertDateTimeToString(DeliveryDate)
              +''','''+GetDateFormat+'''),'+crlf
    else
     s_del := 'FALSE,'+crlf+'NULL,'+crlf;
    if (MessageDataSize = 0) then
     s_data := 'NULL,'+crlf
    else
     s_data := ':P_MessageData,'+crlf;
    if (MessageUnicodeText = '') then
     s_unicode := 'NULL'+crlf
    else
     s_unicode := ':P_MessageUnicodeText'+crlf;
    if (MessageType >= MsgLowestType) then
     s_command := IntToStr(Integer(Command))+','+crlf
    else
     s_command := 'NULL,'+crlf;
    s_sending := 'TODATE('''+ConvertDateTimeToString(SendingDate)+''','''+GetDateFormat+'''),'+crlf;
    Query.SQL.Text := 'INSERT INTO '+MessagesTableName+
                      ' (SenderID, RecipientID, SendingDate, Delivered, DeliveryDate,'+crlf+
                      ' MessageType, Command, MessageDataSize, MessageData,'+
                      ' MessageText, MessageUnicodeText) VALUES ('+crlf+
                      IntToStr(Integer(SenderID))+','+crlf+
                      IntToStr(Integer(RecipientID))+','+crlf+
                      s_sending+crlf+
                      s_del+
                      IntToStr(Byte(MessageType))+','+crlf+
                      s_command+
                      IntToStr(Integer(MessageDataSize))+','+crlf+
                      s_data+
                      AnsiQuotedStr(MessageText,'''')+','+crlf+
                      s_unicode+
                      ');';
    Query.Prepare;
    if (MessageDataSize > 0) then
     begin
      Query.ParamByName('P_MessageData').DataType := ftBlob;
      Query.ParamByName('P_MessageData').SetBlobData(MessageData,MessageDataSize);
     end;
    if (MessageUnicodeText <> '') then
     begin
      Query.ParamByName('P_MessageUnicodeText').DataType := ftWideString;
      Query.ParamByName('P_MessageUnicodeText').Value := MessageUnicodeText;
     end;
    bOK := False;
    cnt := DB.LockParams.RetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      StartTransaction(DB);
      try
       Query.ExecSQL;
       Query.SQL.Text := 'SELECT TOP 1 LASTAUTOINC('+MessagesTableName+',ID) FROM '+ MessagesTableName;
       Query.Open;
       Result := Query.Fields[0].AsInteger;
       DB.Commit(True);
       bOK := True;
      except
       DB.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11379,ErrorLSaveMessageFailed,
       [SenderID,RecipientID,Byte(MessageType),MessageText,MessageDataSize,DB.LockParams.RetryCount,DB.LockParams.Delay]);
  finally
    Query.Free;
    DB.Free;
  end;
end; // SaveMessage


//------------------------------------------------------------------------------
// set message delivery date = CURRENT_TIMESTAMP and delivered = true
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.SetMessageDeliveryDate(MessageID: Integer);
var DB:     TACRDatabase;
    Query:  TACRQuery;
    bOK:    Boolean;
    cnt:    Integer;
begin
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    Query.DatabaseName := DB.DatabaseName;
    Query.SQL.Text := 'UPDATE '+MessagesTableName+
                      ' SET Delivered = TRUE, DeliveryDate = CURRENT_TIMESTAMP'+
                      ' WHERE ID = '+IntToStr(MessageID);
    bOK := False;
    cnt := DB.LockParams.RetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      StartTransaction(DB);
      try
       Query.ExecSQL;
       DB.Commit(True);
       bOK := True;
      except
       DB.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11380,ErrorLSetMessageDeliveryDateFailed,
       [MessageID,DB.LockParams.RetryCount,DB.LockParams.Delay]);
  finally
    Query.Free;
    DB.Free;
  end;
end; // SetMessageDeliveryDate


//------------------------------------------------------------------------------
// delete message
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.DeleteMessage(MessageID: Integer);
var DB:     TACRDatabase;
    Query:  TACRQuery;
    bOK:    Boolean;
    cnt:    Integer;
begin
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    Query.DatabaseName := DB.DatabaseName;
    Query.SQL.Text := 'DELETE FROM '+MessagesTableName+
                      ' WHERE ID = '+IntToStr(MessageID);
    bOK := False;
    cnt := DB.LockParams.RetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      StartTransaction(DB);
      try
       Query.ExecSQL;
       DB.Commit(True);
       bOK := True;
      except
       DB.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11387,ErrorLDeleteMessageFailed,
       [MessageID,DB.LockParams.RetryCount,DB.LockParams.Delay]);
  finally
    Query.Free;
    DB.Free;
  end;
end; // DeleteMessage


//------------------------------------------------------------------------------
// return new query object with found messages from MsgMessages table
//------------------------------------------------------------------------------
function TMsgDatabaseAccuracer.FindMessages(
                         const MessageTextComparison:         TMsgTextComparison;
                         const MessageUnicodeTextComparison:  TMsgTextComparison;
                         const SendingDate:                   TMsgDateComparison;
                         const DeliveryDate:                  TMsgDateComparison;
                         const SearchDelivered:               Boolean;
                         const Delivered:                     Boolean = True;
                         // text of the message
                         const MessageText:                   String = '';
                         // unicode text of the message
                         const MessageUnicodeText:            WideString = '';
                         const SenderID:                      Cardinal = MSG_INVALID_USER_ID;
                         const RecipientID:                   Cardinal = MSG_INVALID_USER_ID;
                         const MessageType:                   TMsgMessageType = aamtNone;
                         // size of MessageData
                         const MessageDataSize:               Integer = -1;