unit GetContact;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Dockable, ComCtrls, RxGIF, ExtCtrls, StdCtrls;

type
  TfrmGetContact = class(TfrmDockable)
    Panel1: TPanel;
    PageControl1: TPageControl;
    tabContact: TTabSheet;
    tabOther: TTabSheet;
    Panel2: TPanel;
    Panel3: TPanel;
    lvRoster: TListView;
    lbedtSID: TLabeledEdit;
    Label1: TLabel;
    lbContact: TLabel;
    btnCancel: TButton;
    btnOk: TButton;
    lbOther: TLabel;
    procedure tabOtherShow(Sender: TObject);
    procedure lbedtSIDChange(Sender: TObject);
    procedure tabContactShow(Sender: TObject);
    procedure lvRosterChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure lvRosterDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    ShowOnlineOnly: Boolean;
    ResultSID: widestring;
    procedure initlist;
    { Public declarations }
  end;

var
  frmGetContact: TfrmGetContact;

function GetContactSID(const sCaption, sContact, sOther: string; var SID: widestring; onlineonly: boolean = false): Boolean;

implementation

uses Session, presence, Roster, JabberID, Jabber1;

{$R *.dfm}

function GetContactSID(const sCaption, sContact, sOther: string; var SID: widestring; onlineonly: boolean = false): Boolean;
begin
  Result := false;
  with TfrmGetContact.Create(Application) do
  try
    Caption := sCaption;
    lbContact.Caption := sContact;
    lbOther.Caption := sOther;
    ShowOnlineOnly := onlineonly;
    initlist;
    Result := showmodal = mrok;
    SID := ResultSID;
  finally
    Free;
  end;
end;

{ TfrmGetContact }

procedure TfrmGetContact.initlist;
var
  i: integer;
  ri: TJabberRosterItem;
  p: TJabberPres;
  tmp: widestring;
  tmpindex: integer;
begin
  lvRoster.Clear;
  lvRoster.Items.BeginUpdate;

  with MainSession.Roster do begin
    for i := 0 to Count - 1 do begin
      ri := TJabberRosterItem(Objects[i]);
      p := MainSession.ppdb.FindPres(ri.JID.jid, '');
      if ri.jid.jid = MainSession.BareJid then
        Continue;
      if ri.jid.user = '' then
        Continue;
      if ShowOnlineOnly and ((p = nil) or (p.PresType = 'unavailable')) then
        Continue;
      with lvRoster.Items.Add do
      begin
        Data := ri;
        Caption := ri.Nickname;
        if p = nil then
          ImageIndex := ico_Offline
        else begin
          if p.Show = 'away' then
            ImageIndex := ico_Away
          else if p.Show = 'xa' then
            ImageIndex := ico_XA
          else if p.Show = 'dnd' then
            ImageIndex := ico_DND
          else
            ImageIndex := ico_Online;
        end;

        tmpindex := ImageIndex;

        tmp := TJabberRosterItem(Data).jid.domain;
        if pos('oicq.', tmp) = 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.', tmp) = 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.', tmp) = 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.', tmp) = 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.', tmp) = 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;

        ImageIndex := tmpindex;
      end;
    end;
  end;

  lvRoster.AlphaSort;
  lvRoster.Items.EndUpdate;
end;

procedure TfrmGetContact.tabOtherShow(Sender: TObject);
begin
  ResultSID := trim(lbedtSID.Text);
  btnOk.Enabled := ResultSID <> '';
end;

procedure TfrmGetContact.lbedtSIDChange(Sender: TObject);
begin
  ResultSID := trim(lbedtSID.Text);
  btnOk.Enabled := ResultSID <> '';
end;

procedure TfrmGetContact.tabContactShow(Sender: TObject);
begin
  btnOk.Enabled := lvRoster.Selected <> nil;
  if btnOk.Enabled then
    ResultSID := trim(TJabberRosterItem(lvRoster.Selected.Data).jid.jid)
  else
    ResultSID := '';
end;

procedure TfrmGetContact.lvRosterChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  btnOk.Enabled := lvRoster.Selected <> nil;
  if btnOk.Enabled then
    ResultSID := trim(TJabberRosterItem(lvRoster.Selected.Data).jid.jid);
end;

procedure TfrmGetContact.lvRosterDblClick(Sender: TObject);
begin
  inherited;
  if lvRoster.Selected <> nil then
    ModalResult := mrOk;
end;

procedure TfrmGetContact.FormCreate(Sender: TObject);
begin
  inherited;
  Label1.Caption := '键入此人完整的'+ProductName+' ID（例如，somebody@'+DefaultServerName+'）';
end;

end.
