msgdatabasemysql.pas

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

         Query.Rollback;
         raise EMsgException.Create(11363,ErrorLUserDoesNotExist,[UserInfo.UserID]);
       end;
      try
       Query.ExecSQL;
       Query.Commit;
       bOK := True;
      except
       Query.Rollback;
       Dec(cnt);
      end;
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11364,ErrorLChangeUserInfoTransactionFailed,
       [UserInfo.UserID,FRetryCount,FDelay]);
  finally
    Query.Free;
  end;
end; // ChangeUserInfo


//------------------------------------------------------------------------------
// ChangeUserStatus
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.ChangeUserStatus(
                           const AllUsers:    Boolean;
                           const UserID:      Cardinal;
                           const Status:      TMsgUserStatus;
                           const Host:        String = '';
                           const Port:        Integer = 0;
                           const Application: String = ''
                          );
var DB:      TDatabase;
    Query:   TMsgMySQLQuery;
    bOK:     Boolean;
    cnt,i:   Integer;
    s,w,a,h: String;
begin 
{$IFDEF DEBUG_DB_ACR}
aaWriteToLog('>TMsgDatabaseMySQL.ChangeUserStatus - UserID = '+IntToStr(UserID)+', Status = '+IntToStr(Byte(Status))); 
{$ENDIF}
  Query := TMsgMySQLQuery.Create(Self,True); 
  try
    if (Status = msgOffline) then
     s := crlf
    else
     begin 
      if (Application <> '') then
       a := StringReplace(Application,'\','\\',[rfReplaceAll])
      else
       a:= ''; 
      if (Host <> '') then
       h := StringReplace(Host,'\','\\',[rfReplaceAll]) 
      else 
       h:= '';
      s := ','+crlf+ 
          'Host = '+AnsiQuotedStr(h,'''')+','+crlf+ 
          'Port = '+IntToStr(Port)+','+crlf+ 
          'Application = '+AnsiQuotedStr(a,'''')+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 := FRetryCount;
    while (not bOK) and (cnt >= 0) do
     begin
      Query.StartTransaction; 
      if (not AllUsers) then 
       if (not UserExists(UserID)) then
        begin
         Query.Rollback;
         raise EMsgException.Create(11366,ErrorLUserDoesNotExist,[UserID]);
        end; 
      try 
       Query.ExecSQL; 
       Query.Commit; 
       bOK := True; 
      except
       Query.Rollback;
       Dec(cnt);
      end; 
     end;
    if (cnt < 0) then
     raise EMsgException.Create(11367,ErrorLChangeUserStatusTransactionFailed, 
       [UserID,FRetryCount,FDelay]); 
  finally
    Query.Free; 
  end;
{$IFDEF DEBUG_DB_ACR}
aaWriteToLog('<TMsgDatabaseMySQL.ChangeUserStatus - UserID = '+IntToStr(UserID)+', Status = '+IntToStr(Byte(Status)));
{$ENDIF} 
end; // ChangeUserStatus 
 
 
//------------------------------------------------------------------------------ 
// Get user info 
//------------------------------------------------------------------------------
function TMsgDatabaseMySQL.GetUserInfo(const UserID: Cardinal): TMsgUserInfo;
var DB:     TDatabase; 
    Query:  TMsgMySQLQuery;
begin
{$IFDEF DEBUG_DB_ACR}
aaWriteToLog('>TMsgDatabaseMySQL.GetUserInfo - UserID = '+IntToStr(UserID)); 
{$ENDIF} 
  Query := TMsgMySQLQuery.Create(Self,False);
  try 
    Query.RequestLive := True; 
    Query.SQL.Text := 'SELECT * FROM '+UsersTableName+' WHERE ID = '+IntToStr(UserID); 
    Query.Dataset.Open;
    Query.Dataset.First;
    if (not Query.Dataset.Eof) then 
     begin 
      Result := ExtractUserInfo(Query.Dataset); 
     end 
    else 
     Result.UserID := MSG_INVALID_USER_ID; 
  finally
    Query.Free; 
  end; 
{$IFDEF DEBUG_DB_ACR} 
aaWriteToLog('<TMsgDatabaseMySQL.GetUserInfo - UserID = '+IntToStr(UserID)+', UserInfo.UserID = '+IntToStr(Result.UserID)); 
{$ENDIF} 
end; // GetUserInfo 
 
 
//------------------------------------------------------------------------------ 
// Return PasswordHeader
//------------------------------------------------------------------------------
function TMsgDatabaseMySQL.GetPasswordHeader(const UserID: Cardinal): TMsgCryptoHeader;
var DB:     TDatabase;
    Query:  TMsgMySQLQuery; 
    bs:     TStream;
begin
{$IFDEF DEBUG_DB_ACR} 
aaWriteToLog('>MsgDatabaseAccuracer.GetPasswordHeader - UserID = '+IntToStr(UserID));
{$ENDIF}
  Query := TMsgMySQLQuery.Create(Self,False); 
  try 
    Query.RequestLive := True; 
    Query.SQL.Text := 'SELECT * FROM '+UsersTableName+' WHERE ID = '+IntToStr(UserID); 
    Query.Dataset.Open; 
    Query.Dataset.First; 
    if (not Query.Dataset.Eof) then 
     begin
      bs := query.Dataset.CreateBlobStream(Query.Dataset.FieldByName('CryptoHeader'),bmRead);
      try 
        bs.ReadBuffer(Result,SizeOf(Result));
      finally 
        bs.Free; 
      end;
     end 
    else
     raise EMsgException.Create(11401,ErrorLUserDoesNotExist,[UserID]); 
  finally 
    Query.Free;
  end;
{$IFDEF DEBUG_DB_ACR}
aaWriteToLog('<TMsgDatabaseMySQL.GetPasswordHeader - UserID = '+IntToStr(UserID)+', UserInfo.UserID = '+IntToStr(Result.UserID));
{$ENDIF}
end; // GetPasswordHeader


//------------------------------------------------------------------------------
// Return true if user exists
//------------------------------------------------------------------------------
function TMsgDatabaseMySQL.UserExists(const UserID: Cardinal): Boolean;
var
    Query:  TMsgMySQLQuery;
begin
  Query := TMsgMySQLQuery.Create(Self,False);
  try
    Query.RequestLive := True;
    Query.SQL.Text := 'SELECT * FROM '+UsersTableName+' WHERE ID = '+IntToStr(Integer(UserID));
    Query.Dataset.Open;
    Query.Dataset.First;
    Result := (not Query.Dataset.Eof);
  finally
    Query.Free;
  end;
end; // UserExists


//------------------------------------------------------------------------------
// Get users
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.GetUsers(var Users: TMsgUserInfoArray; const SortBy: TMsgUserInfoArraySortBy; const Ascending: Boolean);
var DB:     TDatabase;
    Query:  TMsgMySQLQuery;
    s,s1:   String;
    i:      Integer;
begin
  Query := TMsgMySQLQuery.Create(Self,False);
  try
    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.RequestLive := True;
    Query.SQL.Text := 'SELECT * FROM '+UsersTableName+' '+s;
    Query.Dataset.Open;
    i := 0;
    SetLength(Users,i);
    Query.Dataset.First;
    while (not Query.Dataset.Eof) do
     begin
      Inc(i);
      SetLength(Users,i);
      Users[i-1] := ExtractUserInfo(Query.Dataset);
      Query.Dataset.Next;
     end;
  finally
    Query.Free;
  end;
end; // GetUsers


//------------------------------------------------------------------------------
// find users
//------------------------------------------------------------------------------
procedure TMsgDatabaseMySQL.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:         TDatabase;
    Query:      TMsgMySQLQuery;
    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 = '+
                               AnsiQuotedStr(FirstName,'''')+')';
        end;
       mscmpStarts:
        begin
         if (FirstNameComparison.CaseInsensitive) then
          condition_FirstName := '(UPPER(FirstName) LIKE '+
                               AnsiQuotedStr(AnsiUpperCase(FirstName)+'%','''')+')'
         else
          condition_FirstName := '(FirstName LIKE '+
                               AnsiQuotedStr(FirstName+'%','''')+')';