unit GetHistory;

interface

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

type
  TfrmGetHistory = class(TfrmDockable)
    Panel1: TPanel;
    btnCancel: TButton;
    btnOk: TButton;
    PageControl1: TPageControl;
    tabContact: TTabSheet;
    Panel3: TPanel;
    lbContact: TLabel;
    lvRoster: TListView;
    tabRoom: TTabSheet;
    Panel2: TPanel;
    lbOther: TLabel;
    lvRoom: TListView;
    procedure FormShow(Sender: TObject);
    procedure tabContactShow(Sender: TObject);
    procedure tabRoomShow(Sender: TObject);
    procedure lvRosterChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure lvRosterDblClick(Sender: TObject);
    procedure lvRoomChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure lvRoomDblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    ResultSID: widestring;

    procedure initRost(list: TStringlist);
    procedure initRoom(list: TStringlist);
  end;

var
  frmGetHistory: TfrmGetHistory;

function GetHistorySID(const sCaption, sContact, sOther: string; var SID: widestring): Boolean;

implementation

uses Jabber1, Session, Roster, presence, XMLUtils;

{$R *.dfm}

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

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

function ReadFileNames(const ParentDirectory: string;
  FileList: TStringList): Integer;
var
  Status: Integer;
  SearchRec: TSearchRec;
begin
  Result := 0;
  Status := FindFirst(SlashSep(ParentDirectory, '*.XML'), faAnyFile, SearchRec);
  try
    while Status = 0 do
    begin
      if (SearchRec.Attr and faDirectory <> faDirectory) then
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          FileList.Add(StringReplace(SearchRec.Name, '.XML', '', []));
          Inc(Result);
        end;
      end;
      Status := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
  end;
end;

procedure TfrmGetHistory.FormShow(Sender: TObject);
var
  fn: string;
  Rosts: tstringlist;
  Rooms: tstringlist;
  i: integer;
begin
  fn := MainSession.Prefs.getString('log_path');
  if (Copy(fn, length(fn), 1) <> '\') then
    fn := fn + '\';
  fn := fn + MainSession.BareJid + '\';
  Rosts := tstringlist.create;
  Rosts.Sorted := true;
  Rooms := tstringlist.create;
  ReadFileNames(fn, Rosts);
  for i := Rosts.Count - 1 downto 0 do
  begin
    if Pos('_conference', Rosts[i]) > 0 then
    begin
      Rooms.Insert(0, Rosts[i]);
      Rosts.Delete(i);
    end;
  end;
  initrost(Rosts);
  initroom(Rooms);
  Rosts.Free;
  Rooms.Free;
  inherited;
end;

procedure TfrmGetHistory.initRoom(list: TStringlist);
var
  i: integer;
begin
  for i := 0 to List.Count - 1 do
  begin
    with lvRoom.Items.Add do
    begin
      Caption := copy(List[i], 1, pos('_conference', List[i]) - 1);
      SubItems.Add(StringReplace(List[i], '_conference', '@conference', []));
      ImageIndex := 21;
    end;
  end;
end;

procedure TfrmGetHistory.initRost(list: TStringlist);
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]);
      if not list.Find(MungeName(ri.jid.jid), tmpIndex) then
        Continue;
      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 TfrmGetHistory.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 TfrmGetHistory.tabRoomShow(Sender: TObject);
begin
  btnOk.Enabled := lvRoom.Selected <> nil;
  if btnOk.Enabled then
    ResultSID := trim(lvRoom.Selected.SubItems[0])
  else
    ResultSID := '';
end;

procedure TfrmGetHistory.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 TfrmGetHistory.lvRosterDblClick(Sender: TObject);
begin
  inherited;
  if lvRoster.Selected <> nil then
    ModalResult := mrOk;
end;

procedure TfrmGetHistory.lvRoomChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  btnOk.Enabled := lvRoom.Selected <> nil;
  if btnOk.Enabled then
    ResultSID := trim(lvRoom.Selected.SubItems[0]);
end;

procedure TfrmGetHistory.lvRoomDblClick(Sender: TObject);
begin
  inherited;
  if lvRoom.Selected <> nil then
    ModalResult := mrOk;
end;

end.
