msgdatabaseaccuracer.pas

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

//------------------------------------------------------------------------------
// ChangeUserStatus
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.ChangeUserStatus(
                           const AllUsers:    Boolean;
                           const UserID:      Cardinal;
                           const Status:      TMsgUserStatus;
                           const Host:        String = '';
                           const Port:        Integer = 0;
                           const Application: String = ''
                          );
var DB:     TACRDatabase;
    Query:  TACRQuery;
    bOK:    Boolean;
    cnt,i:  Integer;
    s,w:    String;
begin
{$IFDEF DEBUG_DB_ACR}
aaWriteToLog('>TMsgDatabaseAccuracer.ChangeUserStatus - UserID = '+IntToStr(UserID)+', Status = '+IntToStr(Byte(Status)));
{$ENDIF}
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    Query.DatabaseName := DB.DatabaseName;
    if (Status = msgOffline) then
     s := crlf
    else
     begin
     s := ','+crlf+
          'Host = '+AnsiQuotedStr(Host,'''')+','+crlf+
          'Port = '+IntToStr(Port)+','+crlf+
          'Application = '+AnsiQuotedStr(Application,'''')+crlf;
{ TODO : application bug fix }
     for i := 1 to Length(s) do
      if s[i] = #0 then
       s[i] := ' ';
     end;
    if (AllUsers) then
     w := ''
    else
     w := 'WHERE ID = '+IntToStr(Integer(UserID));
    Query.SQL.Text := 'UPDATE '+UsersTableName+' SET '+crlf+
                      'Status = '+IntToStr(Byte(Status))+s+w;
    bOK := False;
    cnt := DB.LockParams.RetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      StartTransaction(DB);
      if (not AllUsers) then
       if (not UserExists(UserID)) then
        begin
         DB.Rollback;
         raise EMsgException.Create(11366,ErrorLUserDoesNotExist,[UserID]);
        end;
      try
       Query.ExecSQL;
       DB.Commit(True);
       bOK := True;
      except
       DB.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11367,ErrorLChangeUserStatusTransactionFailed,
       [UserID,DB.LockParams.RetryCount,DB.LockParams.Delay]);
  finally
    Query.Free;
    DB.Free;
  end;
{$IFDEF DEBUG_DB_ACR}
aaWriteToLog('<TMsgDatabaseAccuracer.ChangeUserStatus - UserID = '+IntToStr(UserID)+', Status = '+IntToStr(Byte(Status)));
{$ENDIF}
end; // ChangeUserStatus


//------------------------------------------------------------------------------
// Get user info
//------------------------------------------------------------------------------
function TMsgDatabaseAccuracer.GetUserInfo(const UserID: Cardinal): TMsgUserInfo;
var DB:     TACRDatabase;
    Query:  TACRQuery;
begin
{$IFDEF DEBUG_DB_ACR}
aaWriteToLog('>TMsgDatabaseAccuracer.GetUserInfo - UserID = '+IntToStr(UserID));
{$ENDIF}
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    Query.DatabaseName := DB.DatabaseName;
    Query.RequestLive := True;
    Query.SQL.Text := 'SELECT * FROM '+UsersTableName+' WHERE ID = '+IntToStr(UserID);
    Query.Open;
    if (Query.RecordCount > 0) then
     begin
      Result := ExtractUserInfo(Query);
     end
    else
     Result.UserID := MSG_INVALID_USER_ID;
  finally
    Query.Free;
    DB.Free;
  end;
{$IFDEF DEBUG_DB_ACR}
aaWriteToLog('<TMsgDatabaseAccuracer.GetUserInfo - UserID = '+IntToStr(UserID)+', UserInfo.UserID = '+IntToStr(Result.UserID));
{$ENDIF}
end; // GetUserInfo


//------------------------------------------------------------------------------
// Return PasswordHeader
//------------------------------------------------------------------------------
function TMsgDatabaseAccuracer.GetPasswordHeader(const UserID: Cardinal): TMsgCryptoHeader;
var DB:     TACRDatabase;
    Query:  TACRQuery;
    bs:     TStream;
begin
{$IFDEF DEBUG_DB_ACR}
aaWriteToLog('>MsgDatabaseAccuracer.GetPasswordHeader - UserID = '+IntToStr(UserID));
{$ENDIF}
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    Query.DatabaseName := DB.DatabaseName;
    Query.RequestLive := True;
    Query.SQL.Text := 'SELECT * FROM '+UsersTableName+' WHERE ID = '+IntToStr(UserID);
    Query.Open;
    if (Query.RecordCount > 0) then
     begin
      bs := query.CreateBlobStream(Query.FieldByName('CryptoHeader'),bmRead);
      try
        bs.ReadBuffer(Result,SizeOf(Result));
      finally
        bs.Free;
      end;
     end
    else
     raise EMsgException.Create(11401,ErrorLUserDoesNotExist,[UserID]);
  finally
    Query.Free;
    DB.Free;
  end;
{$IFDEF DEBUG_DB_ACR}
aaWriteToLog('<TMsgDatabaseAccuracer.GetPasswordHeader - UserID = '+IntToStr(UserID)+', UserInfo.UserID = '+IntToStr(Result.UserID));
{$ENDIF}
end; // GetPasswordHeader


//------------------------------------------------------------------------------
// Return true if user exists
//------------------------------------------------------------------------------
function TMsgDatabaseAccuracer.UserExists(const UserID: Cardinal): Boolean;
var DB:     TACRDatabase;
    Query:  TACRQuery;
begin
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    Query.DatabaseName := DB.DatabaseName;
    Query.RequestLive := True;
    Query.SQL.Text := 'SELECT * FROM '+UsersTableName+' WHERE ID = '+IntToStr(Integer(UserID));
    Query.Open;
    Result := (Query.RecordCount > 0);
  finally
    Query.Free;
    DB.Free;
  end;
end; // UserExists


//------------------------------------------------------------------------------
// Get users
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.GetUsers(var Users: TMsgUserInfoArray; const SortBy: TMsgUserInfoArraySortBy; const Ascending: Boolean);
var DB:     TACRDatabase;
    Query:  TACRQuery;
    s,s1:   String;
    i:      Integer;
begin
  DB := CreateSessionDatabase;
  Query := TACRQuery.Create(nil);
  try
    DB.Open;
    if (Ascending) then
     s1 := ' ASC'
    else
     s1 := ' DESC';
    case SortBy of
    msgusbUserID: s := 'ORDER BY ID'+s1;
    msgusbUserName: s := 'ORDER BY UserName'+s1;
    msgusbFirstName: s := 'ORDER BY FirstName'+s1;
    msgusbLastName: s := 'ORDER BY LastName'+s1;
    msgusbStatus: s := 'ORDER BY Status'+s1;
    msgusbHost: s := 'ORDER BY Host'+s1;
    msgusbPort: s := 'ORDER BY Port'+s1;
    msgusbApplication: s := 'ORDER BY Application'+s1;
    else
     s := '';
    end;
    Query.DatabaseName := DB.DatabaseName;
    Query.RequestLive := True;
    Query.SQL.Text := 'SELECT * FROM '+UsersTableName+' '+s;
    Query.Open;
    SetLength(Users,Query.RecordCount);
    Query.First;
    i := 0;
    while (i < Length(Users)) and (not Query.Eof) do
     begin
      Users[i] := ExtractUserInfo(Query);
      Query.Next;
      Inc(i);
     end;
  finally
    Query.Free;
    DB.Free;
  end;
end; // GetUsers


//------------------------------------------------------------------------------
// find users
//------------------------------------------------------------------------------
procedure TMsgDatabaseAccuracer.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 = ''
                       );
var DB:         TACRDatabase;
    Query:      TACRQuery;
    s,s1:       String;
    i:          Integer;
    condition:  String; 
	
  function AddCondition(condition, newCondition: String): String; 
  begin
   if (newCondition <> '') then 
    begin
     if (condition = '') then
      Result := newCondition
     else
      Result := condition + ' AND '+ newCondition; 
    end
   else
    Result := condition;
  end; // AddCondition 
	
 function GetCondition: String; 
 var 
      condition_UserName:         String;
      condition_FirstName:        String; 
      condition_LastName:         String; 
      condition_Organization:     String; 
      condition_Department:       String;
      condition_Host:             String;
      condition_Application:      String;
      condition_Port:             String; 
      condition_Status:           String;
      condition_UserID:           String; 
 
 begin 
  Result := SearchCondition;
  if (Result = '') then
   begin 
    condition_UserName := ''; 
    condition_FirstName := '';
    condition_LastName := '';
    condition_Organization := '';
    condition_Department := '';
    condition_Host := '';
    condition_Port := ''; 
    condition_Application := ''; 
    condition_Status := '';
    condition_UserID := '';
    if (UserName <> '') then
      case UserNameComparison.Comparison of
       mscmpExact: 
        begin 
         if (UserNameComparison.CaseInsensitive) then 
          condition_UserName := '(UPPER(UserName) = '+ 
                               AnsiQuotedStr(AnsiUpperCase(UserName),'''')+')' 
         else
          condition_UserName := '(UserName = '+
                               AnsiQuotedStr(UserName,'''')+')';
        end; 
       mscmpStarts:
        begin
         if (UserNameComparison.CaseInsensitive) then 
          condition_UserName := '(UPPER(UserName) LIKE '+ 
                               AnsiQuotedStr(AnsiUpperCase(UserName)+'%','''')+')'
         else 
          condition_UserName := '(UserName LIKE '+
                               AnsiQuotedStr(UserName+'%','''')+')';
        end;
       mscmpContains: 
        begin 
         if (UserNameComparison.CaseInsensitive) then 
          condition_UserName := '(UPPER(UserName) LIKE '+ 
                               AnsiQuotedStr('%'+AnsiUpperCase(UserName)+'%','''')+')' 
         else 
          condition_UserName := '(UserName LIKE '+
                               AnsiQuotedStr('%'+UserName+'%','''')+')';
        end; 
      end; // UserName
    if (FirstName <> '') then
      case FirstNameComparison.Comparison of
       mscmpExact: 
        begin 
         if (FirstNameComparison.CaseInsensitive) then
          condition_FirstName := '(UPPER(FirstName) = '+ 
                               AnsiQuotedStr(AnsiUpperCase(FirstName),'''')+')' 
         else 
          condition_FirstName := '(FirstName = '+