unit cfgtransport;

interface

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

type
  TfrmCfgTransports = class(TfrmDockable)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Label2: TLabel;
    GroupBox3: TGroupBox;
    btnReg: TButton;
    btnCancel: TButton;
    ImageList1: TImageList;
    PaintBox1: TPaintBox;
    nbCFG: TNotebook;
    Label3: TLabel;
    lbNewAccount: TLabel;
    lbedtPassword: TLabeledEdit;
    lbedtUserName: TLabeledEdit;
    lbMsg: TLabel;
    procedure btnRegClick(Sender: TObject);
    procedure lbNewAccountClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private declarations }
  public
    jid: widestring;
    cur_key: widestring;
    pres_cb: integer;
    transportType: string;
    { Public declarations }
    procedure getReginfo;
    procedure doRemove;
    procedure doRegister;

    procedure getReginfoCallback(event: string; tag: TXMLTag);
    procedure RegisterCallback(event: string; tag: TXMLTag);
    procedure RemoveCallback(event: string; tag: TXMLTag);
    procedure PresCallback(event: string; tag: TXMLTag; pres: TJabberPres);
  end;

var
  frmCfgTransports: TfrmCfgTransports;

procedure TransportsCfg(TransportName: string);

implementation

uses Session, iq, JabberConst, Agents, RegForm, Roster, s10n, RiserWindow, shellapi,
  Jabber1;

{$R *.dfm}

procedure TransportsCfg(TransportName: string);
var
  tmps: widestring;
begin
  if MainSession = nil then exit;
  if not MainSession.Active then exit;
  with TfrmCfgTransports.Create(Application) do
  begin
    transportType := LowerCase(TransportName);
    ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(UpperCase(transportType));
    if transportType = 'oicq' then
      lbedtUserName.EditLabel.Caption := 'OICQ 号码(&Q):　 ';
    if transportType = 'msn' then
      lbedtUserName.EditLabel.Caption := 'MSN 帐户(&U): 　 ';
    if transportType = 'icq' then
      lbedtUserName.EditLabel.Caption := 'ICQ 号码(&U): 　 ';
    if transportType = 'aim' then
      lbedtUserName.EditLabel.Caption := 'AIM 号码(&S): 　 ';
    if transportType = 'yahoo' then
      lbedtUserName.EditLabel.Caption := 'Yahoo! 帐号(&I): ';

    case ComboBox1.ItemIndex of
      0: tmps := 'OICQ(QQ)';
      1: tmps := 'ICQ';
      2: tmps := 'MSN Messenger';
      3: tmps := 'AOL Instant Messenger';
      4: tmps := 'Yahoo! Messenger';
    end;
    Caption := tmps + '帐户设置';
    label3.Caption := '如果您还没有一个' + tmps + '帐户，您可以:';
    GroupBox3.Caption := tmps;
    jid := transportType + '.' + MainSession.Server;
    try
      getReginfo;
      showmodal;
    finally
      free;
    end;
  end;
end;

procedure TfrmCfgTransports.btnRegClick(Sender: TObject);
begin
  doRegister;
end;

procedure TfrmCfgTransports.lbNewAccountClick(Sender: TObject);
begin
  if transportType = 'oicq' then
    ShellExecute(0, 'open', 'http://qqx.tencent.com/', nil, nil, SW_SHOWNORMAL);
  if transportType = 'icq' then
    ShellExecute(0, 'open', 'http://go.icq.com/register/', nil, nil, SW_SHOWNORMAL);
  if transportType = 'msn' then
    ShellExecute(0, 'open', 'https://register.passport.net/', nil, nil, SW_SHOWNORMAL);
  if transportType = 'aim' then
    ShellExecute(0, 'open', 'http://my.screenname.aol.com/_cqr/login/login.psp?siteId=aimregistrationPROD&authLev=1&mcState=initialized&createSn=1', nil, nil, SW_SHOWNORMAL);
  if transportType = 'yahoo' then
    ShellExecute(0, 'open', 'http://edit.yahoo.com/config/eval_register?.src=pg&.done=http://messenger.yahoo.com', nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmCfgTransports.btnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmCfgTransports.doRegister;
var
  iq: TJabberIQ;
  i: integer;
  fx, xdata, t: TXMLTag;
begin
  btnReg.Enabled := false;
  btnCancel.Enabled := false;
  lbMsg.Caption := '正在向服务器提交注册信息，请耐心等待……';
  nbCFG.PageIndex := 0;

  pres_cb := MainSession.RegisterCallback(PresCallback);
  iq := TJabberIQ.Create(MainSession, MainSession.generateID(), RegisterCallback);
  iq.iqType := 'set';
  iq.toJID := self.jid;
  iq.Namespace := XMLNS_REGISTER;

  iq.qTag.AddBasicTag('username', lbedtUserName.Text);
  iq.qTag.AddBasicTag('password', lbedtPassword.Text);

  if (cur_key <> '') then
    iq.qTag.AddBasicTag('key', cur_key);

  t := TXMLTag.Create('transport');
  t.setAttribute('jid', iq.toJid);
  t.setAttribute('name', '');
  MainSession.FireEvent('/session/transport', t);
  t.Free;

  iq.Send();
end;

procedure TfrmCfgTransports.doRemove;
var
  iq: TJabberIQ;
begin
  iq := TJabberIQ.Create(MainSession, MainSession.generateID(), RemoveCallback);
  with iq do begin
    toJid := jid;
    iqType := 'set';
    Namespace := XMLNS_REGISTER;
    iq.qTag.AddTag('remove');
    Send();
  end;
end;

procedure TfrmCfgTransports.RegisterCallback(event: string; tag: TXMLTag);
begin
  if (event = 'xml') then
  begin
    if (tag.GetAttribute('type') = 'error') then
    begin
      btnCancel.Enabled := True;
      btnCancel.Caption := '关闭';
      lbMsg.Caption := '注册失败，请关闭';
      nbCFG.PageIndex := 0;
    end else
    begin
      btnCancel.Enabled := True;
      btnCancel.Caption := '关闭';
      lbMsg.Caption := '已成功完成注册，请关闭';
      nbCFG.PageIndex := 0;
    end;
  end else
  begin
    btnCancel.Enabled := True;
    btnCancel.Caption := '关闭';
    lbMsg.Caption := '无法完成注册，请关闭';
    nbCFG.PageIndex := 0;
    //Close;
  end;
end;

procedure TfrmCfgTransports.RemoveCallback(event: string; tag: TXMLTag);
begin

end;

procedure TfrmCfgTransports.getReginfo;
var
  iq: TJabberIQ;
begin
  btnReg.Enabled := False;
  nbCFG.PageIndex := 0;

  iq := TJabberIQ.Create(MainSession, MainSession.generateID(), getReginfoCallback);
  with iq do begin
    toJid := jid;
    iqType := 'get';
    Namespace := XMLNS_REGISTER;
    Send();
  end;
end;

procedure TfrmCfgTransports.getReginfoCallback(event: string;
  tag: TXMLTag);
var
  i: integer;
  x, f, ag_tag: TXMLTag;
  flds: TXMLTagList;
  c: TControl;
  ftype: WideString;
begin
  if self=nil then
    exit;
  if csDestroying in ComponentState then
    exit;

    // we got back a response to the iq-get, on the register namespace
  if (event = 'xml') then begin
    if (tag.GetAttribute('type') = 'error') then begin
            // error packet
      ShowRiserWindow(nil, sServiceRegError, ico_info);
//            MessageBox(Application.Handle,Pchar(sServiceRegError), '错误', MB_OK OR MB_ICONERROR);
//            Self.Close();
      btnReg.Enabled := False;
      nbCFG.PageIndex := 0;
      lbMsg.Caption := sServiceRegError;
      btnCancel.Caption := '关闭';
      exit;
    end
    else begin
            // normal result
      btnReg.Enabled := True;
      nbCFG.PageIndex := 1;

      ag_tag := tag.QueryXPTag('/iq/query');

            // always check for registered
      if (ag_tag.GetFirstTag('registered') <> nil) then
        btnReg.Enabled := true;

            // check for x-data form
      x := tag.QueryXPTag('/iq/query/x[@xmlns="' + XMLNS_XDATA + '"]');
      if (x <> nil) then begin
        flds := x.QueryTags('field');
        for i := flds.count - 1 downto 0 do begin
          f := flds[i];
          if (f.GetAttribute('var') = 'key') then
            cur_key := f.GetBasicText('value')
          else if (f.GetAttribute('var') = 'registered') then
                        // ignore registered elements
            btnReg.Enabled := true
          else if (f.GetAttribute('var') = 'username') then
            lbedtUserName.Text := f.GetBasicText('value');
        end;
        flds.Free();
      end

      else begin
                // Normal non-xdata reg form
        flds := ag_tag.ChildTags();
        for i := 0 to flds.count - 1 do begin
          f := flds[i];
          if (f.Name = 'key') then
            cur_key := f.Data
          else if ((f.Name = 'x') and (f.GetAttribute('xmlns') = XMLNS_XDATA)) then
                        // ignore x-data fields here
          else if (f.Name = 'registered') then
                        // ignore registered elements
            btnReg.Enabled := true
          else if (f.Name = 'username') then
            lbedtUserName.Text := f.Data;
        end;
        flds.Free();
      end;
    end;
  end
  else begin
        // timeout on agent query
    ShowRiserWindow(nil, sServiceRegTimeout, ico_info);
        //MessageBox(Application.Handle,Pchar(sServiceRegTimeout), '错误', MB_OK OR MB_ICONERROR);
//        Self.Close();
    btnReg.Enabled := False;
    nbCFG.PageIndex := 0;
    lbMsg.Caption := sServiceRegTimeout;
    btnCancel.Caption := '关闭';
    exit;
  end;
end;

procedure TfrmCfgTransports.FormCreate(Sender: TObject);
begin
  inherited;
  cur_key := '';
  pres_cb := -1;
end;

procedure TfrmCfgTransports.PresCallback(event: string; tag: TXMLTag;
  pres: TJabberPres);
var
  i: integer;
  ritem: TJabberRosterItem;
begin
    // getting some pres packet
  if LowerCase(pres.fromJID.jid) = LowerCase(self.jid) then begin
    MainSession.UnRegisterCallback(pres_cb);
    pres_cb := -1;
    if (pres.PresType = 'error') then begin
            // some kind of error
    end

    else if (pres.PresType = 'unavailable') then begin
            // bad registration
    end

    else begin
            // ok registration, check all pendings and re-subscribe to them
      if WideCompareText(pres.fromJID.jid, jid)<>0 then
        exit;

      if pres.isSubscription then
      begin
        MainSession.roster.AddItem(pres.fromJID.full, pres.fromJid.domain,
            MainSession.Prefs.getString('roster_transport_grp'), false);
      end else
      begin
        with MainSession do begin
          for i := 0 to roster.Count - 1 do begin
            ritem := TJabberRosterItem(Roster.Objects[i]);
            if ((ritem.ask = 'subscribe') and
              (ritem.jid.domain = self.jid)) then begin
              SendSubscribe(ritem.jid.jid, MainSession);
            end;
          end;
        end;
      end;

{
      MainSession.roster.AddItem(pres.fromJID.full, '',
        MainSession.Prefs.getString('roster_transport_grp'), false);

      with MainSession do begin
        for i := 0 to roster.Count - 1 do begin
          ritem := TJabberRosterItem(Roster.Objects[i]);
          if ((ritem.ask = 'subscribe') and
            (ritem.jid.domain = self.jid)) then begin
            SendSubscribe(ritem.jid.jid, MainSession);
          end;
        end;
      end;
{}
    end;
  end;
end;

procedure TfrmCfgTransports.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  if ((pres_cb <> -1) and (MainSession <> nil)) then
    MainSession.UnRegisterCallback(pres_cb);
  Action := caFree;
end;

procedure TfrmCfgTransports.PaintBox1Paint(Sender: TObject);
begin
  ImageList1.Draw(PaintBox1.Canvas, 0, 0, ComboBox1.ItemIndex);
end;

end.
