unit RosterWindow;
{
    Copyright 2001, Peter Millard

    This file is part of Exodus.

    Exodus is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    Exodus is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with Exodus; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

interface

uses
  DropTarget, Unicode, XMLTag, Presence, Roster, commctrl, AnyQBase,  strutils,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, Buttons, ImgList, Menus, StdCtrls, Animate, GIFCtrl,
  ToolWin, RxHook, TntComCtrls;

const
  MapFileName = 'AnyQ_ROSTER';

type
  PMapRosterHead = ^TMapRosterHead;
  TMapRosterHead = packed record
    wFlag: Word;
    wSize: Word;
  end;

  TfrmRosterWindow = class(TAnyQBaseForm)
    popRoster: TPopupMenu;
    popProperties: TMenuItem;
    popRemove: TMenuItem;
    popChat: TMenuItem;
    popMsg: TMenuItem;
    N1: TMenuItem;
    StatBar: TStatusBar;
    popStatus: TPopupMenu;
    pnlShow: TPanel;
    pnlStatus: TPanel;
    presChat: TMenuItem;
    presAvailable: TMenuItem;
    presAway: TMenuItem;
    presXA: TMenuItem;
    presDND: TMenuItem;
    popClientInfo: TMenuItem;
    popVersion: TMenuItem;
    popTime: TMenuItem;
    popLast: TMenuItem;
    popHistory: TMenuItem;
    popPresence: TMenuItem;
    popSendPres: TMenuItem;
    popSendSubscribe: TMenuItem;
    popSendFile: TMenuItem;
    popActions: TPopupMenu;
    popAddContact: TMenuItem;
    popAddGroup: TMenuItem;
    N2: TMenuItem;
    popSendInvisible: TMenuItem;
    popGroup: TPopupMenu;
    popGrpPresence: TMenuItem;
    popGrpAvailable: TMenuItem;
    popGrpInvisible: TMenuItem;
    popGrpInvite: TMenuItem;
    N3: TMenuItem;
    popGrpRename: TMenuItem;
    popGrpRemove: TMenuItem;
    popSendContacts: TMenuItem;
    N4: TMenuItem;
    NewGroup1: TMenuItem;
    InvitetoConference1: TMenuItem;
    SendContactsTo1: TMenuItem;
    popBlock: TMenuItem;
    popGroupBlock: TMenuItem;
    BroadcastMessage1: TMenuItem;
    pnlConnect: TPanel;
    lblStatus: TLabel;
    lblLogin: TLabel;
    popBookmark: TPopupMenu;
    Join1: TMenuItem;
    Properties1: TMenuItem;
    Delete1: TMenuItem;
    N5: TMenuItem;
    popTransport: TPopupMenu;
    popTransLogoff: TMenuItem;
    popTransLogon: TMenuItem;
    N6: TMenuItem;
    popTransUnRegister: TMenuItem;
    popTransProperties: TMenuItem;
    lblStatusLink: TLabel;
    imgAd: TImage;
    popRename: TMenuItem;
    N7: TMenuItem;
    Panel1: TPanel;
    N8: TMenuItem;
    Image1: TImage;
    N9: TMenuItem;
    popGetShareList: TMenuItem;
    popInstantMail: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    Bevel1: TBevel;
    Panel2: TPanel;
    ImageList1: TImageList;
    Shape1: TShape;
    ToolBar2: TToolBar;
    imgStatus: TPaintBox;
    ToolButton6: TToolButton;
    M1: TMenuItem;
    A1: TMenuItem;
    V1: TMenuItem;
    aniWait: TRxGIFAnimator;
    Bevel2: TBevel;
    LvUsers: TListView;
    S1: TMenuItem;
    popMail: TMenuItem;
    pnlTask: TPanel;
    RxWindowHook1: TRxWindowHook;
    popTask: TPopupMenu;
    ImageList2: TImageList;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    tbOicq: TToolButton;
    tbIcq: TToolButton;
    tbMsn: TToolButton;
    tbAim: TToolButton;
    tbYahoo: TToolButton;
    N12: TMenuItem;
    BroadcastSMS: TMenuItem;
    popToolbutton: TPopupMenu;
    NAlogin: TMenuItem;
    NAlogout: TMenuItem;
    NACfg: TMenuItem;
    N16: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure pnlStatusClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure presAvailableClick(Sender: TObject);
    procedure Panel2DblClick(Sender: TObject);
    procedure popVersionClick(Sender: TObject);
    procedure popRosterPopup(Sender: TObject);
    procedure popPropertiesClick(Sender: TObject);
    procedure popRemoveClick(Sender: TObject);
    procedure popHistoryClick(Sender: TObject);
    procedure popChatClick(Sender: TObject);
    procedure popMsgClick(Sender: TObject);
    procedure popSendFileClick(Sender: TObject);
    procedure popAddContactClick(Sender: TObject);
    procedure popAddGroupClick(Sender: TObject);
    procedure popSendPresClick(Sender: TObject);
    procedure popSendSubscribeClick(Sender: TObject);
    procedure imgStatusPaint(Sender: TObject);
    procedure popGrpRenameClick(Sender: TObject);
    procedure popGrpRemoveClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure InvitetoConference1Click(Sender: TObject);
    procedure popGrpInviteClick(Sender: TObject);
    procedure popSendContactsClick(Sender: TObject);
    procedure popBlockClick(Sender: TObject);
    procedure BroadcastMessage1Click(Sender: TObject);
    procedure lblLoginClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure popTransLogoffClick(Sender: TObject);
    procedure popTransUnRegisterClick(Sender: TObject);
    procedure imgAdClick(Sender: TObject);
    procedure popRenameClick(Sender: TObject);
    procedure pluginClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure pnlConnectResize(Sender: TObject);
    procedure popGetShareListClick(Sender: TObject);
    procedure popInstantMailClick(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure pnlAnimationResize(Sender: TObject);
    procedure tbOicqClick(Sender: TObject);
    procedure tbIcqClick(Sender: TObject);
    procedure tbMsnClick(Sender: TObject);
    procedure tbAimClick(Sender: TObject);
    procedure tbYahooClick(Sender: TObject);
    procedure ToolBar2CustomDrawButton(Sender: TToolBar;
      Button: TToolButton; State: TCustomDrawState;
      var DefaultDraw: Boolean);
    procedure Panel1Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure M1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure V1Click(Sender: TObject);
    procedure LvUsersCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure LvUsersCustomDraw(Sender: TCustomListView;
      const ARect: TRect; var DefaultDraw: Boolean);
    procedure LvUsersResize(Sender: TObject);
    procedure LvUsersClick(Sender: TObject);
    procedure LvUsersInsert(Sender: TObject; Item: TListItem);
    procedure LvUsersCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure LvUsersContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure LvUsersDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure LvUsersDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure LvUsersKeyPress(Sender: TObject; var Key: Char);
    procedure LvUsersDblClick(Sender: TObject);
    procedure LvUsersChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure S1Click(Sender: TObject);
    procedure LvUsersInfoTip(Sender: TObject; Item: TListItem;
      var InfoTip: string);
    procedure popMailClick(Sender: TObject);
    procedure LvUsersStartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure RxWindowHook1BeforeMessage(Sender: TObject;
      var Msg: TMessage; var Handled: Boolean);
    procedure TaskClick(Sender: TObject);
    procedure pnlTaskResize(Sender: TObject);
    procedure TaskMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure TaskMenuClick(Sender: TObject);
    procedure popPopup(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BroadcastSMSClick(Sender: TObject);
    procedure popToolbuttonPopup(Sender: TObject);
    procedure NACfgClick(Sender: TObject);
    procedure NAlogoutClick(Sender: TObject);
    procedure NAloginClick(Sender: TObject);
  private
    { Private declarations }
    _rostercb: integer; // roster callback id
    _prescb: integer; // presence callback id
    _sessionCB: integer; // session callback id
    _FullRoster: boolean; // is this a full roster paint?
    _pos: TRect; // current position.. CRUFT??
    _task_collapsed: boolean;
    _show_status: boolean; // show inline status foo (bar) ?
    _status_color: TColor; // inline status font color

    _change_node: TListItem; // the current node being changed
    _bookmark: TListItem; // the Bookmarks container node

    _online: TListItem; // Special groups
    _away: TListItem;
    _xa: TListItem;
    _dnd: TListItem;
    _offline: TListItem;

    _myres: TListItem; // The My Resources node
    _hint_text: WideString; // the hint text for the current node

    _cur_ritem: TJabberRosterItem; // current roster item selected
    _cur_grp: Widestring; // current group selected
    _cur_bm: TJabberBookmark; // current bookmark selected
    _cur_myres: TJabberMyResource; // current My Resource selected
    _cur_status: integer; // current status for the current item

    _collapsed_grps: TWideStringList; // a list of collapsed grps
    _blockers: TWideStringlist; // current list of jids being blocked
    _adURL: string; // the URL for the ad graphic
    _transports: Widestring; // current group name for special transports grp
    _roster_unicode: boolean; // Use unicode chars in the roster?
    _collapse_all: boolean; // Collapse all groups by default?
    _group_counts: boolean;

    _show_pending: boolean;
    _show_online: boolean;
    _show_filter: integer;
    _sort_roster: boolean;
    _offline_grp: boolean;

    _drop_copy: boolean; // is the drag operation trying to copy?

    _drop: TExDropTarget;


    FNewWndProc: Pointer;
    FPrevWndProc: Pointer;

    procedure popUnBlockClick(Sender: TObject);
    procedure RenderItem(ritem: TJabberRosterItem; p: TJabberPres);
    procedure RenderBookmark(bm: TJabberBookmark);
    procedure RemoveItemNodes(ritem: TJabberRosterItem);
    procedure RemoveEmptyGroups();
    procedure ResetPanels;
    //procedure DoShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
    procedure showAniStatus();
    procedure DrawNodeText(Node: TTreeNode; State: TCustomDrawState; c1, c2: Widestring);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    // procedure WndProc(var Message: TMessage); override;

  published
    procedure onURLDrop(p: TPoint; url: Widestring);
    procedure ExpandGroup(grp: widestring);
    procedure CollapseGroup(grp: widestring);
    procedure DeleteGroup(grp: widestring);
    procedure UpdateGroup(grp: widestring);
    procedure ExpandMailGroup;
    procedure CollapseMailGroup;
    procedure UpdateMailGroup;
  public
    { Public declarations }
    DockOffset: longint;
    Docked: boolean;
    inMessenger: boolean;

    TaskButtons: array[0..7] of TButtonControl;

    procedure RosterCallback(event: string; tag: TXMLTag; ritem: TJabberRosterItem);
    procedure PresCallback(event: string; tag: TXMLTag; p: TJabberPres);
    procedure SessionCallback(event: string; tag: TXMLTag);
    procedure vcardCallback(event: string; tag: TXMLTag);


    procedure ChangeStatusImage(idx: integer);

    function getItemType(item: TListItem = nil): integer;

    procedure Redraw;
    procedure DockRoster;
    procedure FloatRoster;
    procedure ShowPresence(show: Widestring);

    function getSelectedContacts(online: boolean = true): TList;

    property CurRosterItem: TJabberRosterItem read _cur_ritem;
    property CurGroup: Widestring read _cur_grp;
    procedure initTask;
    procedure CheckTaskExpand;
    procedure PopTaskMenu;
  end;

var
  frmRosterWindow: TfrmRosterWindow;

procedure ForceAddrBook(JID, Nick, mail: widestring);
function GetMailAddr(JID: widestring): widestring;
procedure RefreshAddrBook;

resourcestring
  sRemoveBookmark = '删除这个地址?';
  sRenameGrp = '重命名组';
  sRenameGrpPrompt = '新建组:';
  sNoContactsSel = '您必须选择一个以上的联系人.';
  sUnblockContacts = '解除对联系人 %d 的阻止?';
  sBlockContacts = '阻止联系人 %d ?';
  sNoBroadcast = '您必须选择一个以上的联系人才能够广播消息.';
  sSignOn = '点击这里登录';
  sCancelLogin = '点击取消登录...';
  sDisconnected = '连接已断开.';
  sConnecting = '正在登录...'; //'正在连接...';
  sAuthenticating = '正在验证...'; //'已连接. '#13#10'正在验证用户名密码...';
  sAuthenticated = '正在验证...'; //'已通过验证.'#13#10'正在加载个人设置...';

  sBtnBlock = '阻止';
  sBtnUnBlock = '取消阻止';
  sMyResources = 'My Resources';

  sNetMeetingConnError = '网络不能连接，请检查网络设置.';


implementation
uses
  ExSession,
  JabberConst, Chat, ChatController, GnuGetText, InputPassword,
  SelContact, Invite, Bookmark, S10n, Transfer, MsgRecv, PrefController,
  ExEvents, ExUtils, Room, Profile, JabberID, RiserWindow, ShellAPI,
  IQ, RosterAdd, GrpRemove, RemoveContact, ChatWin, Jabber1,
  Transports, Session, SendContact, BroadcastMsg, msghistory, Types,
  GetShare, InstantMail, cfgtransport, GetContact, MailUnit, Math,
  GetHistory, Broadcastsms, XMLVCard;

{$R *.DFM}

var
  HMap: THandle;
  PMap: Pointer;
  FMapSize: Integer = 65536;

  sTasks: array[0..13] of string =
  ('我想...',
    '添加联系人',
    '开始对话',
    '发送文件或照片',
    '发起会议',
    '搜索联系人',
    '开始语音对话',
    '开始视频对话',
    '添加组',
    '发送邮件',
    '发送即时邮件',
    '启动白板',
    '',
    '其他'
    );

type
  TTaskButton = class(TButtonControl)
  private
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end;


function SlashSep(const Path, S: string): string;
begin
  if AnsiLastChar(Path)^ <> '\' then
    Result := Path + '\' + S
  else
    Result := Path + S;
end;

procedure ForceAddrBook(JID, Nick, Mail: widestring);
var
  sBook: TStringList;
  sAdd: TStringList;
  Status: Integer;
  SearchRec: TSearchRec;
  Checked: Boolean;
  procedure CheckAddr(fn: string);
  var
    i, p: Integer;
    tmps: string;
  begin
    sBook := TStringList.Create;
    sBook.LoadFromFile(fn);
    sAdd := TStringList.Create;
    sAdd.Delimiter := #30;
    try
      for i := 1 to sBook.Count - 1 do
      begin
        tmps := sBook[i];
        sadd.Clear;
        P := pos(#30, tmps);
        while P > 0 do
        begin
          sadd.add(copy(tmps, 1, p - 1));
          delete(tmps, 1, p);
          P := pos(#30, tmps);
        end;
        sadd.add(tmps);

        if sadd.Count < 32 then Continue;
        if sAdd[31] = JID then
        begin
          Checked := true;
          sAdd[0] := Nick;
          sAdd[1] := mail;
          sBook[i] := sAdd.DelimitedText;
          sBook.SaveToFile(fn);
          exit;
        end;
      end;
    finally
      sAdd.Free;
      sBook.Free;
    end;
  end;
  procedure AddAddr(fn: string);
  var
    i: Integer;
  begin
    sBook := TStringList.Create;
    if FileExists(fn) then
      sBook.LoadFromFile(fn)
    else
      sBook.add('');
    sAdd := TStringList.Create;
    sAdd.Delimiter := #30;
    for i := 0 to 31 do
      sAdd.add('');
    sAdd[0] := nick;
    sAdd[31] := jid;
    sAdd[1] := Mail;
    sBook.Add(sAdd.DelimitedText);
    sBook.SaveToFile(fn);
    sAdd.Free;
    sBook.Free;
  end;
begin
  ForceDirectories(SlashSep(ExtractFilePath(Application.ExeName), 'smail\Setting\Address'));
  Checked := false;
  Status := FindFirst(SlashSep(ExtractFilePath(Application.ExeName), 'smail\Setting\Address\*.ssr'), faAnyFile, SearchRec);
  try
    while Status = 0 do
    begin
      if (SearchRec.Attr and faDirectory <> faDirectory) then
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          CheckAddr(SlashSep(ExtractFilePath(Application.ExeName), 'smail\Setting\Address\' + SearchRec.Name));
          if Checked then exit;
        end;
      end;
      Status := FindNext(SearchRec);
    end;
    if not Checked then
    begin
      AddAddr(SlashSep(ExtractFilePath(Application.ExeName), 'smail\Setting\Address\AnyQ.ssr'));
    end;
  finally
    FindClose(SearchRec);
  end;
end;

function GetMailAddr(JID: widestring): widestring;
var
  sBook: TStringList;
  sAdd: TStringList;
  sMail: TStringList;
  Status: Integer;
  SearchRec: TSearchRec;
  Checked: Boolean;
  procedure CheckAddr(fn: string);
  var
    i, p: Integer;
    tmps: string;
  begin
    sBook := TStringList.Create;
    sBook.LoadFromFile(fn);
    sAdd := TStringList.Create;
    sAdd.Delimiter := #30;
    try
      for i := 1 to sBook.Count - 1 do
      begin
        tmps := sBook[i];
        sadd.Clear;
        P := pos(#30, tmps);
        while P > 0 do
        begin
          sadd.add(copy(tmps, 1, p - 1));
          delete(tmps, 1, p);
          P := pos(#30, tmps);
        end;
        sadd.add(tmps);
        if sadd.Count < 32 then Continue;
        if sAdd[31] = JID then
        begin
          sMail := TStringList.Create;
          sMail.CommaText := sAdd[1];
          if sMail.count > 0 then
            Result := sMail[0]
          else
            Result := sAdd[1];
          sMail.Free;
          Checked := true;
          exit;
        end;
      end;
    finally
      sAdd.Free;
      sBook.Free;
    end;
  end;
begin
  Result := jid;
  Checked := false;
  Status := FindFirst(SlashSep(ExtractFilePath(Application.ExeName), 'smail\Setting\Address\*.ssr'), faAnyFile, SearchRec);
  try
    while Status = 0 do
    begin
      if (SearchRec.Attr and faDirectory <> faDirectory) then
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          CheckAddr(SlashSep(ExtractFilePath(Application.ExeName), 'smail\Setting\Address\' + SearchRec.Name));
          if Checked then exit;
        end;
      end;
      Status := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
  end;
end;

procedure RefreshAddrBook;
var
  i: integer;
  ri: TJabberRosterItem;
begin
  for i := 0 to MainSession.roster.Count - 1 do
  begin
    ri := MainSession.roster.Items[i];
    if ri.jid.full = MainSession.Jid then
      Continue;
    if not ri.IsOnline then
      if ri.jid.jid = MainSession.BareJid then
        Continue;
    if ri.jid.user = '' then
      Continue;
    if ri.subscription = 'remove' then
      Continue;
//    ForceAddrBook(ri.jid.jid, ri.Nickname);
  end;
end;

procedure InitMap;
begin
  HMap := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, FMapSize, MapFileName);
  if HMap = INVALID_HANDLE_VALUE then
    exit;
  PMap := MapViewOfFile(HMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if PMap = nil then
  begin
    CloseHandle(HMap);
    HMap := INVALID_HANDLE_VALUE;
  end;
end;

procedure FreeMap;
begin
  if PMap<>nil then
    UnmapViewOfFile(PMap);
  PMap := nil;
  if HMap<>INVALID_HANDLE_VALUE then
    CloseHandle(HMap);
  HMap := INVALID_HANDLE_VALUE;
end;

procedure GroupMap(newsize: Integer);
var
  tmpbuf: array of byte;
begin
  setlength(tmpbuf, FMapSize);
  CopyMemory(@tmpbuf[0], PMap, FMapSize);
  UnmapViewOfFile(PMap);
  CloseHandle(HMap);
  FMapSize := newsize;
  InitMap;
  if PMap = nil then
    exit;
  CopyMemory(PMap, @tmpbuf[0], length(tmpbuf));
end;

procedure RefreshMap;
var
  i: integer;
  Count, offset: Integer;
  tmpBuf: array of byte;
  p: Pchar;
  ri: TJabberRosterItem;
  pres: TJabberPres;
  sTemp: string;
  RecHead: TMapRosterHead;
  rstatus: Byte;
begin
  setlength(tmpbuf, FMapSize);
  P := @tmpbuf[0];
//  PInteger(P)^ := MainSession.roster.Count;
  Count := 0;
  offset := 4;
  p := p + offset;
  RecHead.wFlag := $FFFF;
  for i := 0 to MainSession.roster.Count - 1 do
  begin
    ri := MainSession.roster.Items[i];
    if ri.jid.full = MainSession.Jid then
      Continue;
    if not ri.IsOnline then
      if ri.jid.jid = MainSession.BareJid then
        Continue;
    if ri.jid.user = '' then
      Continue;
    if ri.subscription = 'remove' then
      Continue;
    pres := MainSession.ppdb.FindPres(ri.JID.jid, '');
    sTemp := ri.jid.jid + #13 + #10 + ri.Nickname;

    rstatus := 0;
    if pres = nil then
      rstatus := 0
    else
      if pres.Show = 'away' then
        rstatus := 2
      else
        if pres.Show = 'xa' then
          rstatus := 3
        else
          if pres.Show = 'dnd' then
            rstatus := 4
          else
            rstatus := 1;

    RecHead.wSize := length(sTemp) + sizeof(rstatus);

    if offset + 4 + RecHead.wSize > FMapSize then
    begin
      setlength(tmpbuf, length(tmpbuf) + 32768);
      P := @tmpbuf[0];
      P := P + offset;
    end;

    PMapRosterHead(P)^ := RecHead;
    P := P + sizeof(TMapRosterHead);
    PByte(P)^ := rstatus;
    P := P + 1;
    Move(sTemp[1], P^, length(sTemp));
    P := P + length(sTemp);
    offset := offset + 4 + RecHead.wSize;
    inc(Count);
  end;
  Pinteger(@tmpbuf[0])^ := Count;
  if FMapSize < length(tmpbuf) then
    GroupMap(FMapSize + length(tmpbuf));
  CopyMemory(PMap, @tmpbuf[0], offset);
end;

{---------------------------------------}

procedure TfrmRosterWindow.FormCreate(Sender: TObject);
var
  s: widestring;
begin
  TranslateProperties(Self);
  LvUsers.DoubleBuffered := true;

    // register the callback
  _FullRoster := false;
  _collapsed_grps := TWideStringList.Create();
  _blockers := TWideStringlist.Create();
  _rostercb := MainSession.RegisterCallback(RosterCallback);
  _prescb := MainSession.RegisterCallback(PresCallback);
  _sessionCB := MainSession.RegisterCallback(SessionCallback, '/session');
  ChangeStatusImage(0);
  _pos.Left := (Screen.Width div 2) - 150;
  _pos.Right := _pos.Left + 200;
  _pos.Top := (Screen.Height div 3);
  _pos.Bottom := _pos.Top + 280;

  SessionCallback('/session/prefs', nil);
  _task_collapsed := false;
  _bookmark := nil;
  _online := nil;
  _away := nil;
  _xa := nil;
  _dnd := nil;
  _offline := nil;
  _myres := nil;
  _change_node := nil;
  _show_status := MainSession.Prefs.getBool('inline_status');
  _status_color := TColor(MainSession.Prefs.getInt('inline_color'));
  _transports := MainSession.Prefs.getString('roster_transport_grp');
  _roster_unicode := MainSession.Prefs.getBool('roster_unicode');
  _collapse_all := MainSession.Prefs.getBool('roster_collapsed');
  _group_counts := MainSession.Prefs.getBool('roster_groupcounts');

  _drop := TExDropTarget.Create();

  frmAnyQ.pnlRoster.ShowHint := not _show_status;

//    aniWait.Filename := '';
//    aniWait.ResName := 'Status';
  pnlConnect.Visible := true;
  pnlConnect.Align := alClient;

  lvUsers.Visible := false;
  pnlTask.Visible := lvUsers.Visible;
  pnlStatus.Visible := true;

  s := MainSession.Prefs.getString('brand_ad');
  if (s <> '') then begin
    imgAd.Picture.LoadFromFile(ExtractFilePath(Application.EXEName) + s);
    imgAd.Visible := true;
  end;
  _adURL := MainSession.Prefs.getString('brand_ad_url');
  if (_adURL <> '') then
    imgAd.Cursor := crHandPoint;

    //Application.ShowHint := true;
    //Application.OnShowHint := DoShowHint;
  initTask;
end;

{---------------------------------------}

procedure TfrmRosterWindow.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

{---------------------------------------}

procedure TfrmRosterWindow.CreateParams(var Params: TCreateParams);
begin
    // Make each window appear on the task bar.
  inherited CreateParams(Params);
  with Params do begin
    ExStyle := ExStyle or WS_EX_APPWINDOW;
  end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.ChangeStatusImage(idx: integer);
begin
  _cur_status := idx;
  imgStatus.Repaint();
end;

{---------------------------------------}
(*
procedure TfrmRosterWindow.DoShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
var
    c: TControl;
    f: TForm;
begin
    // show a hint..
    CanShow := false;
    c := HintInfo.HintControl;
    if (c.Owner is TForm) then
        f := TForm(c.Owner)
    else
        exit;

    exit;

    {
    This is kind of hackish because the application can only
    have a single OnShowHint handler at once.. *SIGH*
    We have this functionality so that TC rooms can also
    display status just like the roster window does.
    }

    if ((f = frmAnyQ) and (c = frmAnyQ.tbsRoster)) then begin
        // Tweak the hint properties for the roster,
        // this allows us to display custom hint text
        // which is set in the MouseMove event.
        CanShow := true;
        HintInfo.ReshowTimeout := 500;
        HintInfo.HintStr := _hint_text;
    end
    else if ((f is TfrmRoom) and (c is TTreeView)) then begin
        // this is a TC room
        CanShow := true;
        HintInfo.ReshowTimeout := 500;
        HintStr := TfrmRoom(f).HintText;
    end;
end;
*)

{---------------------------------------}

procedure TfrmRosterWindow.showAniStatus();
begin
    // show the status animation
  aniWait.Left := (pnlConnect.Width - aniWait.Width) div 2;
  aniWait.Visible := true;
  aniWait.Animate := true;
end;

{---------------------------------------}

procedure TfrmRosterWindow.SessionCallback(event: string; tag: TXMLTag);
var
  i: integer;
  grp_node: TTreeNode;
  ritem: TJabberRosterItem;
  b_jid: Widestring;
begin
    // catch session events
  if event = '/session/disconnected' then begin
    LvUsers.Clear;
//        ClearNodes();
    ShowPresence('offline');
    MainSession.Roster.GrpList.Clear();
    lvUsers.Visible := false;
    pnlTask.Visible := lvUsers.Visible;
    aniWait.Animate := false;
    aniWait.Visible := false;
    pnlConnect.Visible := true;
    pnlConnect.Align := alClient;
    lblStatus.Caption := sDisconnected;
    lblLogin.Caption := sSignOn;
    FreeMap;
  end

    // We are in the process of connecting
  else if event = '/session/connecting' then begin
    pnlConnect.Visible := true;
    pnlConnect.Align := alClient;
    lblStatus.Visible := true;
    lblStatus.Caption := sConnecting;
    lblLogin.Caption := sCancelLogin;
    Self.showAniStatus();
  end

    // we've got a socket connection
  else if event = '/session/connected' then begin
    lblLogin.Caption := sCancelLogin;
    lblStatus.Caption := sAuthenticating;
    Self.showAniStatus();
    ShowPresence('online');
    ResetPanels;
    InitMap;
  end

    // we've been authenticated
  else if event = '/session/authenticated' then begin
    lblLogin.Caption := sCancelLogin;
    lblStatus.Caption := sAuthenticated;
    Self.showAniStatus();
  end

    // it's the end of the roster, update the GUI
  else if event = '/roster/end' then begin
    if (not lvUsers.Visible) then begin
      aniWait.Animate := false;
      aniWait.Visible := false;
      pnlConnect.Visible := false;
      DisableAlign;
      lvUsers.Visible := true;
      pnlTask.Top := pnlStatus.Top - pnlTask.Height;
      pnlTask.Visible := lvUsers.Visible;
      EnableAlign;
    end;
  end

    // our own presence has changed
  else if event = '/session/presence' then begin
    ShowPresence(MainSession.show);
    imgStatus.Hint := MainSession.Status;
  end

    // preferences have been changed, refresh the roster
  else if event = '/session/prefs' then begin
    MainSession.Prefs.fillStringlist('blockers', _blockers);
    _show_status := MainSession.Prefs.getBool('inline_status');
    _status_color := TColor(MainSession.Prefs.getInt('inline_color'));
    _transports := MainSession.Prefs.getString('roster_transport_grp');
    _roster_unicode := MainSession.Prefs.getBool('roster_unicode');
    _collapse_all := MainSession.Prefs.getBool('roster_collapsed');
    _group_counts := MainSession.Prefs.getBool('roster_groupcounts');
    LvUsers.Font.Name := MainSession.Prefs.getString('roster_font_name');
    LvUsers.Font.Size := MainSession.Prefs.getInt('roster_font_size');
    LvUsers.Font.Color := TColor(MainSession.Prefs.getInt('roster_font_color'));
    LvUsers.Font.Charset := MainSession.Prefs.getInt('roster_font_charset');
    if (LvUsers.Font.Charset = 0) then
      LvUsers.Font.Charset := 1;

    pnlConnect.Color := TColor(MainSession.prefs.getInt('roster_bg'));
    lblStatus.Color := pnlConnect.Color;
//        aniWait.Color := pnlConnect.Color;

        // Iterate over all grp nodes
    MainSession.Prefs.fillStringlist('col_groups', _collapsed_grps);
    for i := 0 to MainSession.Roster.GrpList.Count - 1 do begin
      grp_node := TTreeNode(MainSession.Roster.GrpList.Objects[i]);
      if (grp_node <> nil) then begin
        if (_collapsed_grps.IndexOf(grp_node.Text) >= 0) then
          grp_node.Collapse(true)
        else if (not _collapse_all) then
          grp_node.Expand(true);
      end;
    end;

    _show_online := MainSession.Prefs.getBool('roster_only_online');
    _show_filter := MainSession.Prefs.getInt('roster_filter');
    if (_show_filter = show_offline) then begin
      _show_filter := show_dnd;
      MainSession.Prefs.setInt('roster_filter', _show_filter);
    end;

    _sort_roster := MainSession.Prefs.getBool('roster_sort');
    _show_pending := MainSession.Prefs.getBool('roster_show_pending');
    _offline_grp := MainSession.Prefs.getBool('roster_offline_group');

    frmAnyQ.pnlRoster.ShowHint := not _show_status;
    Redraw();
  end

    // someone has been blocked
  else if ((event = '/session/block') or (event = '/session/unblock')) then begin
        // re-render this jid if it's in our roster
    b_jid := tag.GetAttribute('jid');
    ritem := MainSession.Roster.Find(b_jid);
    if (ritem <> nil) then begin
      RenderItem(ritem, MainSession.ppdb.FindPres(b_jid, ''));
    end;
    MainSession.Prefs.fillStringlist('col_groups', _collapsed_grps);
  end

    // we are getting server side prefs
  else if event = '/session/server_prefs' then begin
  end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.RosterCallback(event: string; tag: TXMLTag; ritem: TJabberRosterItem);
var
  tmps: string;
  iq: TJabberIQ;

  tmpitem: TJabberRosterItem;
  p: TJabberPres;
  bi: integer;
  bm: TJabberBookmark;
  i: integer;
  bTransport: boolean;
begin
    // callback from the session
  if event = '/roster/start' then begin
    frmAnyQ.tabs.ActivePage := frmAnyQ.tbsRoster;
    _FullRoster := true;
    LvUsers.Items.BeginUpdate;
        // Don't clear the nodes here so mod_groups works ok..
        // maybe a better way to handle this??
        // ClearNodes();
  end
  else if event = '/roster/end' then begin
    if not MainSession.roster.GrpList.Find(sGrpUnfiled, i) then
      MainSession.roster.GrpList.Add(sGrpUnfiled);

    if (LvUsers.Items.Count = 0) or (LvUsers.Items[0].SubItems.Count < 2) or
      (LvUsers.Items[0].SubItems[1] <> 'mailstate') then
      with LvUsers.Items.Add do
      begin
        SubItems.Add('');
        SubItems.Add('mailstate');
        caption := '';
        ImageIndex := ico_right;
        Data := nil;
      end; {}

    for i := 0 to MainSession.roster.GrpList.Count - 1 do
    begin
      if MainSession.roster.GrpList[i] = _transports then
        continue;
      with LvUsers.Items.Add do
      begin
        SubItems.Add(MainSession.roster.GrpList[i]);
        caption := '';
        ImageIndex := ico_right;
        Data := nil;
      end;
    end;
    _FullRoster := false;
    Self.SessionCallback('/roster/end', nil);
    LvUsers.AlphaSort();
    LvUsers.Items.EndUpdate;

    if (not MainSession.Prefs.getBool('roster_collapsed')) then
    begin
      LvUsers.Items.BeginUpdate;
      for i := LvUsers.Items.Count - 1 downto 1 do
        Self.ExpandGroup(LvUsers.Items.item[i].SubItems[0]);
      LvUsers.Items.EndUpdate;
    end;
    RefreshMap;
    if LvUsers.Items.Count > 0 then
      LvUsers.Items.Item[0].MakeVisible(true);
  end
  else if event = '/roster/bookmark' then begin
    bi := MainSession.Roster.Bookmarks.indexOf(tag.getAttribute('jid'));
    if bi >= 0 then begin
      bm := TJabberBookmark(MainSession.roster.Bookmarks.Objects[bi]);
      RenderBookmark(bm);
    end;
  end
  else if event = '/roster/item' then begin
    if ritem <> nil then begin
      p := MainSession.ppdb.FindPres(ritem.JID.jid, '');
      tmpitem := MainSession.Roster.Find(ritem.jid.jid);
      if tmpitem<>nil then
        RenderItem(ritem, p);
      if ritem.jid.user = '' then
      begin
        tmpitem := MainSession.Roster.Find(ritem.jid.jid);
        bTransport := (MainSession.Roster.Find(ritem.jid.jid + '/registered') <> nil) or
          ((tmpitem<>nil) and (tmpitem.Groups.IndexOf(MainSession.Prefs.getString('roster_transport_grp')) >= 0));

        if pos('oicq.', ritem.jid.jid) = 1 then
          if bTransport then
          begin
            tbOicq.ImageIndex := 0;
            tbOicq.Tag := 1;
            tbOicq.PopupMenu := popToolbutton;
          end
          else
            tbOicq.ImageIndex := 5;
        if pos('icq.', ritem.jid.jid) = 1 then
          if bTransport then
          begin
            tbicq.ImageIndex := 1;
            tbicq.Tag := 1;
            tbicq.PopupMenu := popToolbutton;
          end
          else
            tbicq.ImageIndex := 6;
        if pos('msn.', ritem.jid.jid) = 1 then
          if bTransport then
          begin
            tbMsn.ImageIndex := 2;
            tbMsn.Tag := 1;
            tbMsn.PopupMenu := popToolbutton;
          end
          else
            tbMsn.ImageIndex := 7;
        if pos('aim.', ritem.jid.jid) = 1 then
          if bTransport then
          begin
            tbaim.ImageIndex := 3;
            tbaim.Tag := 1;
            tbaim.PopupMenu := popToolbutton;
          end
          else
            tbaim.ImageIndex := 8;
        if pos('yahoo.', ritem.jid.jid) = 1 then
          if bTransport then
          begin
            tbyahoo.ImageIndex := 4;
            tbyahoo.Tag := 1;
            tbyahoo.PopupMenu := popToolbutton;
          end
          else
            tbyahoo.ImageIndex := 9;
      end;

//            Refreshuse(ritem, p);
{        if ritem.jid.jid<>MainSession.BareJid then
          if ritem.jid.user<>'' then
            ForceAddrBook(ritem.jid.jid, ritem.Nickname);{}

      if ritem.RcvVcard then exit;
      tmps := MainSession.generateID();
      iq := TJabberIQ.Create(MainSession, tmps, vcardCallback);
      iq.Namespace := 'vcard-temp';
      iq.qTag.Name := 'vCard';
      iq.iqType := 'get';
      iq.toJid := ritem.jid.jid;
      iq.Send;
    end;
  end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.RenderBookmark(bm: TJabberBookmark);
begin
  //取消该功能
end;

{---------------------------------------}

function TfrmRosterWindow.getSelectedContacts(online: boolean = true): TList;
var
  c, i, j: integer;
  ri: TJabberRosterItem;
  node: TListItem;
  ntype: integer;
  glist: TList;
begin
    // return a list of the selected roster items
  Result := TList.Create();

  case getItemType() of
    item_ritem:
      begin
        if (((online) and (_cur_ritem.IsOnline)) or (not online)) then
          Result.Add(_cur_ritem);
      end;
    item_grp:
      begin
          // add all online contacts in this grp to the Result list
        node := LvUsers.Selected;
        ntype := getitemType(node);
        if (ntype = item_ritem) then begin
            // add this roster item to the selection
          ri := TJabberRosterItem(node.Data);
          if (((online) and (ri.IsOnline)) or (not online)) then
            Result.Add(TJabberRosterItem(node.Data));
        end
        else if (ntype = item_grp) then begin
            // add this grp to the selection
          glist := MainSession.roster.GetGroupItems(node.SubItems[0], online);
          for j := 0 to glist.count - 1 do
            Result.Add(TJabberRosterItem(glist[j]));
          glist.Free();
        end;
      end;
  end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.Redraw;
var
  i: integer;
  ri: TJabberRosterItem;
  bm: TJabberBookmark;
  p: TJabberPres;
  grp_node: TListItem;
begin
    // Make sure we have current settings
    // SessionCallback('/session/prefs', nil);

    // loop through all roster items and draw them
  _FullRoster := true;
  LvUsers.Color := TColor(MainSession.prefs.getInt('roster_bg'));
  LvUsers.Clear;
  LvUsers.Items.BeginUpdate;

  with LvUsers.Items.Add do
  begin
    SubItems.Add('');
    SubItems.Add('mailstate');
    caption := '';
    ImageIndex := ico_right;
    Data := nil;
  end;

  for i := 0 to MainSession.roster.GrpList.Count - 1 do
  begin
    if MainSession.roster.GrpList[i] = _transports then
      continue;
    with LvUsers.Items.Add do
    begin
      SubItems.Add(MainSession.roster.GrpList[i]);
      caption := '';
      ImageIndex := ico_right;
      Data := nil;
    end;
  end;

    // re-render each item
  with MainSession.Roster do begin
    for i := 0 to Count - 1 do begin
      ri := TJabberRosterItem(Objects[i]);
      p := MainSession.ppdb.FindPres(ri.JID.jid, '');
      RenderItem(ri, p);
    end;
  end;
  _FullRoster := false;

  LvUsers.AlphaSort();
  for i := LvUsers.Items.Count - 1 downto 1 do
    Self.ExpandGroup(LvUsers.Items.item[i].SubItems[0]);
  if LvUsers.Items.Count > 0 then
    LvUsers.Items.Item[0].MakeVisible(true);
  LvUsers.Items.EndUpdate;
end;

{---------------------------------------}

procedure TfrmRosterWindow.PresCallback(event: string; tag: TXMLTag; p: TJabberPres);
var
  ritem, tmpitem: TJabberRosterItem;
  jid, ptype: Widestring;
  tmp_jid: TJabberID;
  bTransport: boolean;
begin
    // callback for the ppdb
  if (event = '/presence/error') then
        // ignore
    exit;

  ptype := tag.getAttribute('type');
  jid := tag.getAttribute('from');
  tmp_jid := TJabberID.Create(jid);
  jid := tmp_jid.jid;

    // this should always work for normal items
  ritem := MainSession.Roster.Find(jid);

    // if we can't find the item based on bare jid, check the full jid.
    // NB: this should catch most of the transport madness.
  if (ritem = nil) then begin
    jid := tmp_jid.full;
    ritem := MainSession.Roster.Find(tmp_jid.full);
  end;

    // if we still don't have a roster item,
    // and we have no username portion of the JID, then
    // check for jid/registered for more transport madness

  if (event = '/presence/offline') then begin
        // remove the node
    if ((ritem <> nil) and (ritem.jid.jid <> MainSession.BareJid)) then
      p := MainSession.PPDB.FindPres(jid, '');
    if (ritem <> nil) then
    begin
      tmpItem := MainSession.Roster.Find(tmp_jid.jid);
      bTransport := (MainSession.Roster.Find(tmp_jid.jid + '/registered') <> nil) or {}
        ((tmpItem<>nil) and (tmpItem.Groups.IndexOf(MainSession.Prefs.getString('roster_transport_grp')) >= 0));
      if not bTransport and (tmpItem=nil) then
        exit;
  {
      ritem := MainSession.Roster.Find(tmp_jid.jid);
      bTransport := (MainSession.Roster.Find(tmp_jid.jid + '/registered') <> nil) or
        (ritem.Groups.IndexOf(MainSession.Prefs.getString('roster_transport_grp')) >= 0);
  {}
      if bTransport then
      begin
        if pos('oicq.', ritem.jid.jid) = 1 then
          tbOicq.ImageIndex := 5;
        if pos('icq.', ritem.jid.jid) = 1 then
          tbicq.ImageIndex := 6;
        if pos('msn.', ritem.jid.jid) = 1 then
          tbMsn.ImageIndex := 7;
        if pos('aim.', ritem.jid.jid) = 1 then
          tbaim.ImageIndex := 8;
        if pos('yahoo.', ritem.jid.jid) = 1 then
          tbyahoo.ImageIndex := 9;
      end;

      RenderItem(ritem, p);
    end;
  end
  else if (ritem <> nil) then begin
        // possibly re-render the node based on this pres packet
    if (tmp_jid.user = '')  then begin
  //        jid := tmp_jid.jid + '/registered';
      tmpItem := MainSession.Roster.Find(tmp_jid.jid);
      bTransport := (MainSession.Roster.Find(tmp_jid.jid + '/registered') <> nil) or {}
        ((tmpItem<>nil) and (tmpItem.Groups.IndexOf(MainSession.Prefs.getString('roster_transport_grp')) >= 0));
      if not bTransport and (tmpItem=nil) then
        exit;
  {
      ritem := MainSession.Roster.Find(tmp_jid.jid);
      bTransport := (MainSession.Roster.Find(tmp_jid.jid + '/registered') <> nil) or
        (ritem.Groups.IndexOf(MainSession.Prefs.getString('roster_transport_grp')) >= 0);
  {}
      if pos('oicq.', ritem.jid.jid) = 1 then
        if bTransport then
        begin
          tbOicq.ImageIndex := 0;
          tbOicq.PopupMenu := popToolbutton;
        end
        else
          tbOicq.ImageIndex := 5;
      if pos('icq.', ritem.jid.jid) = 1 then
        if bTransport then
        begin
          tbicq.ImageIndex := 1;
          tbicq.PopupMenu := popToolbutton;
        end
        else
          tbicq.ImageIndex := 6;
      if pos('msn.', ritem.jid.jid) = 1 then
        if bTransport then
        begin
          tbMsn.ImageIndex := 2;
          tbMsn.PopupMenu := popToolbutton;
        end
        else
          tbMsn.ImageIndex := 7;
      if pos('aim.', ritem.jid.jid) = 1 then
        if bTransport then
        begin
          tbaim.ImageIndex := 3;
          tbaim.PopupMenu := popToolbutton;
        end
        else
          tbaim.ImageIndex := 8;
      if pos('yahoo.', ritem.jid.jid) = 1 then
        if bTransport then
        begin
          tbyahoo.ImageIndex := 4;
          tbyahoo.PopupMenu := popToolbutton;
        end
        else
          tbyahoo.ImageIndex := 9;
    end;

    if (ritem.jid.jid <> MainSession.BareJid) then
      p := MainSession.ppdb.FindPres(tmp_jid.jid, '');
    RenderItem(ritem, p);
  end;

  tmp_jid.Free();
end;

{---------------------------------------}

procedure TfrmRosterWindow.RemoveItemNodes(ritem: TJabberRosterItem);
begin
  //也是用不着
end;

{---------------------------------------}

procedure TfrmRosterWindow.RemoveEmptyGroups();
var
  i: integer;
  node: TTreeNode;
begin
{    // scan for any empty grps
    for i := MainSession.Roster.GrpList.Count - 1 downto 0 do begin
        node := TTreeNode(MainSession.Roster.GrpList.Objects[i]);
        if ((node <> nil) and (node.Count = 0)) then
            RemoveGroupNode(node);
    end;{}
end;

{---------------------------------------}

procedure TfrmRosterWindow.pnlStatusClick(Sender: TObject);
//var
//    cp : TPoint;
begin
//    // popup the menu and to change our status
//    if MainSession.Active then begin
//        GetCursorPos(cp);
//        popStatus.Popup(cp.x, cp.y);
//    end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.DockRoster;
begin
    // dock the window to the main form
  StatBar.Visible := false;
  if (MainSession.Prefs.GetBool('roster_messenger')) then begin
    Self.ManualDock(frmAnyQ.pnlRoster, nil, alClient);
    inMessenger := true;
  end
  else begin
    Self.ManualDock(frmAnyQ.pnlLeft, nil, alClient);
    inMessenger := false;
  end;
  Self.Align := alClient;
  Docked := true;
  MainSession.dock_windows := Docked;

  _drop.DropEvent := onURLDrop;
  _drop.start(LvUsers);
end;

{---------------------------------------}

procedure TfrmRosterWindow.FloatRoster;
begin
    // float the window
  Self.Align := alNone;
  Self.ManualFloat(_pos);
  StatBar.Visible := true;
  Docked := false;
  MainSession.dock_windows := Docked;
end;

{---------------------------------------}

procedure TfrmRosterWindow.FormResize(Sender: TObject);
begin
    // save the pos info in _pos
  _pos.left := Self.Left;
  _pos.Right := Self.Left + Self.Width;
  _pos.Top := Self.Top;
  _pos.Bottom := Self.Top + Self.Height;
  LvUsers.Columns.Items[0].Width := LvUsers.Width - 20;
  LvUsers.Invalidate;
end;

{---------------------------------------}

procedure TfrmRosterWindow.ShowPresence(show: Widestring);
begin
    // display this show type
  if show = 'chat' then begin
    lblStatusLink.Caption := ' [' + sRosterChat + ']';
    ChangeStatusImage(ico_Chat);
  end
  else if show = 'away' then begin
    lblStatusLink.Caption := ' [' + sRosterAway + ']';
    ChangeStatusImage(ico_Away);
  end
  else if show = 'xa' then begin
    lblStatusLink.Caption := ' [' + sRosterXA + ']';
    ChangeStatusImage(ico_XA);
  end
  else if show = 'dnd' then begin
    lblStatusLink.Caption := ' [' + sRosterDND + ']';
    ChangeStatusImage(ico_DND);
  end
  else if show = 'offline' then begin
    lblStatusLink.Caption := ' [' + sRosterOffline + ']';
    ChangeStatusImage(ico_Offline);
  end
  else begin
    lblStatusLink.Caption := ' [' + sRosterAvail + ']';
    ChangeStatusImage(ico_Online);
  end;
  if MainSession.Status <> '' then
    lblStatusLink.Caption := ' [' + MainSession.Status + ']';
end;

{---------------------------------------}

procedure TfrmRosterWindow.presAvailableClick(Sender: TObject);
var
  show: Widestring;
begin
    // change our own presence
  case TMenuItem(Sender).Tag of
    0: begin
        show := 'chat';
      end;
    1: begin
        show := '';
      end;
    2: begin
        show := 'away';
      end;
    3: begin
        show := 'xa';
      end;
    4: begin
        show := 'dnd';
      end;
  end;
  MainSession.Invisible := false;
  MainSession.setPresence(show, '', MainSession.Priority);
end;

{---------------------------------------}

procedure TfrmRosterWindow.Panel2DblClick(Sender: TObject);
begin
    // reset status to online;
  ShowPresence('online');
  MainSession.setPresence('', sRosterAvail, MainSession.Priority);
end;

{---------------------------------------}

procedure TfrmRosterWindow.popVersionClick(Sender: TObject);
var
  jid: Widestring;
  p: TJabberPres;
begin
    // send a client info request
  jid := '';
  case (getitemType()) of
    item_ritem: begin
        if (_cur_ritem = nil) then exit;
        p := MainSession.ppdb.FindPres(_cur_ritem.jid.jid, '');
        if p = nil then
            // this person isn't online.
          jid := _cur_ritem.jid.jid
        else
          jid := p.fromJID.full;
      end;
  end;

  if (jid = '') then exit;

  if Sender = popVersion then
    jabberSendCTCP(jid, XMLNS_VERSION)
  else if Sender = popTime then
    jabberSendCTCP(jid, XMLNS_TIME)
  else if Sender = popLast then
    jabberSendCTCP(jid, XMLNS_LAST);
end;

{---------------------------------------}

procedure TfrmRosterWindow.ResetPanels;
begin
    // order here is important
  pnlShow.Align := alBottom;
end;

{---------------------------------------}

procedure TfrmRosterWindow.popRosterPopup(Sender: TObject);
var
  ntype: integer;
  n: TListItem;
  p: TJabberPres;
  ritem: TJabberRosterItem;
begin
  // Check to see if this person is online or not
  p := nil;
  n := LvUsers.Selected;
  ntype := getItemType(n);
  if (ntype = item_ritem) then begin
    ritem := TJabberRosterItem(n.Data);
    if ritem <> nil then
      p := MainSession.ppdb.FindPres(ritem.jid.jid, '');
    popVersion.Enabled := (p <> nil);
    popTime.Enabled := (p <> nil);
  end;
  popPopup(self);
end;

{---------------------------------------}

procedure TfrmRosterWindow.popPropertiesClick(Sender: TObject);
var
  jid: widestring;
begin
  jid := '';
    // Show properties for this roster item
  case getitemType() of
    item_ritem: begin
        if (_cur_ritem <> nil) then
          ShowProfile(_cur_ritem.jid.jid)
      end;
  else
    if GetContactSID('联系人属性', '请在下面选择您想查看属性的联系人，然后单击“确定”。', '请输入您想查看属性的联系人的'+sJid+'。', jid) then
      ShowProfile(jid)
    {
        node_myres: begin
            if (_cur_myres <> nil) then
                ShowProfile(_cur_myres.jid.jid);
        end;
        node_bm: begin
            if (_cur_bm <> nil) then
                ShowBookmark(_cur_bm.jid.full);
        end;}
  end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.popRemoveClick(Sender: TObject);
var
  g: Widestring;
  jid: widestring;
begin
  jid := '';
    // Remove this roster item.
  case getitemType() of
    item_ritem: begin
          // remove a roster item
        if _cur_ritem <> nil then begin
          if (lvusers.Selected.SubItems.count > 1) then
            g := lvusers.Selected.SubItems[1]
          else
            g := '';
          RemoveRosterItem(_cur_ritem.jid.full, g);
        end;
      end;
  else
    if GetContactSID('删除联系人', '请在下面选择您想删除的联系人，然后单击“确定”。', '请输入您想删除的联系人的'+sJid+'。', jid) then
      RemoveRosterItem(jid, '');
  end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.popHistoryClick(Sender: TObject);
var
  nt: integer;
  n: TListItem;
  ritem: TJabberRosterItem;
  jid: widestring;
begin
//    ShowMsgHistory('');

    // Show history for this user
  n := LvUsers.Selected;
  nt := getitemType(n);
  if (nt = item_ritem) then begin
    ritem := TJabberRosterItem(n.Data);
    if ritem <> nil then
      ShowMsgHistory(ritem.jid.jid)
    else
      if GetHistorySID('打开历史消息记录', '请在下面选择您想打开其消息记录的人的名字，然后单击“确定”。', '请在下面选择您想打开其消息记录的会议的名字，然后单击“确定”。', jid) then
        ShowMsgHistory(jid);
            //ShowMsgHistory('');
  end
  else
    if GetHistorySID('打开历史消息记录', '请在下面选择您想打开其消息记录的人的名字，然后单击“确定”。', '请在下面选择您想打开其消息记录的会议的名字，然后单击“确定”。', jid) then
      ShowMsgHistory(jid);
        //ShowMsgHistory('');
end;

{---------------------------------------}

procedure TfrmRosterWindow.popChatClick(Sender: TObject);
var
  nt: integer;
begin
    // chat w/ contact
  nt := getitemType();
  if (nt = item_ritem) then
    StartChat(_cur_ritem.jid.jid, '', true)
end;

{---------------------------------------}

procedure TfrmRosterWindow.popMsgClick(Sender: TObject);
var
  nt: integer;
begin
    // send a normal msg
  nt := getitemType();
  if (nt = node_ritem) then
    StartMsg(_cur_ritem.jid.jid)
end;

{---------------------------------------}

procedure TfrmRosterWindow.popSendFileClick(Sender: TObject);
var
  node: TListitem;
begin
  node := lvusers.Selected;
  if node = nil then exit;
  if node.Data = nil then exit;

  if (TObject(node.Data) is TJabberRosterItem) then
    FileSend(TJabberRosterItem(node.Data).jid.jid);
end;

{---------------------------------------}

procedure TfrmRosterWindow.popAddContactClick(Sender: TObject);
begin
  frmAnyQ.mnuAddContactClick(Self);
end;

{---------------------------------------}

procedure TfrmRosterWindow.popAddGroupClick(Sender: TObject);
begin
  frmAnyQ.NewGroup2Click(Self);
end;

{---------------------------------------}

procedure TfrmRosterWindow.popSendPresClick(Sender: TObject);
var
  i: integer;
  t: TXMLTag;
  recips: TList;
  invis: boolean;
  pshow, pstatus: Widestring;
  pri: integer;
  cur_jid: Widestring;
begin
    // Send whatever my presence is right now.
  recips := getSelectedContacts(true);

  if (recips.Count > 0) then begin
    invis := false;
    if ((Sender = popSendInvisible) or (Sender = popGrpInvisible)) then
      invis := true;
    pshow := MainSession.Show;
    pstatus := MainSession.Status;
    pri := MainSession.Priority;

        // Send pres to everyone in the list.
    for i := 0 to recips.Count - 1 do begin
      cur_jid := TJabberRosterItem(recips[i]).jid.full;
      t := TXMLTag.Create('presence');

            // do insane invisible hacking to keep our own
            // avails list.
      if (invis) then begin
        t.setAttribute('type', 'invisible');
        if (MainSession.Invisible) then
          MainSession.removeAvailJid(cur_jid);
      end
      else if (MainSession.Invisible) then
        MainSession.addAvailJid(cur_jid);

      if (pshow) <> '' then t.AddBasicTag('show', pshow);
      if (pstatus) <> '' then t.AddBasicTag('status', pstatus);
      if (pri > 0) then t.AddBasicTag('priority', IntToStr(pri));

      t.setAttribute('to', cur_jid);
      MainSession.SendTag(t);
    end;
  end;

  recips.Free;
end;

{---------------------------------------}

procedure TfrmRosterWindow.popSendSubscribeClick(Sender: TObject);
var
  node: Tlistitem;
begin
    // send subscribe to this person
  node := LvUsers.Selected;
  if node = nil then exit;
  if node.Data = nil then exit;

  if (TObject(node.Data) is TJabberRosterItem) then
    SendSubscribe(TJabberRosterItem(node.Data).jid.jid, MainSession);
end;

{---------------------------------------}

procedure TfrmRosterWindow.DrawNodeText(Node: TTreeNode; State: TCustomDrawState;
  c1, c2: Widestring);
begin
end;

{---------------------------------------}

procedure TfrmRosterWindow.imgStatusPaint(Sender: TObject);
begin
  frmAnyQ.ImgLst24b.Draw(imgStatus.Canvas, 1, 1, _cur_status);
end;

{---------------------------------------}

procedure TfrmRosterWindow.popGrpRenameClick(Sender: TObject);
var
  old_grp, new_grp: WideString;
  gi, i: integer;
  ri: TJabberRosterItem;
begin
    // Rename some grp.
  new_grp := LvUsers.Selected.SubItems[0];
    // 如果是保留的组，则退出
  if IsReservedGroup(new_grp) then exit;

  if (InputQueryW(sRenameGrp, sRenameGrpPrompt, new_grp)) then begin
    old_grp := LvUsers.Selected.SubItems[0];
    new_grp := Trim(new_grp);
    if (new_grp <> old_grp) then begin
      for i := 0 to MainSession.Roster.Count - 1 do begin
        ri := MainSession.Roster.Items[i];
        gi := ri.Groups.IndexOf(old_grp);
        if (gi >= 0) then begin
          ri.Groups.Delete(gi);
          ri.Groups.Add(new_grp);
          ri.update();
        end;
      end;
      gi := MainSession.roster.GrpList.IndexOf(old_grp);
      if (gi >= 0) then
      begin
        MainSession.roster.GrpList.Delete(gi);
        MainSession.roster.GrpList.Add(new_grp);
      end;
      LvUsers.Selected.SubItems[0] := new_grp;
      LvUsers.Selected.Update;
    end;
  end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.popGrpRemoveClick(Sender: TObject);
var
  recips: TList;
  i: Integer;
begin
    // Remove the grp..
  if (LvUsers.SelCount = 1) then
  begin
    if RemoveGroup(_cur_grp) then
    begin
      DeleteGroup(_cur_grp);
{      if _cur_grp<>sGrpUnfiled then
        RemoveGroupNode(lvu.Selected);   {}
    end;
  end
  else begin
    recips := getSelectedContacts(false);
    if RemoveGroup('', recips) then
    begin

    end;
    recips.Free();
  end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
    // Kill the blockers list and collapsed grps
  _blockers.Free();
  _collapsed_grps.Free();
  if MainSession <> nil then with MainSession do begin
      UnRegisterCallback(_rostercb);
      UnRegisterCallback(_prescb);
    end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.InvitetoConference1Click(Sender: TObject);
var
  jids: TWideStringList;
begin
    //Show the invite window w/ this JID
  if (_cur_ritem = nil) then exit;

  jids := TWideStringlist.Create();
  jids.Add(_cur_ritem.jid.jid);

  ShowInvite('', jids);
  jids.Free();
end;

{---------------------------------------}

procedure TfrmRosterWindow.popGrpInviteClick(Sender: TObject);
var
  i: integer;
  sel: TList;
  jids: TWideStringlist;
begin
    // Invite the whole group to the conference.
  sel := Self.getSelectedContacts(true);
  jids := TWideStringlist.Create();
  for i := 0 to sel.Count - 1 do
    jids.Add(TJabberRosterItem(sel[i]).jid.full);

  ShowInvite('', jids);
  sel.Free();
  jids.Free();
end;

{---------------------------------------}

procedure TfrmRosterWindow.popSendContactsClick(Sender: TObject);
var
  fsend: TfrmSendContact;
  sel, send: Tlist;
  i: Integer;
begin
  fsend := TfrmSendContact.Create(Application);
  sel := getSelectedContacts(false);
  fsend.CheckSelectAll;
  fsend.CheckSend(sel);
//  fsend.CheckSelect(sel);
  Sel.Free;

  frmAnyQ.PreModal(fsend);
  if (fsend.ShowModal = mrOK) then
  begin
    sel := fsend.GetSelectList;
    send := fsend.GetSendList;
    for i := 0 to send.Count - 1 do
      jabberSendRosterItemsWithMsg(TJabberRosterItem(send.Items[i]).jid.full, sel, fsend.txtMsg.WideLines.Text);
    sel.Free;
    send.Free;
  end;
  frmAnyQ.PostModal();

  fsend.Free();
end;
{}
{
procedure TfrmRosterWindow.popSendContactsClick(Sender: TObject);
var
    fsel: TfrmSelContact;
    sel: TList;
begin
    // Send contacts to this JID..
    sel := getSelectedContacts(false);
    if (sel.Count = 0) then begin
        MessageBox(Handle, Pchar(sNoContactsSel), '错误', MB_OK OR MB_ICONERROR);
        sel.Free();
        exit;
    end;

    fsel := TfrmSelContact.Create(Application);
    // fsel.frameTreeRoster1.DrawRoster(false);
    fsel.frameTreeRoster1.treeRoster.MultiSelect := false;

    frmAnyQ.PreModal(fsel);
    if (fsel.ShowModal = mrOK) then
        jabberSendRosterItems(fsel.GetSelectedJID(), sel);
    frmAnyQ.PostModal();

    sel.Free();
    fSel.Free();
end;
{}

{---------------------------------------}

procedure TfrmRosterWindow.popBlockClick(Sender: TObject);
var
  recips: TList;
  i: integer;
  ri: TJabberRosterItem;
  p: TJabberPres;
begin
    // Block or Unblock this user
  recips := getSelectedContacts(false);
  if (recips.Count > 1) then begin
    if (MessageBox(Handle, Pchar(Format(sBlockContacts, [recips.Count])), '确认',
      MB_YESNO or MB_ICONQUESTION) = mrNo) then exit;
  end;
  for i := 0 to recips.Count - 1 do begin
    ri := TJabberRosterItem(recips[i]);
    MainSession.Block(ri.jid);
    if MainSession.Prefs.getBool('roster_hide_block') then
      RemoveItemNodes(ri)
    else begin
      p := MainSession.ppdb.FindPres(ri.jid.jid, '');
      RenderItem(ri, p);
    end;
  end;

  recips.Clear();
  recips.Free();
end;

{---------------------------------------}

procedure TfrmRosterWindow.popUnBlockClick(Sender: TObject);
var
  recips: TList;
  i: integer;
  ri: TJabberRosterItem;
  p: TJabberPres;
begin
    // Block or Unblock this user
  recips := getSelectedContacts(false);
  if (recips.Count > 1) then begin
    if (MessageBox(Handle, Pchar(Format(sUnblockContacts, [recips.Count])), '确认',
      MB_YESNO or MB_ICONQUESTION) = mrNo) then exit;
  end;
  for i := 0 to recips.Count - 1 do begin
    ri := TJabberRosterItem(recips[i]);
    MainSession.UnBlock(ri.jid);
    p := MainSession.ppdb.FindPres(ri.jid.jid, '');
    RenderItem(ri, p);
  end;

  recips.Clear();
  recips.Free();
end;

{---------------------------------------}

procedure TfrmRosterWindow.BroadcastMessage1Click(Sender: TObject);
var
  r: TList;
  jl: TWideStringList;
  i: integer;
begin
    // Broadcast a message to the grp
  r := getSelectedContacts(false);
  with TfrmBroadcastMsg.Create(Application) do
  begin
    frameTreeRoster1.Check(r);
    if (frmAnyQ.isMinimized()) then
      ShowWindow(Handle, SW_SHOWMINNOACTIVE)
    else
      ShowWindow(Handle, SW_SHOWNOACTIVATE);
    Show;
    SetFocus;
    Activate;
  end;
{
    if (r.Count <= 1) then
        MessageBox(Handle, Pchar(sNoBroadcast), '错误', MB_OK OR MB_ICONERROR)
    else begin
        jl := TWideStringlist.Create();
        for i := 0 to r.Count - 1 do
            jl.Add(TJabberRosterItem(r[i]).jid.full);
        BroadcastMsg(jl);
        jl.Free();
    end;
{}
  r.Clear();
  r.Free();
end;

{---------------------------------------}

procedure TfrmRosterWindow.lblLoginClick(Sender: TObject);
begin
    // Login to the client..
  if (lblLogin.Caption = sCancelLogin) then begin
        // Cancel the connection
    frmAnyQ.CancelConnect();
  end
  else if (lblLogin.Caption = sCancelReconnect) then begin
        // cancel reconnect
    frmAnyQ.timReconnect.Enabled := false;
    Self.SessionCallback('/session/disconnected', nil);
  end
  else
        // Normal, show the login window
    PostMessage(frmAnyQ.Handle, WM_SHOWLOGIN, 0, 0);
end;

{---------------------------------------}

procedure TfrmRosterWindow.FormActivate(Sender: TObject);
begin
  _change_node := nil;
end;

{---------------------------------------}

procedure TfrmRosterWindow.popTransLogoffClick(Sender: TObject);
var
  p: TXMLTag;
begin
    // send unavail pres to this jid..
  if (_cur_ritem <> nil) then begin
    p := TXMLTag.Create('presence');
    if (Sender = popTransLogoff) then
      p.setAttribute('type', 'unavailable');
    p.setAttribute('to', _cur_ritem.jid.full);
    MainSession.SendTag(p);
  end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.popTransUnRegisterClick(Sender: TObject);
begin
    // unregister from the transport.
  RemoveTransport(_cur_ritem.jid.jid, true);
  QuietRemoveRosterItem(_cur_ritem.jid.full);
end;

{---------------------------------------}

procedure TfrmRosterWindow.imgAdClick(Sender: TObject);
begin
  if (_adURL <> '') then
    ShellExecute(0, 'open', PChar(_adURL), nil, nil, SW_SHOWNORMAL);
end;

{---------------------------------------}

procedure TfrmRosterWindow.popRenameClick(Sender: TObject);
var
  ri: TJabberRosterItem;
  nick: Widestring;
begin
    // Do this since the treeview doesn't use WideStrings for
    // processing of Editing events
  getitemType();
  ri := _cur_ritem;
  nick := ri.Nickname;
  if (InputQueryW('重命名', '输入新的昵称: ', nick)) then begin
    ri.Nickname := nick;
    ri.update();
  end;
end;

{---------------------------------------}

procedure TfrmRosterWindow.pluginClick(Sender: TObject);
begin
    // a plugin menu got clicked
  ExCOMController.fireRosterMenuClick(Sender);
end;

{---------------------------------------}

procedure TfrmRosterWindow.onURLDrop(p: TPoint; url: Widestring);
var
  tp: TPoint;
  n: TListItem;
  i, nt: integer;
  r: TList;
  jl: TWidestringlist;
  f: TfrmMsgRecv;
  xtag: Widestring;
begin
    // we got a URL drop
  tp := LvUsers.ScreenToClient(p);
  n := LvUsers.GetitemAt(tp.X, tp.Y);
  if (n = nil) then begin
    ShowRiserWindow(nil, sNoContactsSel, ico_info);
        //MessageBox(Handle, Pchar(sNoContactsSel), '警告', MB_OK OR MB_ICONWARNING);
    exit;
  end;

  xtag := '<x xmlns="jabber:x:oob"><url>' + url + '</url></x>';

  nt := getitemType(n);
  case nt of
    item_ritem: begin
        // send a msg to this user, with the URL in the body.
        f := StartMsg(TJabberRosterItem(n.Data).jid.jid);
        f.AddOutgoing(url);
        f.AddXTagXML(xtag);
        f.txtSendSubject.Text := 'URL';
      end;
    item_grp: begin
        // we have to rpretend to select the group..
        LvUsers.Selected := n;
        r := getSelectedContacts(true);
        jl := TWideStringlist.Create();
        for i := 0 to r.Count - 1 do
          jl.Add(TJabberRosterItem(r[i]).jid.full);

        f := MsgRecv.BroadcastMsg(jl);
        f.AddOutgoing(url);
        f.AddXTagXML(xtag);
        f.txtSendSubject.Text := 'URL';

        jl.Free();
        r.Free();
      end
  else begin
      ShowRiserWindow(nil, sNoContactsSel, ico_info);
        //MessageBox(Handle, Pchar(sNoContactsSel), '警告', MB_OK OR MB_ICONWARNING);
      exit;
    end;
  end;

end;

{---------------------------------------}

procedure TfrmRosterWindow.FormDestroy(Sender: TObject);
begin
  _drop.stop();
  _drop := nil;
  FreeMap
end;

procedure TfrmRosterWindow.pnlConnectResize(Sender: TObject);
begin
  Image1.Left := pnlConnect.Width - Image1.Width;
  Image1.Top := pnlConnect.Height - Image1.Height;
end;

procedure TfrmRosterWindow.popGetShareListClick(Sender: TObject);
var
  node: TListItem;
begin
  node := LvUsers.Selected;
  if node = nil then exit;
  if node.Data = nil then exit;

  if (TObject(node.Data) is TJabberRosterItem) then
    GetShareList(TJabberRosterItem(node.Data).jid.full);
end;

procedure TfrmRosterWindow.popInstantMailClick(Sender: TObject);
var
  node: TListItem;
begin
  node := LvUsers.Selected;
  if node = nil then exit;
  if node.Data = nil then exit;

  if (TObject(node.Data) is TJabberRosterItem) then
    InstantMailSend(TJabberRosterItem(node.Data).jid.jid);
end;

procedure TfrmRosterWindow.N11Click(Sender: TObject);
var
  t: TXMLTag;
begin
  MainSession.Invisible := true;
  t := TXMLTag.Create('presence');
  t.setAttribute('type', 'invisible');
  MainSession.SendTag(t);
  ChangeStatusImage(N11.ImageIndex);
  frmAnyQ.setTrayIcon(N11.ImageIndex);
  lblStatusLink.Caption := ' [隐身]';
  MainSession.Status := '隐身';
end;

procedure TfrmRosterWindow.pnlAnimationResize(Sender: TObject);
begin
  aniWait.Left := (pnlConnect.Width - aniWait.Width) div 2;
end;

procedure TfrmRosterWindow.tbOicqClick(Sender: TObject);
begin
//  TransportsCfg('oicq');
  if TToolButton(sender).PopupMenu=nil then
    exit;
  popToolbutton.PopupComponent := TToolButton(sender);
  popToolbutton.Popup(mouse.CursorPos.X, mouse.CursorPos.y);
end;

procedure TfrmRosterWindow.tbIcqClick(Sender: TObject);
begin
//  TransportsCfg('icq');
  if TToolButton(sender).PopupMenu=nil then
    exit;
  popToolbutton.PopupComponent := TToolButton(sender);
  popToolbutton.Popup(mouse.CursorPos.X, mouse.CursorPos.y);
end;

procedure TfrmRosterWindow.tbMsnClick(Sender: TObject);
begin
//  TransportsCfg('msn');
  if TToolButton(sender).PopupMenu=nil then
    exit;
  popToolbutton.PopupComponent := TToolButton(sender);
  popToolbutton.Popup(mouse.CursorPos.X, mouse.CursorPos.y);
end;

procedure TfrmRosterWindow.tbAimClick(Sender: TObject);
begin
//  TransportsCfg('aim');
  if TToolButton(sender).PopupMenu=nil then
    exit;
  popToolbutton.PopupComponent := TToolButton(sender);
  popToolbutton.Popup(mouse.CursorPos.X, mouse.CursorPos.y);
end;

procedure TfrmRosterWindow.tbYahooClick(Sender: TObject);
begin
//  TransportsCfg('yahoo');
  if TToolButton(sender).PopupMenu=nil then
    exit;
  popToolbutton.PopupComponent := TToolButton(sender);
  popToolbutton.Popup(mouse.CursorPos.X, mouse.CursorPos.y);
end;

procedure TfrmRosterWindow.ToolBar2CustomDrawButton(Sender: TToolBar;
  Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  frmAnyQ.ImgLst24b.Draw(sender.Canvas, 1, 1, _cur_status);
end;

procedure TfrmRosterWindow.Panel1Click(Sender: TObject);
//var
//    cp : TPoint;
begin
//    // popup the menu and to change our status
//    if MainSession.Active then begin
//        GetCursorPos(cp);
//        popStatus.Popup(cp.x, cp.y);
//    end;
end;

procedure TfrmRosterWindow.ToolButton6Click(Sender: TObject);
var
  cp: TPoint;
begin
    // popup the menu and to change our status
  if MainSession.Active then begin
    GetCursorPos(cp);
    popStatus.Popup(cp.x, cp.y);
  end;
end;

procedure TfrmRosterWindow.M1Click(Sender: TObject);
var
  node: TListItem;
begin
  node := LvUsers.Selected;
  if node = nil then exit;
  if node.Data = nil then exit;

  if (TObject(node.Data) is TJabberRosterItem) then
    newmail(GetMailAddr(TJabberRosterItem(node.Data).jid.jid));
end;

procedure TfrmRosterWindow.A1Click(Sender: TObject);
var
  nt: integer;
begin
  nt := getitemType();
  if (nt = item_ritem) then
    StartAudioChat(_cur_ritem.jid.jid)
end;

procedure TfrmRosterWindow.V1Click(Sender: TObject);
var
  nt: integer;
begin
  nt := getitemType();
  if (nt = item_ritem) then
    StartVideoChat(_cur_ritem.jid.jid)
end;

procedure TfrmRosterWindow.LvUsersCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  xRect: TRect;
  nRect: TRect;
  DrawStyle: TDrawingStyle;
  sTxt, sTmp: widestring;
  online, total: integer;
  p: TJabberPres;
  tmpIndex: Integer;
  style: TFontStyles;
  i: integer;
  function ismsn(jid: TJabberID): boolean;
  begin
    Result := CompareText('msn.', Copy(jid.domain,1,4))=0;
  end;

begin
  with Sender.Canvas do begin
    font := LvUsers.font;
    style := font.Style;
    if item.Indent = 0 then
      Style := font.Style + [fsBold]
    else
      Style := font.Style - [fsBold];

    font.Style := Style;


    if item.Indent = 0 then
    begin
      if Item.SubItems[0] <> '' then
      begin
        SetBkMode(handle, Transparent);
        TextFlags := ETO_OPAQUE;
        SetTextColor(handle, ColorToRGB(clWindowText));
        total := MainSession.roster.getGroupCount(Item.SubItems[0], false);
        online := MainSession.roster.getGroupCount(Item.SubItems[0], true);
        sTxt := Item.SubItems[0];
        sTxt := sTxt + '(' + inttostr(online) + '/' + inttostr(total) + ')';
        if Item.Caption <> sTxt then
          Item.Caption := sTxt;
      end
      else
      begin
        Style := Style - [fsBold];
        font.Style := Style;
        font.Color := clGrayText;
        SetBkMode(handle, Transparent);
        TextFlags := ETO_OPAQUE;
        SetTextColor(handle, ColorToRGB(clGrayText));
        if (Item.SubItems.Count > 1) and (Item.SubItems[1] = 'mailstate') then
        begin
          SetTextColor(handle, ColorToRGB(clWindowText));
          sTxt := '我的电子邮箱';
          if getNewMailCount > 0 then
            sTxt := '我的电子邮箱(有' + inttostr(getNewMailCount) + '封新邮件)';
        end
        else
          sTxt := '将联系人拖到该组中';
        if Item.Caption <> sTxt then
          Item.Caption := sTxt;
      end;
    end
    else
    begin
      SetBkMode(handle, Transparent);
      TextFlags := ETO_OPAQUE;
      SetTextColor(handle, ColorToRGB(clWindowText));
      if item.data = nil then
      begin
        sTxt := item.SubItems[0];
        for i := 0 to MailState.AccountCount - 1 do
          if sTxt = MailState.states[i].AccountName then
          begin
            sTxt := sTxt + '(' + inttostr(MailState.states[i].NewMail) + ')';
            break;
          end;
      end
      else
      begin
        if TJabberRosterItem(item.Data).Nickname <> '' then
          sTxt := TJabberRosterItem(item.Data).Nickname
        else
          sTxt := TJabberRosterItem(item.Data).jid.user;

        if ((TJabberRosterItem(item.Data).Nickname=TJabberRosterItem(item.Data).jid.user) or
           (TJabberRosterItem(item.Data).Nickname='')) and
           ismsn(TJabberRosterItem(item.Data).jid) then
        begin
          sTxt := ReverseString(sTxt);
          sTxt := StringReplace(sTxt, '%', '@', []);
          sTxt := ReverseString(sTxt);
        end;

        p := MainSession.ppdb.FindPres(TJabberRosterItem(item.Data).jid.jid, '');
        if ((p <> nil) and (_show_status)) then begin
          if (p.Status <> '') then
          begin
            if ismsn(TJabberRosterItem(item.Data).jid) then
              sTxt := p.Status
            else
              sTxt := sTxt + '(' + p.Status + ')';
          end;
        end;

        if MainSession.IsBlocked(TJabberRosterItem(item.Data).jid.jid) then
        begin
          if (p = nil) then
            tmpIndex := ico_blockoffline
          else
            tmpIndex := ico_blocked;
        end
        else
          if TJabberRosterItem(item.Data).ask = 'subscribe' then
            tmpIndex := ico_Unknown
          else if p = nil then
            tmpIndex := ico_Offline
          else begin
            if p.Show = 'away' then
              tmpIndex := ico_Away
            else if p.Show = 'xa' then
              tmpIndex := ico_XA
            else if p.Show = 'dnd' then
              tmpIndex := ico_DND
            else
              tmpIndex := ico_Online
          end;

        sTmp := TJabberRosterItem(item.Data).jid.domain;

        if pos('oicq.', sTmp) = 1 then
        begin
          case tmpIndex of
            ico_Offline: tmpIndex := 49;
            ico_Online: tmpIndex := 48;
            ico_Away: tmpIndex := 51;
            ico_XA: tmpIndex := 51;
            ico_DND: tmpIndex := 50;
            ico_blocked: tmpIndex := 52;
            ico_blockoffline: tmpIndex := 52;
          end;
        end
        else
          if pos('msn.', sTmp) = 1 then
          begin
            case tmpIndex of
              ico_Offline: tmpIndex := 44;
              ico_Online: tmpIndex := 43;
              ico_Away: tmpIndex := 46;
              ico_XA: tmpIndex := 46;
              ico_DND: tmpIndex := 45;
              ico_blocked: tmpIndex := 47;
              ico_blockoffline: tmpIndex := 47;
            end;
          end
          else
            if pos('icq.', sTmp) = 1 then
            begin
            //画icq图标
              case tmpIndex of
                ico_Offline: tmpIndex := 54;
                ico_Online: tmpIndex := 53;
                ico_Away: tmpIndex := 56;
                ico_XA: tmpIndex := 56;
                ico_DND: tmpIndex := 55;
                ico_blocked: tmpIndex := 57;
                ico_blockoffline: tmpIndex := 57;
              end;
            end
            else
              if pos('aim.', sTmp) = 1 then
              begin
            //画aim图标
                case tmpIndex of
                  ico_Offline: tmpIndex := 59;
                  ico_Online: tmpIndex := 58;
                  ico_Away: tmpIndex := 61;
                  ico_XA: tmpIndex := 61;
                  ico_DND: tmpIndex := 60;
                  ico_blocked: tmpIndex := 62;
                  ico_blockoffline: tmpIndex := 62;
                end;
              end
              else
                if pos('yahoo.', sTmp) = 1 then
                begin
            //画yahoo!图标
                  case tmpIndex of
                    ico_Offline: tmpIndex := 64;
                    ico_Online: tmpIndex := 63;
                    ico_Away: tmpIndex := 66;
                    ico_XA: tmpIndex := 66;
                    ico_DND: tmpIndex := 65;
                    ico_blocked: tmpIndex := 67;
                    ico_blockoffline: tmpIndex := 67;
                  end;
                end;
        if item.ImageIndex <> tmpIndex then
          item.ImageIndex := tmpIndex;
      end;

      if Item.Caption <> sTxt then
        Item.Caption := sTxt;
    end;


    Brush.Color := clNone;
    Brush.Color := LvUsers.Color;

    if item.Selected then
      exit;

    xRect := Item.DisplayRect(drSelectBounds);
    nRect := Item.DisplayRect(drIcon);
    xRect.Left := nRect.Right + 1;

    if (cdsFocused in State) then
      Sender.Canvas.DrawFocusRect(xRect);

//    xrect.Left := xrect.Left+2;
    InflateRect(xrect, -1, -1);
    windows.DrawTextW(handle, pwidechar(sTxt), length(sTxt), xRect, DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS);

    DrawStyle := dsTransparent;

//    if (cdsSelected in State) or item.Selected then
//      DrawStyle := dsSelected;

    LvUsers.SmallImages.Draw(Sender.Canvas, nRect.Left, nRect.Top, Item.ImageIndex, DrawStyle, itImage);
  {}end;
  DefaultDraw := false;
end;

procedure TfrmRosterWindow.LvUsersCustomDraw(Sender: TCustomListView;
  const ARect: TRect; var DefaultDraw: Boolean);
var
  btop, bLeft: Integer;
  rect: Trect;
  x, y, h: integer;
begin
  sender.Canvas.font.Name := LvUsers.Font.Name;
  sender.Canvas.font.Size := LvUsers.Font.Size;

  x := GetScrollPos(sender.Handle, SB_HORZ);
  y := GetScrollPos(sender.Handle, SB_VERT);
  h := 17;

{
  if LvUsers.TopItem <> nil then
  begin
    GetWindowRect(LvUsers.TopItem.Handle, rect);
    h:= (rect.Bottom-rect.Top+1) div LvUsers.VisibleRowCount;
  end;
{}
  rect := sender.ClientRect;
  rect.Bottom := rect.Top + sender.Height;
  btop := rect.Bottom - Image1.Picture.Bitmap.Height - y * h;
  bleft := rect.Right - Image1.Picture.Bitmap.Width - x;

  sender.Canvas.FillRect(Arect);

  rect := Types.rect(bleft - 1, btop - 1, bleft + Image1.Picture.Bitmap.Width + 1, bTop + Image1.Picture.Bitmap.Height + 1);

  if IntersectRect(rect, rect, arect) then
    BitBlt(sender.Canvas.Handle, Arect.Left, Arect.Top, Arect.Right - Arect.Left { Image1.Picture.Bitmap.Width},
      Arect.Bottom - Arect.top {Image1.Picture.Bitmap.Height}, Image1.Picture.Bitmap.Canvas.Handle, Arect.Left - bleft, Arect.Top - btop, SRCCOPY);
{}
  DefaultDraw := true;
end;

procedure TfrmRosterWindow.LvUsersResize(Sender: TObject);
begin
  LvUsers.Columns.Items[0].Width := LvUsers.Width - 20;
  LvUsers.Invalidate;
end;

procedure TfrmRosterWindow.ExpandGroup(grp: widestring);
var
  i, s, c: integer;
  _show_online: boolean;
  itemlist: Tlist;
  stxt: widestring;
begin
  s := -1;
  for i := 0 to LvUsers.Items.Count - 1 do
  begin
    if LvUsers.Items.Item[i].Indent >= 1 then
      Continue;
    if LvUsers.Items.Item[i].SubItems[0] = grp then
    begin
      s := i;
      break;
    end;
  end;
  if s = -1 then
    exit;

  s := s + 1;

  _show_online := MainSession.Prefs.getBool('roster_only_online');
  itemlist := MainSession.roster.getGroupItems(grp, _show_online);
  LvUsers.Items.BeginUpdate;

  if itemlist.Count <= 0 then
    with LvUsers.Items.Insert(s) do
    begin
      Data := nil;
      SubItems.Add('');
      SubItems.Add(grp);
      Caption := '';
      Indent := 0;
      ImageIndex := -1;
    end;

  for i := itemlist.Count - 1 downto 0 do
  begin
    if TJabberRosterItem(itemlist[i]).Nickname <> '' then
      stxt := TJabberRosterItem(itemlist[i]).Nickname
    else
      stxt := TJabberRosterItem(itemlist[i]).jid.user;
    if stxt = '' then continue;
    with LvUsers.Items.Insert(s) do
    begin
      Data := TJabberRosterItem(itemlist[i]);
      SubItems.Add(stxt);
      SubItems.Add(grp);
      Caption := '';
      Indent := 1;
    end;
  end;
  itemlist.free;
  LvUsers.Items.item[s - 1].ImageIndex := ico_down;
  LvUsers.AlphaSort;
  LvUsers.Items.EndUpdate;
end;

procedure TfrmRosterWindow.CollapseGroup(grp: widestring);
var
  i, s, c: integer;
begin
  s := -1;
  for i := 0 to LvUsers.Items.Count - 1 do
  begin
    if LvUsers.Items.Item[i].Indent >= 1 then
      Continue;
    if LvUsers.Items.Item[i].SubItems[0] = grp then
    begin
      s := i;
      break;
    end;
  end;
  if s = -1 then exit;
  s := s + 1;

  LvUsers.Items.BeginUpdate;

  for i := s to LvUsers.Items.Count - 1 do
  begin
    if s >= LvUsers.Items.Count then
      break;
    if (LvUsers.Items.Item[s].Indent < 1) and (LvUsers.Items.Item[s].SubItems[0] <> '') then
      break;
    LvUsers.Items.Delete(s);
  end;

  LvUsers.Items.item[s - 1].ImageIndex := ico_right;
  LvUsers.Items.EndUpdate;
end;

procedure TfrmRosterWindow.LvUsersClick(Sender: TObject);
var
  i: integer;
begin
  if LvUsers.Selected <> nil then
    if LvUsers.Selected.Indent = 0 then
      if LvUsers.Selected.SubItems[0] <> '' then
      begin
        if LvUsers.Selected.ImageIndex = ico_down then
          CollapseGroup(LvUsers.Selected.SubItems[0])
        else
          ExpandGroup(LvUsers.Selected.SubItems[0]);
//        LvUsers.Items.BeginUpdate;
//        LvUsers.AlphaSort;
//        LvUsers.Items.EndUpdate;
        for i := 0 to LvUsers.Items.Count - 1 do
          LvUsers.items.Item[i].Update;
///        LvUsers.Invalidate;
      end
      else
      begin
        if (LvUsers.Selected.SubItems.Count > 1) and
          (LvUsers.Selected.SubItems[1] = 'mailstate') then
        begin
          if LvUsers.Selected.ImageIndex = ico_down then
            CollapseMailGroup()
          else
            ExpandMailGroup();
          for i := 0 to LvUsers.Items.Count - 1 do
            LvUsers.items.Item[i].Update;
        end
      end;
end;

procedure TfrmRosterWindow.LvUsersInsert(Sender: TObject; Item: TListItem);
begin
//  item.Update;
end;

procedure TfrmRosterWindow.LvUsersCompare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
var
  sgup1, suser1: widestring;
  sgup2, suser2: widestring;
  p1, p2: TJabberPres;
begin
  sgup1 := '';
  suser1 := '';
  sgup2 := '';
  suser2 := '';

  Compare := 0;

  if Item1.SubItems.Count = 1 then
    sgup1 := Item1.SubItems[0]
  else
  begin
    sgup1 := Item1.SubItems[1];
    suser1 := Item1.SubItems[0];
    if (suser1 <> '') and (item1.Data <> nil) then
      p1 := MainSession.ppdb.FindPres(TJabberRosterItem(item1.Data).jid.jid, '');
  end;

  if Item2.SubItems.Count = 1 then
    sgup2 := Item2.SubItems[0]
  else
  begin
    sgup2 := Item2.SubItems[1];
    suser2 := Item2.SubItems[0];
    if (suser2 <> '') and (item2.Data <> nil) then
      p2 := MainSession.ppdb.FindPres(TJabberRosterItem(item2.Data).jid.jid, '');
  end;

  if sgup1 = sGrpUnfiled then
    inc(Compare);
  if sgup2 = sGrpUnfiled then
    dec(Compare);

  if sgup1 = 'mailstate' then
    dec(Compare);
  if sgup2 = 'mailstate' then
    inc(Compare);

  if Compare = 0 then
    Compare := WideCompareText(sgup1, sgup2);

  if Compare = 0 then
    Compare := Item1.Indent - Item2.Indent;

  if Compare = 0 then
  begin
    if p1 <> nil then
      dec(Compare);
    if p2 <> nil then
      inc(Compare);
  end;

  if Compare = 0 then
    Compare := WideCompareText(suser1, suser2);
end;

procedure TfrmRosterWindow.LvUsersContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
var
  me, o, e: boolean;
  b, u: boolean;
  i, r: integer;
  n: TListItem;
  ri: TJabberRosterItem;
  pri: TJabberPres;
  slist: TList;
begin
    // Figure out what popup menu to show
    // based on the selection

  ri := nil;
  n := LvUsers.GetItemAt(MousePos.X, MousePos.Y);
  if (n <> nil) then begin
    if (LvUsers.SelCount > 1) then
      r := item_grp
    else
      r := getItemType(n);
  end
  else begin
    LvUsers.Selected := nil;
    r := item_none;
  end;

  case r of
    item_none:
      begin
        // show the actions popup when no node is hit
        Lvusers.PopupMenu := popActions;
        popProperties.Enabled := false;
        popAddContact.Visible := LvUsers.Selected = nil;
        popAddGroup.Visible := LvUsers.Selected = nil;
        popMail.Visible := LvUsers.Selected <> nil;
      end;
    item_ritem:
      begin
        // show the roster menu when a node is hit
        Lvusers.PopupMenu := popRoster;
        Lvusers.Selected := n;
        o := false;
        if (r = node_myres) then begin
          me := true;
          e := (_cur_myres.item <> nil);
          ri := _cur_myres.item;
        end
        else begin
          me := false;
          e := (_cur_ritem <> nil);
          if (e) then begin
                // check to see if this person is online
            ri := TJabberRosterItem(n.Data);
            pri := MainSession.ppdb.FindPres(ri.jid.jid, '');
            o := (pri <> nil);
          end;
        end;

        popChat.Enabled := e;
        popMsg.Enabled := e;
        popProperties.Enabled := true;
        popSendFile.Enabled := (o) and
          (MainSession.Profile.ConnectionType = conn_normal) and
          (not me);
        popGetShareList.Enabled := popSendFile.Enabled;
        popInstantMail.Enabled := popSendFile.Enabled;
        A1.Enabled := popSendFile.Enabled;
        V1.Enabled := popSendFile.Enabled;

        popPresence.Enabled := e and (not me);
        popClientInfo.Enabled := true;
        popVersion.Enabled := o;
        popTime.Enabled := o;
        popRename.Enabled := (not me);
        popHistory.Enabled := e;
        popBlock.Enabled := (not me);
        popRemove.Enabled := (not me);

        if ((ri <> nil) and (MainSession.isBlocked(ri.jid))) then begin
          popBlock.Caption := sBtnUnBlock;
          popBlock.OnClick := popUnblockClick;
        end
        else begin
          popBlock.Caption := sBtnBlock;
          popBlock.OnClick := popBlockClick;
        end;
        popGroupBlock.OnClick := popBlock.OnClick;
      end;
    item_grp:
      begin
        // check to see if we have the Transports grp selected
        if (n.SubItems[0] = _transports) then
        begin
          Lvusers.PopupMenu := popActions;
          popProperties.Enabled := false;
          exit;
        end;

        // check to see if we have multiple contacts or a group selected
        Lvusers.PopupMenu := popGroup;
        if (Lvusers.SelCount <= 1) then
        begin
          Lvusers.Selected := n;
        end;

        popGrpRename.Enabled := (Lvusers.SelCount <= 1);

        b := true;
        u := true;

        // do blocking madness
        slist := getSelectedContacts(MainSession.Prefs.getBool('roster_only_online'));
        for i := 0 to slist.count - 1 do begin
          ri := TJabberRosterItem(slist[i]);
          if (_blockers.IndexOf(ri.jid.jid) >= 0) then begin
            b := false;
            if (not u) then break;
          end
          else begin
            u := false;
            if (not b) then break;
          end;
        end;
        if ((not b) and (not u)) then begin
          popGroupBlock.Caption := sBtnBlock;
          popGroupBlock.Enabled := false;
          popBlock.OnClick := popBlockClick;
        end
        else if (b) then begin
          popGroupBlock.Caption := sBtnBlock;
          popGroupBlock.Enabled := true;
          popBlock.OnClick := popBlockClick;
        end
        else if (u) then begin
          popGroupBlock.Caption := sBtnUnBlock;
          popGroupBlock.Enabled := true;
          popBlock.OnClick := popUnBlockClick;
        end;

        popGroupBlock.OnClick := popBlock.OnClick;

        slist.Clear();
        slist.Free();
      end;
  end;
end;

function TfrmRosterWindow.getItemType(item: TListItem): integer;
var
  grp_node, n: TListItem;
begin
  // return the type of node this is..
  if (item = nil) then
    n := LvUsers.Selected
  else
    n := item;

  Result := item_none;

  _cur_ritem := nil;
  _cur_bm := nil;
  _cur_grp := '';

  if (n = nil) then exit;
  if (n.Indent = 0) and (n.SubItems[0] = '') then
    exit;

  if ((n.Indent = 0) or ((LvUsers.SelCount > 1) and (item = nil))) then
  begin
    Result := item_grp;
    _cur_grp := n.SubItems[0];
  end
  else
    if (TObject(n.Data) is TJabberRosterItem) then begin
      Result := item_ritem;
      _cur_ritem := TJabberRosterItem(n.Data);
    end;
end;

procedure TfrmRosterWindow.LvUsersDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := False;
  if Source = LvUsers then
    Accept := (LvUsers.Selected<>nil);
end;

procedure TfrmRosterWindow.LvUsersDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  i: integer;
  ritem: TJabberRosterItem;
  d_grp: Widestring;
  d_item: TListItem;
  s_Item: TListItem;
begin
  // Drop the roster items onto the roster
  // d_node   : the new group node
  // d_grp    : the new group name
  // s_node   : selected node we are changing (the thing that was dropped)

  d_item := Lvusers.GetItemAt(X, Y);
  if d_item = nil then exit;
  if d_item.SubItems.Count > 1 then begin
    if (TObject(d_item.Data) is TJabberRosterItem) then
      d_grp := d_item.SubItems[1]
    else
      exit;
  end
  else
    d_grp := d_item.SubItems[0];

  s_Item := Lvusers.Selected;
  if s_Item=nil then
    exit;
  ritem := TJabberRosterItem(s_Item.Data);
  if ritem <> nil then begin
    if (ritem.Groups.IndexOf(d_grp) < 0) then
    begin
      if (not _drop_copy) then
        ritem.Groups.Clear;
      ritem.Groups.Add(d_grp);
      ritem.update;
    end;
  end;

{  // Make sure d_grp is expanded if it's not in _collapsed_grps
  if ((not d_item.expanded) and (_collapsed_grps.IndexOf(d_grp) < 0)) then
      d_node.Expand(true);  {}
end;

procedure TfrmRosterWindow.LvUsersKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then begin
    Self.LvUsersDblClick(Self);
    Key := #0;
  end;
end;

procedure TfrmRosterWindow.LvUsersDblClick(Sender: TObject);
var
  r: integer;
begin
  // Chat with this person
  _change_node := nil;
  case getItemType() of
    item_ritem:
      begin
        // chat w/ this person
        r := MainSession.Prefs.getInt(P_CHAT);
        if ((r = 0) or (r = 2)) then
           // StartChat will handle doing the right thing
          StartChat(_cur_ritem.jid.jid, '', true)
        else if (r = 1) then
          // instant message
          StartMsg(_cur_ritem.jid.jid);
      end;
    item_none:
      begin
        if LvUsers.Selected <> nil then
          popMail.Click;
      end;
  end;
end;

procedure TfrmRosterWindow.UpdateGroup(grp: widestring);
var
  i, s, c: integer;
  _show_online: boolean;
  itemlist: Tlist;
  stxt: widestring;
begin
  s := -1;
  for i := 0 to LvUsers.Items.Count - 1 do
  begin
    if LvUsers.Items.Item[i].Indent >= 1 then
      Continue;
    if LvUsers.Items.Item[i].SubItems[0] = grp then
    begin
      s := i;
      break;
    end;
  end;
  if s = -1 then exit;
  s := s + 1;

  if LvUsers.Items.item[s - 1].ImageIndex <> ico_Down then
    exit;

  LvUsers.Items.BeginUpdate;

  for i := s to LvUsers.Items.Count - 1 do
  begin
    if s >= LvUsers.Items.Count then
      break;
    if (LvUsers.Items.Item[s].Indent < 1) and (LvUsers.Items.Item[s].SubItems[0] <> '') then
      break;
    LvUsers.Items.Delete(s);
  end;

  _show_online := MainSession.Prefs.getBool('roster_only_online');
  itemlist := MainSession.roster.getGroupItems(grp, _show_online);

  if itemlist.Count <= 0 then
    with LvUsers.Items.Insert(s) do
    begin
      Data := nil;
      SubItems.Add('');
      SubItems.Add(grp);
      Caption := '';
      Indent := 0;
      ImageIndex := -1;
    end;

  for i := itemlist.Count - 1 downto 0 do
  begin
    if TJabberRosterItem(itemlist[i]).Nickname <> '' then
      stxt := TJabberRosterItem(itemlist[i]).Nickname
    else
      stxt := TJabberRosterItem(itemlist[i]).jid.user;
    if stxt = '' then continue;
    with LvUsers.Items.Insert(s) do
    begin
      Data := TJabberRosterItem(itemlist[i]);
      SubItems.Add(stxt);
      SubItems.Add(grp);
      Caption := '';
      Indent := 1;
    end;
  end;
  itemlist.free;
  LvUsers.Items.item[s - 1].ImageIndex := ico_down;
  LvUsers.AlphaSort;
  LvUsers.Items.EndUpdate;
  RefreshMap;
end;

procedure TfrmRosterWindow.RenderItem(ritem: TJabberRosterItem;
  p: TJabberPres);
var
  i: integer;
begin
  for i := LvUsers.Items.Count - 1 downto 0 do
    if Tobject(LvUsers.Items.Item[i].Data) = ritem then
      if ritem.Groups.IndexOf(LvUsers.Items.Item[i].SubItems[1]) < 0 then
        LvUsers.Items.Delete(i);
  for i := 0 to ritem.Groups.Count - 1 do
    UpdateGroup(ritem.Groups[i]);
  if ritem.Groups.Count = 0 then
    UpdateGroup(sGrpUnfiled);
end;

procedure TfrmRosterWindow.LvUsersChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  LvUsers.Invalidate;
end;

procedure TfrmRosterWindow.S1Click(Sender: TObject);
var
  node: Tlistitem;
begin
  // send subscribe to this person
  node := LvUsers.Selected;
  if node = nil then exit;
  if node.Data = nil then exit;
  if (TObject(node.Data) is TJabberRosterItem) then
    SendSubscribe(TJabberRosterItem(node.Data).jid.jid, MainSession);
end;

procedure TfrmRosterWindow.LvUsersInfoTip(Sender: TObject; Item: TListItem;
  var InfoTip: string);
begin
  if item.Indent = 1 then
    if item.data <> nil then
      InfoTip := TJabberRosterItem(item.data).jid.jid;
end;

procedure TfrmRosterWindow.CollapseMailGroup;
var
  i, s, c: integer;
begin
  s := 1;

  LvUsers.Items.BeginUpdate;

  for i := s to LvUsers.Items.Count - 1 do
  begin
    if s >= LvUsers.Items.Count then
      break;
    if (LvUsers.Items.Item[s].Indent < 1) and (LvUsers.Items.Item[s].SubItems[0] <> '') then
      break;
    LvUsers.Items.Delete(s);
  end;

  LvUsers.Items.item[s - 1].ImageIndex := ico_right;
  LvUsers.Items.EndUpdate;
end;

procedure TfrmRosterWindow.ExpandMailGroup;
var
  i, s, c: integer;
  stxt: widestring;
begin
  s := 1;

  LvUsers.Items.BeginUpdate;

  for i := 0 to MailState.AccountCount - 1 do
  begin
    sTxt := MailState.states[i].AccountName;
    if stxt = '' then continue;
    with LvUsers.Items.Insert(s) do
    begin
      Data := nil;
      SubItems.Add(stxt);
      SubItems.Add('mailstate');
      Caption := '';
      Indent := 1;
      ImageIndex := 32;
    end;
  end;

  LvUsers.Items.item[s - 1].ImageIndex := ico_down;
  LvUsers.AlphaSort;
  LvUsers.Items.EndUpdate;
end;

procedure TfrmRosterWindow.UpdateMailGroup;
var
  i, s, c: integer;
  _show_online: boolean;
  itemlist: Tlist;
  stxt: widestring;
begin
  s := 1;

  if LvUsers.Items.item[s - 1].ImageIndex <> ico_Down then
    exit;

  LvUsers.Items.BeginUpdate;

  for i := s to LvUsers.Items.Count - 1 do
  begin
    if s >= LvUsers.Items.Count then
      break;
    if (LvUsers.Items.Item[s].Indent < 1) and (LvUsers.Items.Item[s].SubItems[0] <> '') then
      break;
    LvUsers.Items.Delete(s);
  end;

  for i := 0 to MailState.AccountCount - 1 do
  begin
    sTxt := MailState.states[i].AccountName;
    if stxt = '' then continue;
    with LvUsers.Items.Insert(s) do
    begin
      Data := nil;
      SubItems.Add(stxt);
      SubItems.Add('mailstate');
      Caption := '';
      Indent := 1;
      ImageIndex := 32;
    end;
  end;

  LvUsers.Items.item[s - 1].ImageIndex := ico_down;
  LvUsers.AlphaSort;
  LvUsers.Items.EndUpdate;
end;

procedure TfrmRosterWindow.popMailClick(Sender: TObject);
begin
  ShellExecute(0, 'open', pchar(extractfilepath(application.ExeName) + '\SMAIL\smail.exe'),
    pchar('-sendreceivemail '), pchar(extractfilepath(application.ExeName) + '\SMAIL\'), SW_NORMAL);
end;

procedure TfrmRosterWindow.LvUsersStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  if getItemType() <> item_ritem then
    abort;
end;

procedure TfrmRosterWindow.RxWindowHook1BeforeMessage(Sender: TObject;
  var Msg: TMessage; var Handled: Boolean);
var
  i: Integer;
  TaskBrush: HBrush;
  TaskPen: TPen;
  R: TRect;
  P: TPoint;
  DC: HDC;
  DrawItemStruct: TDrawItemStruct;
begin
  if Msg.Msg = WM_DRAWITEM then
  begin
    for i := 0 to 7 do
    begin
      if TaskButtons[i] = nil then Continue;
      if Msg.WParam = TaskButtons[i].Handle then
      begin
        DrawItemStruct := PDrawItemStruct(msg.LParam)^;
        R := DrawItemStruct.rcItem;
        DC := DrawItemStruct.hDC;

        if (((TaskButtons[i].Tag and $1) = $1) or (DrawItemStruct.itemState = ODS_FOCUS)) and (i = 0) then
          TaskBrush := CreateSolidBrush(ColorToRGB(clHighlight))
        else
          TaskBrush := CreateSolidBrush(ColorToRGB(TColor($FFFBF0)));

        if i = 0 then
        begin
          if (((TaskButtons[i].Tag and $1) = $1) or (DrawItemStruct.itemState = ODS_FOCUS)) then
          begin
            SetBkColor(DC, ColorToRGB(clHighlight));
            TTaskButton(TaskButtons[i]).Font.Color := clHighlightText;
          end
          else
          begin
            SetBkColor(DC, ColorToRGB(TColor($FFFBF0)));
            TTaskButton(TaskButtons[i]).Font.Color := clWindowText;
          end;
        end
        else
        begin
          if (((TaskButtons[i].Tag and $1) = $1) or (DrawItemStruct.itemState = ODS_FOCUS)) then
          begin
            TTaskButton(TaskButtons[i]).Font.Color := clBlue;
          end
          else
          begin
            TTaskButton(TaskButtons[i]).Font.Color := clWindowText;
          end;
        end;

        SelectObject(DC, TaskBrush);
        FillRect(DC, R, TaskBrush);

        case i of
          0:
            begin
              InflateRect(R, -4, -6);
              R.Left := R.Left + 4;
              R.Right := R.Right - 20;
              DrawText(DC, Pchar(sTasks[0]), Length(sTasks[0]), R, DT_END_ELLIPSIS);
            end;
          1..5:
            begin
              InflateRect(R, -4, -2);
              R.Left := R.Left + 24;
              R.Right := R.Right - 20;
              DrawText(DC, Pchar(sTasks[i]), Length(sTasks[i]), R, DT_END_ELLIPSIS);
              if (((TaskButtons[i].Tag and $1) = $1) or (DrawItemStruct.itemState = ODS_FOCUS)) then
                ImageList_Draw(ImageList2.Handle, i - 1, DC, R.Left - 18, R.Top - 2, ILD_SELECTED)
              else
                ImageList_Draw(ImageList2.Handle, i - 1, DC, R.Left - 18, R.Top - 2, ILD_TRANSPARENT);
            end;
          6:
            begin
              TaskPen := TPen.Create;
              TaskPen.Color := clNavy;
              TaskPen.Style := psSolid;
              TaskPen.Width := 1;
              MoveToEx(DC, R.Left + 4, R.Top + 8, nil);
              SelectObject(DC, TaskPen.Handle);
              LineTo(DC, R.Right - 4, R.Top + 8);
              TaskPen.Free;
            end;
          7:
            begin
              InflateRect(R, -4, -4);
              R.Left := R.Left + 24;
              R.Right := R.Right - 20;
              DrawText(DC, Pchar(sTasks[13]), Length(sTasks[13]), R, DT_END_ELLIPSIS);
            end;
        end;
        DeleteObject(TaskBrush);
        Exit;
      end;
    end;
  end;
end;

procedure TfrmRosterWindow.initTask;
var
  i: Integer;
begin
  TaskButtons[0] := TTaskButton.Create(Application);
  TaskButtons[0].Height := 24;
  TaskButtons[0].Width := pnlTask.Width;
  TaskButtons[0].top := 0;
  TaskButtons[0].Left := 0;
  TaskButtons[0].Parent := pnlTask;
  TTaskButton(TaskButtons[0]).Font := pnlTask.Font;
  TTaskButton(TaskButtons[0]).Font.Style := TTaskButton(TaskButtons[0]).Font.Style + [fsBold];

  for i := 1 to 5 do
  begin
    TaskButtons[i] := TTaskButton.Create(Application);
    TaskButtons[i].Height := 18;
    TaskButtons[i].Width := pnlTask.Width;
    TaskButtons[i].top := i * 18 + 6;
    TaskButtons[i].Left := 0;
    TaskButtons[i].Parent := pnlTask;
    TTaskButton(TaskButtons[i]).Font := pnlTask.Font;
  end;

  TaskButtons[6] := TTaskButton.Create(Application);
  TaskButtons[6].Height := 12;
  TaskButtons[6].Width := pnlTask.Width;
  TaskButtons[6].top := 6 * 18 + 6;
  TaskButtons[6].Left := 0;
  TaskButtons[6].Parent := pnlTask;
  TaskButtons[6].TabStop := false;

  TaskButtons[7] := TTaskButton.Create(Application);
  TaskButtons[7].Height := 20;
  TaskButtons[7].Width := pnlTask.Width;
  TaskButtons[7].top := 7 * 18;
  TaskButtons[7].Left := 0;
  TaskButtons[7].Parent := pnlTask;
  TTaskButton(TaskButtons[7]).Font := pnlTask.Font;
  TTaskButton(TaskButtons[7]).Font.Style := TTaskButton(TaskButtons[7]).Font.Style + [fsBold];

  for i := 0 to 7 do
  begin
    TaskButtons[i].Tag := 0;
    TaskButtons[i].Enabled := true;
    if i <> 6 then
      TaskButtons[i].Cursor := crHandPoint;
    TTaskButton(TaskButtons[i]).OnMouseMove := TaskMouseMove;
    TTaskButton(TaskButtons[i]).OnClick := TaskClick;
    SendMessage(TaskButtons[i].Handle, BM_SETSTYLE, BS_OWNERDRAW, 1);
    if i > 1 then
      TaskButtons[i].Visible := false;
  end;

  SetWindowLong(TaskButtons[0].Handle, GWL_STYLE, WS_GROUP or GetWindowLong(TaskButtons[0].Handle, GWL_STYLE));
//  pnlTask.DoubleBuffered := true;
end;

{ TTaskButton }

procedure TTaskButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Self.Cursor = crDefault then exit;
  if (self.tag and $1) <> $1 then
  begin
    self.tag := self.tag or $1;
    self.Repaint;
  end;
end;

procedure TTaskButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Self.Cursor = crDefault then exit;
  if (self.tag and $1) = $1 then
  begin
    self.tag := self.tag and $FFFFFFFE;
    self.Repaint;
  end;
end;

procedure TTaskButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  CreateSubClass(Params, 'BUTTON');
end;

procedure TfrmRosterWindow.TaskClick(Sender: TObject);
var
  i: Integer;
begin
  if sender = TaskButtons[6] then exit;
  if sender = TaskButtons[0] then
  begin
    TaskButtons[0].Enabled := false;
    TaskButtons[0].Enabled := True;
    CheckTaskExpand;
    exit;
  end;
  if sender = TaskButtons[7] then
  begin
    TaskButtons[7].Enabled := false;
    TaskButtons[7].Enabled := True;
    PopTaskMenu;
    exit;
  end;
  for i := 1 to 5 do
  begin
    if sender = TaskButtons[i] then
    begin
      TaskButtons[i].Enabled := false;
      TaskButtons[i].Enabled := True;
      TaskButtons[i].Tag := TaskButtons[i].Tag and $FFFFFFFE;
      TaskButtons[i].Repaint;
      case i of
        1: frmAnyQ.W1.Click;    //mnuAddContactClick(Self);
        2: frmAnyQ.mnuChat.Click;
        3: frmAnyQ.popSendFile1.Click;
        4: frmAnyQ.N110.Click;
        5: frmAnyQ.E1.Click;
      end;
      exit;
    end;
  end;
end;

procedure TfrmRosterWindow.pnlTaskResize(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to 7 do
  begin
    TaskButtons[i].Width := pnlTask.Width;
    SendMessage(TaskButtons[i].Handle, BM_SETSTYLE, BS_OWNERDRAW, 1);
  end;
end;

procedure TfrmRosterWindow.TaskMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
{var
  i: Integer;{}
begin
{  TTaskButton(sender).MouseCapture := true;
  If not PtInRect(TTaskButton(sender).ClientRect, point(X,Y)) then
  begin
    TTaskButton(sender).MouseCapture := false;
    exit;
  end;

  for i:= 0 to 7 do
  begin
    if not TaskButtons[i].Visible then continue;
    if i=6 then continue;
    if sender= TaskButtons[i] then
    begin
      if (TaskButtons[i].tag and $1) <> $1 then
      begin
        TaskButtons[i].tag := TaskButtons[i].tag or $1;
        TaskButtons[i].Repaint;
      end;
    end
    else
    begin
      if (TaskButtons[i].tag and $1) = $1 then
      begin
        TaskButtons[i].tag := TaskButtons[i].tag and $FFFFFFFE;
        TaskButtons[i].Repaint;
      end;
    end;
  end;  {}
end;

procedure TfrmRosterWindow.CheckTaskExpand;
var
  i: Integer;
begin
  TaskButtons[0].Tag := TaskButtons[0].Tag xor $80000000;
  if TaskButtons[0].Tag and $80000000 <> $80000000 then
  begin
    for i := 2 to 7 do
      TaskButtons[i].Visible := false;
    TaskButtons[1].Top := 25;
    frmRosterWindow.DisableAlign;
    pnlTask.Height := 24 + 20;
    frmRosterWindow.EnableAlign;
  end
  else
  begin
    for i := 0 to 7 do
      TaskButtons[i].Visible := true;
    TaskButtons[1].Top := 24;
    frmRosterWindow.DisableAlign;
    pnlTask.Height := 7 * 18 + 20;
    pnlTask.Top := frmRosterWindow.ClientHeight - pnlTask.Height - pnlShow.Height - 1;
    frmRosterWindow.EnableAlign;
  end;
end;

procedure TfrmRosterWindow.PopTaskMenu;
var
  i: Integer;
  Item: TMenuItem;
  P: TPoint;
begin
  with popTask do
  begin
    items.Clear;
    for i := 6 to 11 do
    begin
      Item := TMenuItem.Create(items);
      Item.Caption := sTasks[i];
      Item.Tag := i;
      Item.ImageIndex := i - 1;
      Item.OnClick := TaskMenuClick;
      items.Add(Item);
    end;
    P := TaskButtons[7].ClientToScreen(Point(TaskButtons[7].width, TaskButtons[7].height));
    Popup(p.X, p.Y);
  end;
end;

procedure TfrmRosterWindow.TaskMenuClick(Sender: TObject);
begin
  case TMenuItem(Sender).Tag of
    6: frmAnyQ.A1.Click;
    7: frmAnyQ.V1.Click;
    8: frmAnyQ.NewGroup2.Click;
    9: frmAnyQ.N30.Click;
    10: frmAnyQ.popInstantMail1.Click;
    11: frmAnyQ.W2.Click;
  end;
end;

procedure TfrmRosterWindow.popPopup(Sender: TObject);
begin
//  frmAnyQ.SkinData1.SkinForm(self.Handle);
  if frmAnyQ.SkinData1.Active then
    frmAnyQ.SkinData1.UpdateMenu(self);
end;

procedure TfrmRosterWindow.FormShow(Sender: TObject);
begin
  if frmAnyQ.SkinData1.Active then
    frmAnyQ.SkinData1.AddNestForm(frmAnyQ, Self);
//  if frmAnyQ.SkinData1.Active then
//    frmAnyQ.SkinData1.SkinForm(self.Handle);
end;

procedure TfrmRosterWindow.DeleteGroup(grp: widestring);
var
  i, s, c: integer;
begin
  s := -1;
  for i := 0 to LvUsers.Items.Count - 1 do
  begin
    if LvUsers.Items.Item[i].Indent >= 1 then
      Continue;
    if LvUsers.Items.Item[i].SubItems[0] = grp then
    begin
      s := i;
      break;
    end;
  end;
  if s = -1 then exit;
  s := s + 1;

  LvUsers.Items.BeginUpdate;

  for i := s to LvUsers.Items.Count - 1 do
  begin
    if s >= LvUsers.Items.Count then
      break;
    if (LvUsers.Items.Item[s].Indent < 1) and (LvUsers.Items.Item[s].SubItems[0] <> '') then
      break;
    LvUsers.Items.Delete(s);
  end;
  LvUsers.Items.Delete(s-1);
//  LvUsers.Items.item[s - 1].ImageIndex := ico_right;
  LvUsers.Items.EndUpdate;
end;

procedure TfrmRosterWindow.BroadcastSMSClick(Sender: TObject);
var
  r: TList;
  jl: TWideStringList;
  i: integer;
begin
  r := getSelectedContacts(false);
  with TfrmBroadcastSMS.Create(Application) do
  begin
    frameTreeRoster1.Check(r);
    if (frmAnyQ.isMinimized()) then
      ShowWindow(Handle, SW_SHOWMINNOACTIVE)
    else
      ShowWindow(Handle, SW_SHOWNOACTIVATE);
    Show;
    SetFocus;
    Activate;
  end;
  r.Clear();
  r.Free();
end;

procedure TfrmRosterWindow.vcardCallback(event: string; tag: TXMLTag);
var
  jid: WideString;
  vcard: TXMLVCard;
  procedure ChageNick(sjid, snick, smobile: widestring);
  var
    ritem: TJabberRosterItem;
    changed: boolean;
    i: integer;
    tmp_grplist: TStringList;
  begin
      // if the nick has changed then change the roster item
    ritem := MainSession.roster.Find(sjid);
    changed := false;
    if ritem <> nil then begin
      ritem.RcvVcard := True;
      if ritem.RawNickname <> snick then begin
        ritem.RawNickname := snick;
        changed := true;
      end;

      if ritem.mobile <> smobile then begin
        ritem.mobile := smobile;
        changed := true;
      end;

      if changed then
      begin
        ritem.update();
        MainSession.FireEvent('/roster/item', nil, ritem);
      end;
    end;
  end;
begin
  // callback for vcard info
  if self=nil then exit;
  if (MainSession=nil) or (not MainSession.Active) then
    exit;
  if (event <> 'xml') then exit;
  jid := tag.getAttribute('from');
  vcard := TXMLVCard.Create;
  vcard.parse(tag);

  with vcard do begin
    ChageNick(jid, nick, WorkCell.number);
  end;

  vcard.Free();
end;

procedure TfrmRosterWindow.popToolbuttonPopup(Sender: TObject);
begin
  if popToolbutton.PopupComponent is TToolButton then
  begin
    NAlogout.Caption := '注销'+TToolButton(popToolbutton.PopupComponent).Caption;
    NAlogin.Caption := '登录'+TToolButton(popToolbutton.PopupComponent).Caption;
    NAlogout.Enabled := MainSession.Active and (TToolButton(popToolbutton.PopupComponent).ImageIndex<5) and (TToolButton(popToolbutton.PopupComponent).Tag=1);
    NAlogin.Enabled := MainSession.Active and not NAlogout.Enabled and (TToolButton(popToolbutton.PopupComponent).Tag=1);
    NACfg.Enabled := MainSession.Active;
  end;
end;

procedure TfrmRosterWindow.NACfgClick(Sender: TObject);
begin
  if popToolbutton.PopupComponent is TToolButton then
  begin
//    TToolButton(popToolbutton.PopupComponent). Click;
    if popToolbutton.PopupComponent=tbOicq then
      TransportsCfg('oicq');
    if popToolbutton.PopupComponent=tbIcq then
      TransportsCfg('icq');
    if popToolbutton.PopupComponent=tbMsn then
      TransportsCfg('msn');
    if popToolbutton.PopupComponent=tbAim then
      TransportsCfg('aim');
    if popToolbutton.PopupComponent=tbYahoo then
      TransportsCfg('yahoo');
  end;
end;

procedure TfrmRosterWindow.NAlogoutClick(Sender: TObject);
  procedure Logout(server: string);
  var
    tag: TXMLTag;
  begin
    tag := TXMLTag.Create('presence');
    tag.setAttribute('to', server);
    tag.setAttribute('type', 'unavailable');
    MainSession.SendTag(Tag);
  end;
begin
  if popToolbutton.PopupComponent is TToolButton then
  begin
    if popToolbutton.PopupComponent=tbOicq then
      Logout('oicq.'+MainSession.Server);
    if popToolbutton.PopupComponent=tbIcq then
      Logout('icq.'+MainSession.Server);
    if popToolbutton.PopupComponent=tbMsn then
      Logout('msn.'+MainSession.Server);
    if popToolbutton.PopupComponent=tbAim then
      Logout('aim.'+MainSession.Server);
    if popToolbutton.PopupComponent=tbYahoo then
      Logout('yahoo.'+MainSession.Server);
  end;
end;

procedure TfrmRosterWindow.NAloginClick(Sender: TObject);
  procedure Login(server: string);
  var
    tag: TXMLTag;
  begin
    tag := TXMLTag.Create('presence');
    tag.setAttribute('to', server);
//    tag.AddBasicTag('status', 'Available');
//    tag.AddBasicTag('priority', '1');
    MainSession.SendTag(Tag);
  end;
begin
  if popToolbutton.PopupComponent is TToolButton then
  begin
    if popToolbutton.PopupComponent=tbOicq then
      Login('oicq.'+MainSession.Server);
    if popToolbutton.PopupComponent=tbIcq then
      Login('icq.'+MainSession.Server);
    if popToolbutton.PopupComponent=tbMsn then
      Login('msn.'+MainSession.Server);
    if popToolbutton.PopupComponent=tbAim then
      Login('aim.'+MainSession.Server);
    if popToolbutton.PopupComponent=tbYahoo then
      Login('yahoo.'+MainSession.Server);
  end;
end;

initialization
  frmRosterWindow := nil;
end.

