umemberlist.pas

msn控件 可验证 可接受信息 可发送信息 msn8协议 win32

unit UMemberList;
(* Msn Messenger 儊儞僶儕僗僩娭楢儐僯僢僩 *)

interface

uses
  SysUtils, Classes, UIntList;

type
  TMsnGroup = class ;
  TMsnMemberStatus = (usFLN, usNLN, usBSY, usIDL, usBRB, usAWY, usPHN, usLUN, usHDN);
  TMsnSortType = (stNone, stState, stName, stAccount);
  TMsnGroupEvent= procedure (Sender: TObject; Group: TMsnGroup) of Object;

  TMsnPassportInfo = record
    LoginTime: Integer;
    EmailEnabled: Boolean;
    MemberIdHigh: Integer;
    MemberIdLow: Integer;
    lang_preference: Integer;
    preferredEmail: String;
    country: String;
    PostalCode: String;
    Gender: String;
    Kid: Integer;
    Age: Integer;
    sid: Integer;
    kv: Integer;
    MSPAuth: String;
    ClientIP: String;
    ClientPort: Integer;
    sl: Integer;
  end;

  TMsnMemberBase = class
  private
    FAccount: String;
    FName: WideString;
    FStatus: TMsnMemberStatus;
    FMsnObj: String;
  public
    procedure Assign(Source: TMsnMemberBase);
    property Account: String read FAccount write FAccount;
    property Name: WideString read FName write FName;
    property Status: TMsnMemberStatus read FStatus write FStatus;
    property MsnObj: String read FMsnObj write FMsnObj;
  end;

  TMsnMember = class(TMsnMemberBase)
  private
    FGroups: TIntegerList;        // 僌儖乕僾
    FTyping: Boolean;             // 僞僀僺儞僌拞偐偳偆偐
    FTypingStartTime: TDateTime;  // 僞僀僺儞僌奐巒帪崗
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TMsnMemberBase);
    property Groups: TIntegerList read FGroups;
    property Typing: Boolean read FTyping write FTyping;
    property TypingStartTime: TDateTime read FTypingStartTime write FTypingStartTime;
  end;

  TMsnUser = class(TMsnMemberBase)
  private
    FPassword: String;      // 僷僗儚乕僪
    FPassportInfo: TMsnPassportInfo; // 僷僗億乕僩忣曬
  public
    procedure Assign(Source: TMsnMemberBase);
    property Password: String read FPassword write FPassword;
    property PassportInfo: TMsnPassportInfo read FPassportInfo;
  end;

  TMsnMemberList = class
  private
    FMembers: TList;
    FUpdated: Boolean;
    function GetMember(Index: Integer): TMsnMember;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    function Add: TMsnMember;
    function Insert(Idx: Integer): TMsnMember;
    procedure Move(CurIndex, NewIndex: Integer);
    procedure Delete(Idx: Integer);
    procedure Clear;
    function Find(Account: String): TMsnMember;
    function FindMemberByMail(Account: String): TMsnMember;
    function FindMailByAlias(Alias: String): string;

    function IndexOf(Account: String): Integer;
    function Contains(Account: String): Boolean;
    procedure Sort(SortType: TMsnSortType);

    property Members[Index: Integer]: TMsnMember read GetMember; default;
    property Count: Integer read GetCount;
    property Updated: Boolean read FUpdated write FUpdated;
    property List: TList read FMembers;
  end;

  TMsnGroup = class
  private
    FName: WideString;
    FId: Integer;
    FTag: Integer;
    FCount: Integer;
    FOnlineCount: Integer;
  public
    property Name: WideString read FName write FName;
    property Id: Integer read FId write FId;
    property Tag: Integer read FTag write FTag;
    property Count: Integer read FCount write FCount;
    property OnlineCount: Integer read FOnlineCount write FOnlineCount;
  end;

  TMsnGroupList = class
  private
    FGroups: TList;
    function GetGroup(Index: Integer): TMsnGroup;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;

    function Add: TMsnGroup;
    function Insert(Idx: Integer): TMsnGroup;
    procedure Move(CurIndex, NewIndex: Integer);
    procedure Delete(Idx: Integer);
    procedure Clear;
    function IndexOf(Id: Integer): Integer;

    property Groups[Index: Integer]: TMsnGroup read GetGroup; default;
    property Count: Integer read GetCount;
  end;

function StrToMemberStatus(Stat: String): TMsnMemberStatus;
function MemberStatusToStr(Stat: TMsnMemberStatus): String;

implementation

function CompareAccount(Item1, Item2: Pointer): Integer; forward;
function CompareState(Item1, Item2: Pointer): Integer; forward;
function CompareName(Item1, Item2: Pointer): Integer; forward;
function CompareGroupName(Item1, Item2: Pointer): Integer; forward;

// -----------------------------------------------------------------------------
procedure TMsnMemberBase.Assign(Source: TMsnMemberBase);
begin
  FAccount := Source.Account;
  FName := Source.Name;
  FStatus := Source.Status;
end;
// -----------------------------------------------------------------------------
constructor TMsnMember.Create;
begin
  inherited;
  FGroups := TIntegerList.Create;
end;

destructor TMsnMember.Destroy;
begin
  FGroups.Free;
  inherited;
end;

procedure TMsnMember.Assign(Source: TMsnMemberBase);
begin
  inherited;
  if Source is TMsnMember then
    FGroups.Assign(TMsnMember(Source).Groups);
end;
// -----------------------------------------------------------------------------
constructor TMsnMemberList.Create;
begin
  FMembers := TList.Create;
end;

destructor TMsnMemberList.Destroy;
begin
  Clear;
  FMembers.Free;
  inherited;
end;

function TMsnMemberList.GetMember(Index: Integer): TMsnMember;
begin
  Result := TMsnMember(FMembers[Index]);
end;

function TMsnMemberList.GetCount: Integer;
begin
  Result := FMembers.Count;
end;

function TMsnMemberList.Add: TMsnMember;
begin
  Result := TMsnMember.Create;
  FMembers.Add(Result);
end;

function TMsnMemberList.Insert(Idx: Integer): TMsnMember;
begin
  Result := TMsnMember.Create;
  FMembers.Insert(Idx, Result);
end;

procedure TMsnMemberList.Move(CurIndex, NewIndex: Integer);
begin
  FMembers.Move(CurIndex, NewIndex);
end;

procedure TMsnMemberList.Delete(Idx: Integer);
begin
  TMsnMember(FMembers[Idx]).Free;
  FMembers.Delete(Idx);
end;

procedure TMsnMemberList.Clear;
begin
  while FMembers.Count > 0 do
    Delete(0);
end;

function TMsnMemberList.Find(Account: String): TMsnMember;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FMembers.Count - 1 do
  begin
    if TMsnMember(FMembers[I]).Account = Account then
    begin
      Result := TMsnMember(FMembers[I]);
      Break;
    end;
  end;
end;


function TMsnMemberList.IndexOf(Account: String): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to FMembers.Count - 1 do
  begin
    if TMsnMember(FMembers[I]).Account = Account then
    begin
      Result := I;
      Break;
    end;
  end;
end;

function TMsnMemberList.Contains(Account: String): Boolean;
begin
  if IndexOf(Account) = -1 then
    Result := False
  else
    Result := True;
end;

procedure TMsnMemberList.Sort(SortType: TMsnSortType);
begin
  case SortType of
  stNone:
    Exit;
  stState:
    FMembers.Sort(CompareState);
  stName:
    FMembers.Sort(CompareName);
  stAccount:
    FMembers.Sort(CompareAccount);
  end;
end;

function CompareAccount(Item1, Item2: Pointer): Integer;
begin
  Result := CompareText(TMsnMember(Item1).Account, TMsnMember(Item2).Account);
end;

function CompareState(Item1, Item2: Pointer): Integer;
begin
  Result := Ord(TMsnMember(Item1).Status) - Ord(TMsnMember(Item2).Status);
  if Result = 0 then
    Result := CompareAccount(Item1, Item2);
end;

function CompareName(Item1, Item2: Pointer): Integer;
begin
  Result := CompareText(TMsnMember(Item1).Name, TMsnMember(Item2).Name);
  if Result = 0 then
    Result := CompareAccount(Item1, Item2);
end;
// -----------------------------------------------------------------------------

constructor TMsnGroupList.Create;
begin
  FGroups := TList.Create;
end;

destructor TMsnGroupList.Destroy;
begin
  Clear;
  FGroups.Free;
  inherited;
end;

function TMsnGroupList.GetGroup(Index: Integer): TMsnGroup;
begin
  Result := TMsnGroup(FGroups[Index]);
end;

function TMsnGroupList.GetCount: Integer;
begin
  Result := FGroups.Count;
end;

function TMsnGroupList.Add: TMsnGroup;
begin
  Result := TMsnGroup.Create;
  FGroups.Add(Result);
end;

function TMsnGroupList.Insert(Idx: Integer): TMsnGroup;
begin
  Result := TMsnGroup.Create;
  FGroups.Insert(Idx, Result);
end;

procedure TMsnGroupList.Move(CurIndex, NewIndex: Integer);
begin
  FGroups.Move(CurIndex, NewIndex);
end;

procedure TMsnGroupList.Delete(Idx: Integer);
begin
  TMSNGroup(FGroups[Idx]).Free;
  FGroups.Delete(Idx);
end;

procedure TMsnGroupList.Clear;
begin
  while FGroups.Count > 0 do
    Delete(0);
end;

function TMsnGroupList.IndexOf(Id: Integer): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to FGroups.Count - 1 do
  begin
    if TMSNGroup(FGroups[I]).Id = Id then
    begin
      Result := I;
      Break;
    end;
  end;
end;

function CompareGroupName(Item1, Item2: Pointer): Integer;
begin
  if (TMsnGroup(Item1).Id = 0) and (TMsnGroup(Item2).Id <> 0) then
    Result := 1
  else if (TMsnGroup(Item1).Id <> 0) and (TMsnGroup(Item2).Id = 0) then
    Result := -1
  else
    Result := CompareText(TMsnGroup(Item1).Name, TMsnGroup(Item2).Name);
  if Result = 0 then
    Result := TMsnGroup(Item1).Id - TMsnGroup(Item2).Id;
end;

// -----------------------------------------------------------------------------
function StrToMemberStatus(Stat: String): TMsnMemberStatus;
begin
  if Stat = 'NLN' then
    Result := usNLN
  else if Stat = 'BSY' then
    Result := usBSY
  else if Stat = 'IDL' then
    Result := usIDL
  else if Stat = 'BRB' then
    Result := usBRB
  else if Stat = 'AWY' then
    Result := usAWY
  else if Stat = 'PHN' then
    Result := usPHN
  else if Stat = 'LUN' then
    Result := usLUN
  else if Stat = 'HDN' then
    Result := usHDN
  else
    Result := usFLN;
end;

function MemberStatusToStr(Stat: TMsnMemberStatus): String;
begin
  case Stat of
    usNLN : Result := 'NLN';
    usBSY : Result := 'BSY';
    usIDL : Result := 'IDL';
    usBRB : Result := 'BRB';
    usAWY : Result := 'AWY';
    usPHN : Result := 'PHN';
    usLUN : Result := 'LUN';
    usFLN : Result := 'FLN';
    usHDN : Result := 'HDN';
  end;
end;

{ TMsnUser }

procedure TMsnUser.Assign(Source: TMsnMemberBase);
begin
  inherited Assign(Source);
  if Source is TMsnUser then
  begin
     FPassword := TMsnUser(Source).Password;
     FPassportInfo := TMsnUser(Source).PassportInfo;
  end;
end;

function TMsnMemberList.FindMemberByMail(Account: String): TMsnMember;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FMembers.Count - 1 do
  begin
    if TMsnMember(FMembers[I]).Account = Account then
    begin
      Result := TMsnMember(FMembers[I]);
      Break;
    end;
  end;
end;

function TMsnMemberList.FindMailByAlias(Alias: String): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to FMembers.Count - 1 do
  begin
    if TMsnMember(FMembers[I]).Account = Alias then
    begin
      Result := TMsnMember(FMembers[I]).Account;
      Break;
    end;
  end;
end;

end.