msgclient.pas

来自「Delphi MsgCommunicator 2-10 component.I 」· PAS 代码 · 共 1,701 行 · 第 1/5 页

function TMsgClient.GetContact(Index: Integer): TMsgContactInfo;
begin
  if (Index >= 0) and (Index < Length(FContacts)) then
   Result := FContacts[Index]
  else
   begin
    FillChar(Result,SizeOf(Result),$00);
    Result.UserInfo.UserID := MSG_INVALID_USER_ID;
   end;
end; // GetContact


//------------------------------------------------------------------------------
// return contacts
//------------------------------------------------------------------------------
function TMsgClient.GetContactCount: Integer;
begin
  Result := Length(FContacts);
end; // GetContactCount


//------------------------------------------------------------------------------
// change user status
//------------------------------------------------------------------------------
procedure TMsgClient.ChangeUserStatus(const UserID: Cardinal; const Status: TMsgUserStatus);
var i: Integer;
begin
  for i := Low(FContacts) to High(FContacts) do
   if (FContacts[i].UserInfo.UserID = UserID) then
    FContacts[i].UserInfo.Status := Status;
end; // ChangeUserStatus


//------------------------------------------------------------------------------
// OnDisconnect
//------------------------------------------------------------------------------
procedure TMsgClient.OnDisconnect(Session: TMsgClientSession);
var
  Sessions:         TList;
  lSession:         TMsgClientSession;
  i:                Integer;
  DirectFound,
  Found:            Boolean;
begin
// search for connected sessions
  DirectFound := False;
  Found := False;
  Sessions:=FSessions.LockList;
  try
   for i:=Sessions.Count-1 downto 0 do
    begin
     lSession := Sessions.Items[i];
     if lSession.Connected then
      begin
       if not lSession.Direct then
         Found := True
       else
         if lSession.SessionID <> INVALID_SESSION_ID then
           DirectFound := True;
      end;
    end;
  finally
   FSessions.UnlockList;
  end;
  if (not DirectFound) then
    FConnectedDirectly := False;
// event
  if (Session = FDefaultServerSession)
  or (not Found)
  then
   begin
    if Connected then
     begin
      FConnected := False;
      FLogged := False;
      if Assigned(FOnServerShutdown) then
        FOnServerShutdown(Self);
     end;
   end;
end; // OnDisconnect


//------------------------------------------------------------------------------
// determine if user exists at server
//------------------------------------------------------------------------------
function TMsgClient.IsUserExisting(UserID: Cardinal): Integer;
begin
  Result := MSG_Error_IsUserExisting_NotConnected;
  if (Connected) then
   Result := FDefaultServerSession.IsUserExisting(UserID);
end;// IsUserExisting


//------------------------------------------------------------------------------
// determine if user is on-line now
//------------------------------------------------------------------------------
function TMsgClient.IsUserOnLine(UserID: Cardinal): Integer;
begin
  Result := MSG_Error_IsUserOnline_NotLogged;
  if not Logged then
    Exit;
  Result := MSG_Error_IsUserOnline_NotConnected;
  if (Connected) then
   Result := FDefaultServerSession.IsUserOnLine(UserID);
end;// IsUserOnLine


//------------------------------------------------------------------------------
// return MSG_COMMAND_OK and UserInfo if user exists, otherwise return error code
//------------------------------------------------------------------------------
function TMsgClient.GetUserInfo(UserID: Cardinal; var UserInfo: TMsgUserInfo): Integer;
var
  Sessions:         TList;
  Session:          TMsgClientSession;
  i:                Integer;
begin
  Result := MSG_Error_GetUserInfo_NotLogged;
  if not Logged then
    Exit;
  Result := MSG_Error_GetUserInfo_NotConnected;
  if (Connected) then
    Result := FDefaultServerSession.GetUserInfo(UserID,UserInfo)
  else
   begin // Peer-to-Peer
    Result := MSG_Error_GetUserInfo_UserDoesNotExist;
    Sessions:=FSessions.LockList;
    try
     for i:=0 to Sessions.Count-1 do
      begin
       Session := Sessions.Items[i];
       if Session.RemoteUser.UserID = UserID then
        begin
         UserInfo := Session.RemoteUser;
         Result := MSG_COMMAND_OK;
         break;
        end;
      end;
    finally
     FSessions.UnlockList;
    end;
   end;
end;// GetUserInfo


//------------------------------------------------------------------------------
// register new user at server
//------------------------------------------------------------------------------
function TMsgClient.RegisterNewUser(var UserInfo: TMsgUserInfo; Password: String): Integer;
begin
  Result := MSG_Error_RegisterNewUser_NotConnected;
  if (Connected) then
    Result := FDefaultServerSession.RegisterNewUser(UserInfo,Password);
end;// RegisterNewUser


//------------------------------------------------------------------------------
// UpdateUserInfo
//------------------------------------------------------------------------------
function TMsgClient.UpdateUserInfo(var UserInfo: TMsgUserInfo; ChangePassword: Boolean; Password: String): Integer;
begin
  Result := MSG_Error_UpdateUserInfo_NotLogged;
  if not Logged then
    Exit;
  Result := MSG_Error_UpdateUserInfo_NotConnected;
  if (Connected) then
    Result := FDefaultServerSession.UpdateUserInfo(UserInfo,ChangePassword,Password);
end;// UpdateUserInfo


//------------------------------------------------------------------------------
// add user to Contacts list of this client
//------------------------------------------------------------------------------
function TMsgClient.AddUserToContacts(
                               UserID:            Cardinal;
                               ContactNameSource: TMsgContactNameSource;
                               ContactCustomName: String
                              ): Integer;
var i,n,h:    Integer;
    UserInfo: TMsgUserInfo;
begin
  Result := MSG_Error_AddUserToContacts_NotLogged;
  if not Logged then
    Exit;
  Result := MSG_Error_AddUserToContacts_NotConnected;
  if (Connected) then
    Result := FDefaultServerSession.AddUserToContacts(UserID,UserInfo,ContactNameSource,ContactCustomName);
  if (Result = MSG_COMMAND_OK) then
   begin
    i := Length(FContacts);
    SetLength(FContacts,i+1);
    FContacts[i].UserInfo := UserInfo;
    FContacts[i].ContactNameSource := ContactNameSource;
    FContacts[i].ContactCustomName := ContactCustomName;
   end;
end;// AddUserToContacts


//------------------------------------------------------------------------------
// update user in Contacts list of this client
//------------------------------------------------------------------------------
function TMsgClient.UpdateUserInContacts(
                           UserID:            Cardinal;
                           ContactNameSource: TMsgContactNameSource = mcnsUserName;
                           ContactCustomName: String = ''
                          ): Integer;
var i,n,h:    Integer;
begin
  Result := MSG_Error_UpdateUserInContacts_NotLogged;
  if not Logged then
    Exit;
  Result := MSG_Error_UpdateUserInContacts_NotConnected;
  if (Connected) then
    Result := FDefaultServerSession.UpdateUserInContacts(UserID,ContactNameSource,ContactCustomName);
  if (Result = MSG_COMMAND_OK) then
   begin
    n := -1;
    h := High(FContacts);
    for i := Low(FContacts) to h do
     if (FContacts[i].UserInfo.UserID = UserID) then
      begin
       n := i;
       break;
      end;
    if (n >= 0) then
     begin
      FContacts[n].ContactNameSource := ContactNameSource;
      FContacts[n].ContactCustomName := ContactCustomName;
     end;
   end;
end; // UpdateUserInContacts


//------------------------------------------------------------------------------
// remove user from Contacts list of this client
//------------------------------------------------------------------------------
function TMsgClient.RemoveUserFromContacts(UserID: Cardinal): Integer;
var i,n,h: Integer;
begin
  Result := MSG_Error_RemoveUserFromContacts_NotLogged;
  if not Logged then
    Exit;
  Result := MSG_Error_RemoveUserFromContacts_NotConnected;
  if (Connected) then
    Result := FDefaultServerSession.RemoveUserFromContacts(UserID);
  if (Result = MSG_COMMAND_OK) then
   begin
    n := -1;
    h := High(FContacts);
    for i := Low(FContacts) to h do
     if (FContacts[i].UserInfo.UserID = UserID) then
      begin
       n := i;
       break;
      end;
    if (n >= 0) then
     begin
      for i := n+1 to h do
       FContacts[i-1] := FContacts[i];
      SetLength(FContacts,h);
     end;
   end;
end;// RemoveUserFromContacts


//------------------------------------------------------------------------------
// get list of Contacts of this client from all servers
//------------------------------------------------------------------------------
function TMsgClient.GetContacts: Integer;
begin
  Result := MSG_Error_GetContacts_NotLoggeed;
  if not Logged then
    Exit;
  Result := MSG_Error_GetContacts_NotConnected;
  if (Connected) then
    Result := FDefaultServerSession.GetContacts(FContacts);
end;// GetContactsList


//------------------------------------------------------------------------------
// find users
//------------------------------------------------------------------------------
function TMsgClient.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:                     String = '';
                    FirstName:                    String = '';
                    LastName:                     String = '';
                    Organization:                 String = '';
                    Department:                   String = '';
                    Host:                         String = '';
                    Application:                  String = '';
                    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 = ''
                   ): Integer;
var ms:  TMsgMemoryStream;
    len: Integer;
    s:   ShortString;
begin
  Result := MSG_Error_FindUsers_NotConnected;
  if (Connected) then
   begin
    ms := TMsgMemoryStream.Create;
    try
      SaveDataToStream(UserNameComparison,SizeOf(UserNameComparison),ms,11403);
      SaveDataToStream(FirstNameComparison,SizeOf(FirstNameComparison),ms,11404);
      SaveDataToStream(LastNameComparison,SizeOf(LastNameComparison),ms,11405);
      SaveDataToStream(OrganizationComparison,SizeOf(OrganizationComparison),ms,11406);
      SaveDataToStream(DepartmentComparison,SizeOf(DepartmentComparison),ms,11407);
      SaveDataToStream(ApplicationComparison,SizeOf(ApplicationComparison),ms,11408);
      SaveDataToStream(HostComparison,SizeOf(HostComparison),ms,11409);
      SaveDataToStream(PortComparison,SizeOf(PortComparison),ms,11410);
      SaveDataToStream(Status,SizeOf(Status),ms,11411);
      SaveDataToStream(UserID,SizeOf(UserID),ms,11412);
      // C++ Builder ShortString bug fix - replaced to string in v.2.10
      SaveStringToStream(UserName,ms,11413);
      SaveStringToStream(FirstName,ms,11414);
      SaveStringToStream(LastName,ms,11415);
      SaveStringToStream(Organization,ms,11416);
      SaveStringToStream(Department,ms,11417);
      SaveStringToStream(Host,ms,11418);
      SaveStringToStream(Application,ms,11419);
      SaveStringToStream(SearchCondition,ms,11546);
      SaveDataToStream(SortBy,SizeOf(SortBy),ms,11537);
      Sa