unit entusers;

interface

uses
  IQ, XMLTag, Contnrs,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, Menus, Dockable;

type
  TfrmEntUsers = class(TfrmDockable)
    PopupMenu1: TPopupMenu;
    popAdd: TMenuItem;
    popProfile: TMenuItem;
    N1: TMenuItem;
    popChat: TMenuItem;
    popMessage: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    lstContacts: TListView;
    Panel5: TPanel;
    Button1: TButton;
    Panel6: TPanel;
    BtnClose: TButton;
    aniWait: TAnimate;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure BtnCloseClick(Sender: TObject);
    procedure lstContactsData(Sender: TObject; Item: TListItem);
    procedure lstContactsContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure popAddClick(Sender: TObject);
    procedure popProfileClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure lstContactsDblClick(Sender: TObject);
    procedure lstContactsDataFind(Sender: TObject; Find: TItemFind;
      const FindString: string; const FindPosition: TPoint;
      FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
      Wrap: Boolean; var Index: Integer);
  private
    { Private declarations }
    field_set: TStringList;
    virtlist: TObjectList;
    jid_col: integer;


    cur_iq: TJabberIQ;
    cur_state: string;
    procedure ItemsCallback(event: string; tag: TXMLTag);
  public
    { Public declarations }
    domain: widestring;
    procedure sendRequest;
  end;

var
  frmEntUsers: TfrmEntUsers;

procedure showentusers(sdomain: widestring);

implementation

uses jud, Unicode, RiserWindow, JabberConst, Jabber1, ExUtils, Session,
  Roster, JabberID, Profile;

{$R *.dfm}

procedure showentusers(sdomain: widestring);
begin
  with TfrmEntUsers.create(application) do
  begin
    domain := sdomain;
    sendRequest;
    showmodal;
  end;
end;
{ TfrmEntUsers }

procedure TfrmEntUsers.ItemsCallback(event: string; tag: TXMLTag);
var
  cidx, i, c: integer;
  items, cols: TXMLTagList;
  cur: TXMLTag;
  col: TListColumn;
  ji: TJUDItem;
  jid_fld: Widestring;
  clist: TWideStringList;
  tmps: Widestring;
begin
    // callback when we get our search results back
  cur_iq := nil;
  clist := nil;
  aniWait.Visible := false;
  aniWait.Active := false;

  if (event <> 'xml') then begin
        // timeout
    cur_state := 'get_fields';
    ShowRiserWindow(nil, sJUDTimeout, 12);
        //MessageBox(Handle,Pchar(sJUDTimeout), '´íÎó', MB_OK OR MB_ICONERROR);
    exit;
  end
  else begin
        // tag
        {
        <iq from='users.jabber.org' id='jcl_6' to='pgm-foo@jabber.org/Exodus' type='result'>
        <query xmlns='jabber:iq:search'>
        <item jid='clever@jabber.org'>
            <nick>Clever</nick>
            <first>Hennie</first>
            <email>clever@jabber.com</email>
            <last/>
        </item></query></iq>
        }

        // get all the returned items
    items := nil;
    if (cur_state = 'items') then
      items := tag.QueryXPTags('/iq/query/item');

    if ((items = nil) or (items.Count = 0)) then
      items := tag.QueryXPTags('//x[@xmlns="jabber:x:data"]/item');

    if ((items = nil) or (items.Count = 0)) then begin
      items.Free();
      cur_state := 'get_fields';
      lstContacts.Clear();
      ShowRiserWindow(nil, sJUDEmpty, 12);
            //MessageBox(Handle,Pchar(sJUDEmpty), 'ÐÅÏ¢', MB_OK OR MB_ICONINFORMATION);
      exit;
    end;

    lstContacts.AllocBy := 25;
    lstContacts.Items.Clear;
    virtlist.Clear();

    lstContacts.Columns.Clear();

        // setup the columns for items (no x-data)
    if (cur_state = 'items') then begin
            // use the first item in the list
      cur := items[0];
      cols := cur.ChildTags();

      with lstContacts.Columns.Add() do begin
                // add a JID column by default
        Caption := sJID;
        Width := 100;
        jid_col := 0;
      end;

      for i := 0 to cols.count - 1 do begin
        col := lstContacts.Columns.Add();
        col.Caption := getDisplayField(cols[i].Name);
        col.Width := 100;
      end;

      cols.Free();
    end
    else begin
            // reported columns for x-data, setup columns
      cols := tag.QueryXPTags('//x[@xmlns="jabber:x:data"]/reported/field');
      clist := TWidestringList.Create();
      if (cols <> nil) then begin
        for i := 0 to cols.Count - 1 do begin
          with lstContacts.Columns.Add() do begin
            Caption := cols[i].GetAttribute('label');
            Width := 100;
            tmps := cols[i].getAttribute('type');
            if ((tmps = 'jid') or (tmps = 'jid-single')) then begin
              jid_col := i;
              jid_fld := cols[i].GetAttribute('var');
            end;
          end;
          clist.Add(cols[i].GetAttribute('var'));
        end;
        cols.Free();
      end;
    end;

        // populate the listview.
    for i := 0 to items.count - 1 do begin
      cur := items[i];
      ji := TJUDItem.Create();

      if (cur_state = 'items') then begin
        ji.xdata := false;
        cols := cur.ChildTags();
        ji.jid := cur.GetAttribute('jid');
        ji.count := lstContacts.Columns.Count + 1;
        for c := 0 to cols.count - 1 do
          ji.cols[c + 1] := cols[c].Data;
        cols.Free();
      end

      else begin // xitems
        ji.xdata := true;
        cols := cur.QueryTags('field');
        ji.count := cols.Count;
        for c := 0 to cols.count - 1 do begin
          tmps := cols[c].getAttribute('var');
          cidx := clist.indexOf(tmps);
          if (cidx > -1) then begin
            ji.cols[cidx] := cols[c].GetBasicText('value');
            if (tmps = jid_fld) then
              ji.jid := ji.cols[cidx];
          end;
        end;
        cols.Free();
      end;

      virtlist.Add(ji);
    end;

    lstContacts.Items.Count := virtlist.Count;

    if (clist <> nil) then clist.Free();
    if (items <> nil) then Items.Free();

    aniWait.Visible := false;
    cur_state := 'add';
  end;
end;

procedure TfrmEntUsers.sendRequest;
begin
  // make sure we wait for a long time for really nasty queries and slow agents :)
  cur_iq := TJabberIQ.Create(MainSession, MainSession.generateID(), ItemsCallback, 120);
  with cur_iq do begin
    iqType := 'set';
    Namespace := XMLNS_SEARCH;
    toJid := 'user.' + domain;
    cur_iq.qTag.AddBasicTag('domain', domain);
  end;
  cur_state := 'items';
  cur_iq.Send();
end;

procedure TfrmEntUsers.FormCreate(Sender: TObject);
begin
  inherited;

  cur_state := 'get_fields';
  field_set := TStringList.Create();
  virtlist := TObjectList.Create();
  virtlist.OwnsObjects := true;
end;

procedure TfrmEntUsers.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  field_set.Free();
  virtlist.Free();
  Action := caFree;
end;

procedure TfrmEntUsers.BtnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmEntUsers.lstContactsData(Sender: TObject; Item: TListItem);
var
  i: integer;
  ji: TJUDItem;
begin
  inherited;
  if (Item.Index < 0) then exit;
  if (Item.Index >= virtlist.Count) then exit;

  ji := TJUDItem(virtlist[Item.Index]);
  if ji <> nil then begin
    if (ji.xdata) then
      Item.Caption := ji.cols[0]
    else
      Item.Caption := ji.jid;
    Item.SubItems.Clear();
    for i := 1 to ji.count do
      item.SubItems.Add(ji.cols[i]);
  end;
end;

procedure TfrmEntUsers.lstContactsContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
var
  multi: boolean;
begin
  inherited;
  multi := (lstContacts.SelCount > 1);
  if multi then
    popAdd.Caption := sJUDAdd
  else
    popAdd.Caption := sJUDAdd;

  popProfile.Enabled := not multi;
  popChat.Enabled := not multi;
  popMessage.Enabled := not multi;
end;

procedure TfrmEntUsers.popAddClick(Sender: TObject);
var
  i: integer;

  procedure doAdd(item: TListItem);
  var
    ritem: TJabberRosterItem;
    jid: TJabberID;
  begin
        // do the actual add stuff
    ritem := MainSession.roster.Find(item.Caption);
    if (ritem <> nil) then begin
      if ((ritem.subscription = 'to') or (ritem.subscription = 'both')) then
        exit;
    end;

        // add the item
    jid := TJabberID.Create(item.caption);
    MainSession.roster.AddItem(item.caption, jid.user, sGrpUnfiled, true);
    jid.Free();

  end;

begin
  inherited;
    // add selected contacts
  if (lstContacts.SelCount = 1) then
        // only a single user
    doAdd(lstContacts.Selected)
  else begin
    for i := 0 to lstContacts.Items.Count - 1 do begin
      if lstContacts.Items[i].Selected then
        doAdd(lstContacts.Items[i]);
    end;
  end;
end;

procedure TfrmEntUsers.popProfileClick(Sender: TObject);
begin
  inherited;
    // view the profile for the user
  ShowProfile(lstContacts.Selected.Caption);
end;

procedure TfrmEntUsers.Button1Click(Sender: TObject);
begin
  popAdd.Click;
end;

procedure TfrmEntUsers.lstContactsDblClick(Sender: TObject);
begin
  inherited;
  if lstContacts.Selected <> nil then
    ShowProfile(lstContacts.Selected.Caption);
end;

procedure TfrmEntUsers.lstContactsDataFind(Sender: TObject;
  Find: TItemFind; const FindString: string; const FindPosition: TPoint;
  FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
  Wrap: Boolean; var Index: Integer);
var
  ji: TJUDItem;
  i: integer;
  f: boolean;
begin
  inherited;
    // todo: This may have bugs still.. incremental searching in JUD results

    // OnDataFind gets called in response to calls to FindCaption, FindData,
    // GetNearestItem, etc. It also gets called for each keystroke sent to the
    // ListView (for incremental searching)

  i := StartIndex;

  if (Find = ifExactString) or (Find = ifPartialString) then begin
    repeat
      if (i = virtlist.Count - 1) then begin
        if Wrap then i := 0 else exit;
      end;
      ji := TJUDItem(virtlist[i]);
      f := Pos(FindString, ji.jid) > 0;
      inc(i);
    until (f or (i = StartIndex));
    if (f) then Index := i - 1;
  end;
end;

end.
