unit FindEnt;

interface

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

type

  TfrmFindEnt = class(TfrmDockable)
    PageControl1: TPageControl;
    Panel1: TPanel;
    tabSearch: TTabSheet;
    tabResult: TTabSheet;
    Label1: TLabel;
    Panel2: TPanel;
    lvEnt: TListView;
    lbledtCompany: TLabeledEdit;
    lbledtService: TLabeledEdit;
    btnprv: TButton;
    btnNext: TButton;
    btnCancel: TButton;
    Panel3: TPanel;
    Button1: TButton;
    Button2: TButton;
    coboProvince: TTntComboBox;
    Label6: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    coboMode: TTntComboBox;
    coboTrade: TTntComboBox;
    coboSubtrade: TTntComboBox;
    tabUsers: TTabSheet;
    lvUsers: TListView;
    Panel4: TPanel;
    Panel5: TPanel;
    aniWait: TAnimate;
    Label2: TLabel;
    Panel6: TPanel;
    Label7: TLabel;
    Animate2: TAnimate;
    Button3: TButton;
    PopupMenu1: TPopupMenu;
    popAdd: TMenuItem;
    popProfile: TMenuItem;
    N1: TMenuItem;
    popChat: TMenuItem;
    popMessage: TMenuItem;
    procedure btnNextClick(Sender: TObject);
    procedure btnprvClick(Sender: TObject);
    procedure lvEntData(Sender: TObject; Item: TListItem);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure lvEntDblClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure coboTradeChange(Sender: TObject);
    procedure coboChange(Sender: TObject);
    procedure lvEntChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure lvUsersContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure lvUsersData(Sender: TObject; Item: TListItem);
    procedure lvUsersDataFind(Sender: TObject; Find: TItemFind;
      const FindString: string; const FindPosition: TPoint;
      FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
      Wrap: Boolean; var Index: Integer);
    procedure lvUsersDblClick(Sender: TObject);
    procedure popAddClick(Sender: TObject);
    procedure popProfileClick(Sender: TObject);
  private
    { Private declarations }
    HYFL: TXMLTag;
    EntInfos: array of TEnterpriseInfo;
    cur_iq: TJabberIQ;
    field_set: TStringList;
    virtlist: TObjectList;
    jid_col: integer;

    cur_state: string;
    procedure Checkparam;
  public
    { Public declarations }
    procedure SendRequest;
    procedure SendSerach(domain: widestring);
    procedure ItemsCallback(event: string; tag: TXMLTag);
    procedure UserItemsCallback(event: string; tag: TXMLTag);
  end;

var
  frmFindEnt: TfrmFindEnt;

procedure StartFindEnt;

implementation

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

{$R *.dfm}

procedure StartFindEnt;
begin
  with TfrmFindEnt.Create(Application) do
    ShowModal;
end;

procedure TfrmFindEnt.btnNextClick(Sender: TObject);
begin
  case PageControl1.ActivePageIndex of
    0:
      begin
        Checkparam;
//        btnNext.Enabled := false;
        btnprv.Enabled := true;
        PageControl1.ActivePage := tabResult;
        lvEnt.Clear;
        lvEnt.Items.Count := 0;
        sendRequest;
      end;
    1:
      begin
        btnNext.Enabled := true;
        btnNext.caption := '完成';
        btnprv.Enabled := true;
        PageControl1.ActivePage := tabUsers;
        lvUsers.Clear;
        lvUsers.Items.Count := 0;
        if lvEnt.Selected <> nil then
          sendSerach(EntInfos[lvEnt.Selected.Index].Domain);
      end;
    2:
      close;
  end;
end;

procedure TfrmFindEnt.btnprvClick(Sender: TObject);
begin
  btnNext.Caption := '下一步(&N)＞';
  btnNext.Enabled := true;
  if PageControl1.ActivePageIndex > 0 then
    PageControl1.ActivePageIndex := PageControl1.ActivePageIndex - 1;
  btnprv.Enabled := PageControl1.ActivePageIndex <= 0;
//  PageControl1.ActivePage := tabSearch;
end;

procedure TfrmFindEnt.Checkparam;
var
  valid: boolean;
begin
  valid := false;
  valid := valid or (lbledtCompany.Text <> '');
  valid := valid or (lbledtService.Text <> '');
  valid := valid or (coboMode.ItemIndex <= 0);
  valid := valid or (coboTrade.ItemIndex <= 0);
  valid := valid or (coboSubtrade.ItemIndex <= 0);
  valid := valid or (coboProvince.ItemIndex <= 0);
  if not valid then
  begin
    ShowRiserWindow(nil, '请输入查询条件！', ico_info);
    //MessageBox(handle, '请输入查询条件！', '错误',MB_OK or MB_ICONERROR);
    abort;
  end;
end;

procedure TfrmFindEnt.ItemsCallback(event: string; tag: TXMLTag);
var
  cidx, i, c: integer;
  items, cols: TXMLTagList;
  cur, CurItem: TXMLTag;
  CurEI: TEnterpriseInfo;
  XState: Boolean;
//    col: TListColumn;
//    jid_fld: Widestring;
//    clist: TWideStringList;
  tmps, tmpV: Widestring;

  procedure GetValue;
  begin
    CurItem := cur.GetFirstTag('company');
    if CurItem <> nil then
      CurEI.Company := CurItem.Data;
    CurItem := cur.GetFirstTag('service');
    if CurItem <> nil then
      CurEI.Service := CurItem.Data;
    CurItem := cur.GetFirstTag('mode');
    if CurItem <> nil then
      CurEI.mode := CurItem.Data;
    CurItem := cur.GetFirstTag('trade');
    if CurItem <> nil then
      CurEI.trade := CurItem.Data;
    CurItem := cur.GetFirstTag('subtrade');
    if CurItem <> nil then
      CurEI.subtrade := CurItem.Data;
    CurItem := cur.GetFirstTag('person');
    if CurItem <> nil then
      CurEI.person := CurItem.Data;
    CurItem := cur.GetFirstTag('tel');
    if CurItem <> nil then
      CurEI.tel := CurItem.Data;
    CurItem := cur.GetFirstTag('fax');
    if CurItem <> nil then
      CurEI.fax := CurItem.Data;
    CurItem := cur.GetFirstTag('province');
    if CurItem <> nil then
      CurEI.province := CurItem.Data;
    CurItem := cur.GetFirstTag('city');
    if CurItem <> nil then
      CurEI.city := CurItem.Data;
    CurItem := cur.GetFirstTag('street');
    if CurItem <> nil then
      CurEI.street := CurItem.Data;
    CurItem := cur.GetFirstTag('postcode');
    if CurItem <> nil then
      CurEI.postcode := CurItem.Data;
    CurItem := cur.GetFirstTag('url');
    if CurItem <> nil then
      CurEI.url := CurItem.Data;
    CurItem := cur.GetFirstTag('content');
    if CurItem <> nil then
      CurEI.content := CurItem.Data;
    CurItem := cur.GetFirstTag('domain');
    if CurItem <> nil then
      CurEI.Domain := CurItem.Data;
  end;

  procedure GetXValue(s, v: widestring);
  begin
    if (s = 'jid') or (s = 'jid-single') then begin
      CurEI.CID := v;
      exit;
    end;
    if (s = 'company') then begin
      CurEI.company := v;
      exit;
    end;

    if (s = 'service') then begin
      CurEI.Service := v;
      exit;
    end;
    if (s = 'mode') then begin
      CurEI.mode := v;
      exit;
    end;
    if (s = 'trade') then begin
      CurEI.trade := v;
      exit;
    end;
    if (s = 'subtrade') then begin
      CurEI.subtrade := v;
      exit;
    end;
    if (s = 'person') then begin
      CurEI.person := v;
      exit;
    end;
    if (s = 'tel') then begin
      CurEI.tel := v;
      exit;
    end;
    if (s = 'fax') then begin
      CurEI.fax := v;
      exit;
    end;
    if (s = 'province') then begin
      CurEI.province := v;
      exit;
    end;
    if (s = 'city') then begin
      CurEI.city := v;
      exit;
    end;
    if (s = 'street') then begin
      CurEI.street := v;
      exit;
    end;
    if (s = 'postcode') then begin
      CurEI.postcode := v;
      exit;
    end;
    if (s = 'url') then begin
      CurEI.url := v;
      exit;
    end;
    if (s = 'content') then begin
      CurEI.content := v;
      exit;
    end;
    if (s = 'domain') then begin
      CurEI.Domain := v;
      exit;
    end;
  end;
begin
  XState := false;
    // callback when we get our search results back
  cur_iq := nil;
  if aniWait=nil then
    exit;
  aniWait.Visible := false;
  aniWait.Active := false;

  if (event <> 'xml') then begin
        // timeout
    ShowRiserWindow(nil, '查询超时', ico_info);
        //MessageBox(Handle,'查询超时', '错误', 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;
    items := tag.QueryXPTags('/iq/query/item');

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

    if ((items = nil) or (items.Count = 0)) then begin
      items.Free();
      ShowRiserWindow(nil, '没有找到符合条件的企业！', ico_info);
            //MessageBox(Handle,'没有找到符合条件的企业！', '信息', MB_OK OR MB_ICONINFORMATION);
      exit;
    end;


    setlength(EntInfos, items.Count);

    for i := 0 to items.count - 1 do begin
      cur := items[i];

      if not XState then begin
        CurEI.CID := cur.GetAttribute('jid');
        GetValue;
        EntInfos[i] := CurEI;
      end
      else begin // xitems
        cols := cur.QueryTags('field');
        for c := 0 to cols.count - 1 do begin
          tmps := cols[c].getAttribute('var');
          tmpv := cols[c].GetBasicText('value');
          GetXValue(tmps, tmpv);
        end;
        cols.Free();
        EntInfos[i] := CurEI;
      end;
    end;

    lvEnt.Items.Count := items.Count;

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

    aniWait.Visible := false;
  end;
end;

procedure TfrmFindEnt.sendRequest;
var
  i: integer;
  valid: boolean;
  x, fx: TXMLTag;
begin
  valid := true;

  cur_iq := TJabberIQ.Create(MainSession, MainSession.generateID(), ItemsCallback, 30);
  with cur_iq do begin
    iqType := 'set';
    Namespace := XMLNS_SEARCH;
    toJid := sEntServer;

    if lbledtCompany.Text <> '' then
      cur_iq.qTag.AddBasicTag('company', lbledtCompany.Text);
    if lbledtService.Text <> '' then
      cur_iq.qTag.AddBasicTag('service', lbledtService.Text);

    if coboMode.ItemIndex > 0 then
      cur_iq.qTag.AddBasicTag('mode', coboMode.Text);
    if coboTrade.ItemIndex > 0 then
      cur_iq.qTag.AddBasicTag('trade', coboTrade.Text);
    if coboSubtrade.ItemIndex > 0 then
      cur_iq.qTag.AddBasicTag('subtrade', coboSubtrade.Text);
    if coboProvince.ItemIndex > 0 then
      cur_iq.qTag.AddBasicTag('province', coboProvince.Text);
  end;
  aniWait.Visible := true;
  aniWait.Active := true;
  cur_iq.Send();
end;

procedure TfrmFindEnt.lvEntData(Sender: TObject; Item: TListItem);
begin
  item.Caption := EntInfos[item.Index].Company;
  item.SubItems.Add(EntInfos[item.Index].Service);
  item.SubItems.Add(EntInfos[item.Index].Mode);
  item.SubItems.Add(EntInfos[item.Index].Trade);
  item.SubItems.Add(EntInfos[item.Index].Subtrade);
  item.SubItems.Add(EntInfos[item.Index].Tel);
end;

procedure TfrmFindEnt.Button1Click(Sender: TObject);
begin
  if lvEnt.Selected <> nil then
    showentinfo(EntInfos[lvEnt.Selected.Index]);
end;

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

procedure TfrmFindEnt.FormCreate(Sender: TObject);
var
  Parser: TXMLTagParser;
  i: integer;
  lst: TXMLTagList;
begin
  inherited;

  HYFL := nil;
  Parser := TXMLTagParser.Create;
  Parser.ParseFile(ExtractFilePath(Application.ExeName) + 'hyfl.xml');
  if Parser.Count > 0 then
  begin
    HYFL := Parser.popTag;
    lst := HYFL.ChildTags;
    for i := 0 to lst.Count - 1 do
      coboTrade.Items.AddObject(lst[i].GetAttribute('name'), lst[i]);
    lst.Free;
  end;
  Parser.Free;

  tabSearch.TabVisible := false;
  tabResult.TabVisible := false;
  tabUsers.TabVisible := false;
  PageControl1.ActivePage := tabSearch;

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

procedure TfrmFindEnt.lvEntDblClick(Sender: TObject);
begin
  if lvEnt.Selected <> nil then
    showentinfo(EntInfos[lvEnt.Selected.Index]);
end;

procedure TfrmFindEnt.Button2Click(Sender: TObject);
begin
  if lvEnt.Selected <> nil then
    showentUsers(EntInfos[lvEnt.Selected.Index].Domain);
end;

procedure TfrmFindEnt.coboTradeChange(Sender: TObject);
var
  lst: TXMLTagList;
  i: integer;
begin
  coboSubtrade.Items.Clear;
  coboSubtrade.Items.Add('请选择合适您的行业小类');
  if (coboTrade.ItemIndex > 0) and (coboTrade.Items.Objects[coboTrade.ItemIndex] <> nil) then
  begin
    lst := TXMLTag(coboTrade.Items.Objects[coboTrade.ItemIndex]).ChildTags;
    for i := 0 to lst.Count - 1 do
      coboSubtrade.Items.Add(lst[i].GetAttribute('name'));
  end;
  coboSubtrade.ItemIndex := 0;
  with TTntComboBox(sender) do
    if Enabled then
      if ItemIndex < 0 then
        ItemIndex := 0;
end;

procedure TfrmFindEnt.coboChange(Sender: TObject);
begin
  with TTntComboBox(sender) do
    if Enabled then
      if ItemIndex < 0 then
        ItemIndex := 0;
end;

procedure TfrmFindEnt.SendSerach(domain: widestring);
begin
  cur_iq := TJabberIQ.Create(MainSession, MainSession.generateID(), UserItemsCallback, 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 TfrmFindEnt.UserItemsCallback(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, ico_info);
        //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';
      lvUsers.Clear();
      ShowRiserWindow(nil, sJUDEmpty, ico_info);
            //MessageBox(Handle,Pchar(sJUDEmpty), '信息', MB_OK OR MB_ICONINFORMATION);
      exit;
    end;

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

    lvUsers.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 lvUsers.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 := lvUsers.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 lvUsers.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 := lvUsers.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;

    lvUsers.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 TfrmFindEnt.lvEntChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  btnNext.Enabled := lvEnt.Selected <> nil;
end;

procedure TfrmFindEnt.lvUsersContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
var
  multi: boolean;
begin
  inherited;
  multi := (lvUsers.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 TfrmFindEnt.lvUsersData(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 TfrmFindEnt.lvUsersDataFind(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;

procedure TfrmFindEnt.lvUsersDblClick(Sender: TObject);
begin
  inherited;
  if lvUsers.Selected <> nil then
    ShowProfile(lvUsers.Selected.Caption);
end;

procedure TfrmFindEnt.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 (lvUsers.SelCount = 1) then
        // only a single user
    doAdd(lvUsers.Selected)
  else begin
    for i := 0 to lvUsers.Items.Count - 1 do begin
      if lvUsers.Items[i].Selected then
        doAdd(lvUsers.Items[i]);
    end;
  end;
end;

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

end.
