msgdatabaseaccuracer.pas

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

unit MsgDatabaseAccuracer;

interface

{$I MsgVer.inc}
{DEFINE DEBUG_DB_ACR}

uses

{$IFDEF MSWINDOWS}
Windows,
{$ENDIF}
{$IFDEF LINUX}
Libc,
{$ENDIF}

Classes,SysUtils,

Db,
MsgDatabase,
ACRMain,
ACRLocalEngine,

{$IFDEF DEBUG_LOG}
MsgDebug,
{$ENDIF}

MsgCompression,
MsgExcept,
MsgComBase,
MsgConst,
MsgTypes
;

// SQL script for creating all tables on server side (SQL syntax of Accuracer)
// on client only MsgMessages table needed for storing local message history
// SIGNEDINT32 = INTEGER
// UNSIGNEDINT8 = BYTE
// AUTOINC = INTEGER auto-increment counter
{
DROP TABLE MsgUsers CASCADE;
CREATE TABLE MsgUsers (
	ID SIGNEDINT32,
	UserName CHAR (255),
	FirstName CHAR (255),
	LastName CHAR (255),
	Organization CHAR (255),
	Department CHAR (255),
	Status UNSIGNEDINT8,
	Host CHAR (255),
	Port SIGNEDINT32,
	Application CHAR (255),
	CryptoHeader BLOB BLOBBLOCKSIZE 102400 BLOBCOMPRESSIONALGORITHM NONE BLOBCOMPRESSIONMODE 0,
PRIMARY KEY UsersPK (ID)
);

DROP TABLE MsgContacts CASCADE;
CREATE TABLE MsgContacts (
	OwnerID SIGNEDINT32,
	ContactID SIGNEDINT32,
	ContactNameSource UNSIGNEDINT8,
	ContactCustomName STRING (255),
PRIMARY KEY ContactsPK (OwnerID, ContactID)
);

DROP TABLE MsgMessages CASCADE;
CREATE TABLE MsgMessages (
	ID  AUTOINC (AUTOINC INITIALVALUE 0 INCREMENT 1 NOMINVALUE NOMAXVALUE NOCYCLED),
	SenderID SIGNEDINT32,
	RecipientID SIGNEDINT32,
	Delivered LOGICAL,
	DeliveryDate DATETIME,
	SendingDate DATETIME,
	MessageType UNSIGNEDINT8,
	Command SIGNEDINT32,
	MessageDataSize SIGNEDINT32,
	MessageData BLOB BLOBBLOCKSIZE 102400 BLOBCOMPRESSIONALGORITHM NONE BLOBCOMPRESSIONMODE 0,
	MessageText MEMO BLOBBLOCKSIZE 102400 BLOBCOMPRESSIONALGORITHM NONE BLOBCOMPRESSIONMODE 0,
	MessageUnicodeText WIDEMEMO BLOBBLOCKSIZE 102400 BLOBCOMPRESSIONALGORITHM NONE BLOBCOMPRESSIONMODE 0,
PRIMARY KEY MessagesPK (ID)
);

}

type

////////////////////////////////////////////////////////////////////////////////
//
// TMsgDatabaseAccuracer
//
////////////////////////////////////////////////////////////////////////////////

 TMsgDatabaseAccuracer = class (TMsgDatabase)
  private
   FDatabase: TACRDatabase;
   FCounter:  Int64;
  protected
   function GetTablesExists(HistoryOnly: Boolean): Boolean; override;
   procedure CreateTables(HistoryOnly: Boolean); override;
   procedure OpenDatabase; override;
   function CreateSessionDatabase: TACRDatabase;
   procedure StartTransaction(aDatabase: TACRDatabase);
   procedure GetInsertUserSQL(Query: TACRQuery; UserInfo: TMsgUserInfo; PasswordHeader: TMsgCryptoHeader);
   procedure GetUpdateUserSQL(Query: TACRQuery; UserInfo: TMsgUserInfo; ChangePassword: Boolean; PasswordHeader: TMsgCryptoHeader);
   function ExtractUserInfo(Dataset: TDataset): TMsgUserInfo;
  public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   procedure CloseDatabase; override;
   procedure AddUser(UserInfo: TMsgUserInfo; PasswordHeader: TMsgCryptoHeader); override;
   procedure RemoveUser(const UserID: Cardinal); override;
   procedure ChangeUserInfo(UserInfo: TMsgUserInfo; ChangePassword: Boolean; PasswordHeader: TMsgCryptoHeader); override;
   procedure ChangeUserStatus(
                               const AllUsers:    Boolean;
                               const UserID:      Cardinal;
                               const Status:      TMsgUserStatus;
                               const Host:        String = '';
                               const Port:        Integer = 0;
                               const Application: String = ''
                             ); override;
   function GetUserInfo(const UserID: Cardinal): TMsgUserInfo; override;
   function GetPasswordHeader(const UserID: Cardinal): TMsgCryptoHeader; override;
   function UserExists(const UserID: Cardinal): Boolean; override;
   procedure GetUsers(var Users: TMsgUserInfoArray; const SortBy: TMsgUserInfoArraySortBy; const Ascending: Boolean); override;
   procedure FindUsers(
                    var Users:                    TMsgUserInfoArray;
                    var UserNameComparison:       TMsgTextComparison;
                    var FirstNameComparison:      TMsgTextComparison;
                    var LastNameComparison:       TMsgTextComparison;
                    var OrganizationComparison:   TMsgTextComparison;
                    var DepartmentComparison:     TMsgTextComparison;
                    var ApplicationComparison:    TMsgTextComparison;
                    var HostComparison:           TMsgTextComparison;
                    var PortComparison:           TMsgIntegerComparison;
                    Status:                       TMsgUserStatus = msgNone;
                    UserID:                       Cardinal = MSG_INVALID_USER_ID;
                    UserName:                     ShortString = '';
                    FirstName:                    ShortString = '';
                    LastName:                     ShortString = '';
                    Organization:                 ShortString = '';
                    Department:                   ShortString = '';
                    Host:                         ShortString = '';
                    Application:                  ShortString = '';
                    SearchCondition:              String = ''; // SQL WHERE clause without word WHERE
                    // ORDER BY columns without ORDER BY words
                    // example: SenderID DESC, SendingDate ASC
                    SortBy:                       TMsgUserInfoArraySortBy = msgusbNone;
                    Ascending:                    Boolean = True;
                    OrderByClause:                String = ''
                       ); override;
   procedure GetUserContacts(const UserID: Cardinal; var Contacts: TMsgContactInfoArray); override;
   procedure AddUserToContacts(
                            const OwnerUserID:        Cardinal;
                            const ContactUserID:      Cardinal;
                            const ContactNameSource:  TMsgContactNameSource = mcnsUserName;
                            const ContactCustomName:  ShortString = ''
                              ); override;
   procedure UpdateUserInContacts(
                            const OwnerUserID:        Cardinal;
                            const ContactUserID:      Cardinal;
                            const ContactNameSource:  TMsgContactNameSource = mcnsUserName;
                            const ContactCustomName:  ShortString = ''
                              ); override;
   procedure RemoveUserFromContacts(const OwnerUserID: Cardinal; const ContactUserID: Cardinal); override;
   // saves message to database and returns MessageID
   function 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; override;
   procedure SetMessageDeliveryDate(MessageID: Integer); override;
   procedure DeleteMessage(MessageID: Integer); override;
   // return new query object with found messages from MsgMessages table
   function FindMessages(
                         const MessageTextComparison:         TMsgTextComparison;
                         const MessageUnicodeTextComparison:  TMsgTextComparison;
                         const SendingDate:                   TMsgDateComparison;
                         const DeliveryDate:                  TMsgDateComparison;
                         const SearchDelivered:               Boolean;
                         const Delivered:                     Boolean = True;
                         const MessageText:                   String = ''; // text of the message
                         const MessageUnicodeText:            WideString = ''; // unicode text of the message
                         const SenderID:                      Cardinal = MSG_INVALID_USER_ID;
                         const RecipientID:                   Cardinal = MSG_INVALID_USER_ID;
                         const MessageType:                   TMsgMessageType = aamtNone;
                         const MessageDataSize:               Integer = -1; // size of MessageData
                         const OrderBySendingDate:            Boolean = False;
                         const OrderByClause:                 String = '';
                         const Command:                       Cardinal = 0 // no command
                        ): TDataset; override;
  published
   property Database: TACRDatabase read FDatabase write FDatabase;
 end; // TMsgDatabaseAccuracer


////////////////////////////////////////////////////////////////////////////////
//
// TMsgTempTableAccuracer
//
////////////////////////////////////////////////////////////////////////////////


 TMsgTempTableAccuracer = class (TMsgTempTable)
  private
   FCompressionAlgorithm: TCompressionAlgorithm;
   FCompressionMode:      Byte;
   FBlockSize:            Integer;
  public
   constructor Create(AOwner: TComponent); override;
   procedure SaveDatasetToStream(Dataset: TDataset; Stream: TStream); override;
   procedure LoadDatasetFromStream(var Dataset: TDataset; Stream: TStream); override;
  published
   property CompressionAlgorithm: TCompressionAlgorithm read FCompressionAlgorithm write FCompressionAlgorithm;
   property CompressionMode: Byte read FCompressionMode write FCompressionMode;
   property BlockSize: Integer read FBlockSize write FBlockSize;
 end; // TMsgTempTable


 // convert dt to string constant using time stamp MM/DD/YYYY HH24:NN:SS
 function ConvertDateTimeToString(dt: TDateTime): String;
 function GetDateFormat: String;

implementation

{$IFDEF D6H}
uses DateUtils;
{$ELSE}
procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay,
  AHour, AMinute, ASecond, AMilliSecond: Word);
begin
  DecodeDate(AValue, AYear, AMonth, ADay);
  DecodeTime(AValue, AHour, AMinute, ASecond, AMilliSecond);
end;
{$ENDIF}


////////////////////////////////////////////////////////////////////////////////
//
// TMsgDatabaseAccuracer
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// Return true if all tables exists
//------------------------------------------------------------------------------
function TMsgDatabaseAccuracer.GetTablesExists(HistoryOnly: Boolean): Boolean;
begin
  Result := FDatabase.TableExists(MessagesTableName);
  if (Result and (not HistoryOnly)) then
   begin
    Result := FDatabase.TableExists(UsersTableName);
    if (Result) then
     begin
      Result := FDatabase.TableExists(ContactsTableName);
     end;
   end;
end; // GetTablesExists


//------------------------------------------------------------------------------
// Create Tables
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.CreateTables(HistoryOnly: Boolean);
var s:              String;
    MemoBlobParams: String;
    DataBlobParams: String;
    FQuery:         TACRQuery;
begin
 FQuery := TACRQuery.Create(nil);
 try
   FQuery.DatabaseName := FDatabase.DatabaseName;
   MemoBlobParams := '';
   DataBlobParams := '';
   if (not HistoryOnly) then
    begin
     if (FDatabase.TableExists(UsersTableName)) then
      s := 'DROP TABLE '+UsersTableName+';'+crlf
     else
      s := '';
     s := s+'CREATE TABLE '+UsersTableName + ' ('+crlf+
          // User unique ID
          'ID Integer, '+ crlf+
          'UserName Char(255),'+crlf+
          'FirstName Char(255),'+crlf+
          'LastName Char(255),'+crlf+
          'Organization Char(255),'+crlf+
          'Department Char(255),'+crlf+
          'Status Byte,'+crlf+
          'Host Char(255),'+crlf+
          'Port Integer,'+crlf+
          'Application Char(255),'+crlf+
          'CryptoHeader BLOB,'+crlf+
          'PRIMARY KEY UsersPK (ID)'+ crlf+
          ');'+crlf+
          'CREATE INDEX IDDescIndex ON '+UsersTableName+' (ID DESC);'+crlf+
          'CREATE INDEX UserNameIndex ON '+UsersTableName+' (UserName);'+crlf+
          'CREATE INDEX UserNameNoCaseIndex ON '+UsersTableName+' (UserName NOCASE);'+crlf+
          'CREATE INDEX FirstNameIndex ON '+UsersTableName+' (FirstName);'+crlf+
          'CREATE INDEX FirstNameNoCaseIndex ON '+UsersTableName+' (FirstName NOCASE);'+crlf+
          'CREATE INDEX LastNameIndex ON '+UsersTableName+' (LastName);'+crlf+
          'CREATE INDEX LastNameNoCaseIndex ON '+UsersTableName+' (LastName NOCASE);'+crlf+
          'CREATE INDEX OrganizationIndex ON '+UsersTableName+' (Organization);'+crlf+
          'CREATE INDEX DepartmentIndex ON '+UsersTableName+' (Department);'+crlf+
          'CREATE INDEX HostIndex ON '+UsersTableName+' (Host);'+crlf+
          'CREATE INDEX PortIndex ON '+UsersTableName+' (Port);'+crlf+
          'CREATE INDEX ApplicationIndex ON '+UsersTableName+' (Application);'+crlf+
          'CREATE INDEX StatusIndex ON '+UsersTableName+' (Status);'+crlf
          ;
     FQuery.SQL.Text := s;
     FQuery.ExecSQL;

     if (FDatabase.TableExists(ContactsTableName)) then
      s := 'DROP TABLE '+ContactsTableName+';'+crlf
     else
      s := '';
     s := s+'CREATE TABLE '+ContactsTableName + ' ('+crlf+
          // id in Users of the contact list owner
          'OwnerID Integer,'+crlf+
          // id in Users of the person in contact list
          'ContactID Integer,'+crlf+
          // source of the name: UserName, FirstName, LastName, FirstName LastName, Custom,  etc.
          'ContactNameSource Byte,'+crlf+
          // contact custom name
          'ContactCustomName Varchar(255),'+crlf+
          'PRIMARY KEY ContactsPK (OwnerID,ContactID)'+ crlf+
          ');'+crlf+
          'CREATE INDEX ContactIDIndex ON '+ContactsTableName+' (ContactID);'+crlf;
     FQuery.SQL.Text := s;
     FQuery.ExecSQL;
    end;