📄 msgdatabasemysql.pas
字号:
unit MsgDatabaseMySQL;
interface
{$I MsgVer.inc}
uses
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF}
{$IFDEF LINUX}
Libc,
{$ENDIF}
Classes,SysUtils,
Db,
MsgDatabase,
DBTables,
{$IFDEF D6H}
DBXpress, SqlExpr,
{$ENDIF}
{$IFDEF DEBUG_LOG}
MsgDebug,
{$ENDIF}
MsgCompression,
MsgExcept,
MsgComBase,
MsgConst,
MsgTypes
;
// SQL script for creating all tables on server side (SQL syntax of mySQL)
// on client only MsgMessages table needed for storing local message history
{
DROP TABLE MsgUsers CASCADE;
CREATE TABLE `msgusers` (
`ID` int(11) NOT NULL default '0',
`UserName` varchar(255) default NULL,
`FirstName` varchar(255) default NULL,
`LastName` varchar(255) default NULL,
`Organization` varchar(255) default NULL,
`Department` varchar(255) default NULL,
`Status` tinyint(3) unsigned default NULL,
`Host` varchar(255) default NULL,
`Port` int(11) default NULL,
`Application` varchar(255) default NULL,
`CryptoHeader` blob,
PRIMARY KEY (`ID`),
KEY `UserNameIndex` (`UserName`),
KEY `FirstNameIndex` (`FirstName`),
KEY `LastNameIndex` (`LastName`),
KEY `OrganizationIndex` (`Organization`),
KEY `DepartmentIndex` (`Department`),
KEY `HostIndex` (`Host`),
KEY `PortIndex` (`Port`),
KEY `ApplicationIndex` (`Application`),
KEY `StatusIndex` (`Status`)
) TYPE=MyISAM;
DROP TABLE MsgContacts CASCADE;
CREATE TABLE `msgcontacts` (
`OwnerID` int(11) NOT NULL default '0',
`ContactID` int(11) NOT NULL default '0',
`ContactNameSource` tinyint(3) unsigned default NULL,
`ContactCustomName` varchar(255) default NULL,
PRIMARY KEY (`OwnerID`,`ContactID`),
KEY `ContactIDIndex` (`ContactID`)
) TYPE=MyISAM;
DROP TABLE MsgMessages CASCADE;
CREATE TABLE `msgmessages` (
`ID` int(11) NOT NULL auto_increment,
`SenderID` int(11) default NULL,
`RecipientID` int(11) default NULL,
`Delivered` tinyint(3) unsigned default NULL,
`DeliveryDate` datetime default NULL,
`SendingDate` datetime default NULL,
`MessageType` tinyint(3) unsigned default NULL,
`Command` int(11) default NULL,
`MessageDataSize` int(11) default NULL,
`MessageData` longblob,
`MessageText` longtext,
PRIMARY KEY (`ID`)
) TYPE=MyISAM
}
type
////////////////////////////////////////////////////////////////////////////////
//
// TMsgMySQLQuery
//
////////////////////////////////////////////////////////////////////////////////
TMsgMySQLQuery = class (TComponent)
private
FNewSession: Boolean;
FDatabase: TDatabase;
FQuery: TQuery;
FSession: TSession;
FSQL: TStrings;
FParams: TParams;
{$IFDEF D6H}
FSQLConnection: TSQLConnection;
FSQLQuery: TSQLQuery;
FTransactionDesc: TTransactionDesc;
{$ENDIF}
protected
function GetRequestLive: Boolean;
procedure SetRequestLive(Value: Boolean);
procedure SetQuery(Value: TStrings);
procedure SetParamsList(Value: TParams);
procedure Prepare;
function ParamByName(const Value: string): TParam;
function GetDataset: TDataset;
function TableExists(const TableName: string): Boolean;
public
constructor Create(
AOwner: TComponent;
CreateNewSession: Boolean = False
);
destructor Destroy; override;
procedure StartTransaction;
procedure Commit;
procedure Rollback;
procedure ExecSQL;
public
property SQL: TStrings read FSQL;
property Params: TParams read FParams;
property Dataset: TDataset read GetDataset;
property RequestLive: Boolean read GetRequestLive write SetRequestLive;
end; // TMsgMySQLQuery
////////////////////////////////////////////////////////////////////////////////
//
// TMsgDatabaseMySQL
//
////////////////////////////////////////////////////////////////////////////////
TMsgDatabaseMySQL = class (TMsgDatabase)
private
FDatabase: TDatabase;
{$IFDEF D6H}
FSQLConnection: TSQLConnection;
{$ENDIF}
FDelay: Integer;
FRetryCount: Integer;
FTableType: String;
protected
procedure SetDatabase(Value: TDatabase);
{$IFDEF D6H}
procedure SetSQLConnection(Value: TSQLConnection);
{$ENDIF}
function GetTablesExists(HistoryOnly: Boolean): Boolean; override;
procedure CreateTables(HistoryOnly: Boolean); override;
procedure OpenDatabase; override;
procedure GetInsertUserSQL(Query: TMsgMySQLQuery; UserInfo: TMsgUserInfo; PasswordHeader: TMsgCryptoHeader);
procedure GetUpdateUserSQL(Query: TMsgMySQLQuery; 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: TDatabase read FDatabase write SetDatabase;
{$IFDEF D6H}
property SQLConnection: TSQLConnection read FSQLConnection write SetSQLConnection;
{$ENDIF}
property Delay: Integer read FDelay write FDelay;
property RetryCount: Integer read FRetryCount write FRetryCount;
property TableType: String read FTableType write FTableType;
end; // TMsgDatabaseMySQL
// convert dt to string constant using time stamp MM/DD/YYYY HH24:NN:SS
function ConvertDateTimeToString(dt: TDateTime): String;
procedure FixTableNames(sl: TStringList);
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}
////////////////////////////////////////////////////////////////////////////////
//
// TMsgMySQLQuery
//
////////////////////////////////////////////////////////////////////////////////
//------------------------------------------------------------------------------
// return request live
//------------------------------------------------------------------------------
function TMsgMySQLQuery.GetRequestLive: Boolean;
begin
if (FQuery <> nil) then
Result := FQuery.RequestLive
else
begin
{$IFDEF D6H}
if (FSQLQuery <> nil) then
Result := False;
{$ENDIF}
end;
end; // SetQuery
//------------------------------------------------------------------------------
// set request live
//------------------------------------------------------------------------------
procedure TMsgMySQLQuery.SetRequestLive(Value: Boolean);
begin
if (FQuery <> nil) then
FQuery.RequestLive := Value;
end; // SetQuery
//------------------------------------------------------------------------------
// Set query
//------------------------------------------------------------------------------
procedure TMsgMySQLQuery.SetQuery(Value: TStrings);
begin
if (FQuery <> nil) then
FQuery.SQL.Assign(Value)
else
begin
{$IFDEF D6H}
if (FSQLQuery <> nil) then
FSQLQuery.SQL.Assign(Value);
{$ENDIF}
end;
end; // SetQuery
//------------------------------------------------------------------------------
// Set params
//------------------------------------------------------------------------------
procedure TMsgMySQLQuery.SetParamsList(Value: TParams);
begin
if (FQuery <> nil) then
FQuery.Params.AssignValues(Value)
else
begin
{$IFDEF D6H}
if (FSQLQuery <> nil) then
FSQLQuery.Params.AssignValues(Value);
{$ENDIF}
end;
end; // SetParamsList
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -