unit Jabber1;
{
    Copyright 2001, Peter Millard

    This file is part of Exodus.

    Exodus is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    Exodus is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with Exodus; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

interface

uses
    // AnyQ stuff
  AnyQBase,
  BaseChat, ExResponders, ExEvents, RosterWindow, Presence, XMLTag,
  ShellAPI, Registry, SelContact,

    // Delphi stuff
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, StdCtrls, ComCtrls, Menus, ImgList, ExtCtrls,
  Buttons, OleCtrls, AppEvnts, ToolWin,
  IdHttp, TntComCtrls, DdeMan, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdMessageClient, IdPOP3, ActnList,
  IdThreadMgr, IdThreadMgrDefault, IdTCPServer, WinSkinStore, WinSkinData;

const
  DefaultServerName = 'anyq.net';
  ProductName = 'AnyQ';

  sAnyQ = ProductName;
  sJID = ProductName+' ID';
  sEnterJID = '输入 '+sJID;
  sEnterSvcJID = '输入服务的'+sJID+': ';
  sInvalidJID = '您所输入的'+sJID+'是不正确的.';
  sPasswordCaption = ProductName+'密码';

  UpdateKey = '001';

  RECONNECT_RETRIES = 3;

  WM_TRAY = WM_USER + 5269;
  WM_PREFS = WM_USER + 5272;
  WM_SHOWLOGIN = WM_USER + 5273;
  WM_CLOSEAPP = WM_USER + 5274;
  WM_RECONNECT = WM_USER + 5300;
  WM_INSTALLER = WM_USER + 5350;
  WM_MUTEX = WM_USER + 5351;
  WM_DISCONNECT = WM_USER + 5352;
  WM_REMOVEPROFILE = WM_USER + 5353;

type
  TGetLastTick = function: dword; stdcall;
  TInitHooks = procedure; stdcall;
  TStopHooks = procedure; stdcall;

type
  TfrmAnyQ = class(TAnyQBaseForm)
    MainMenu1: TMainMenu;
    mmiFile: TMenuItem;
    Connect2: TMenuItem;
    Preferences1: TMenuItem;
    N7: TMenuItem;
    mnuPresence: TMenuItem;
    presOnline: TMenuItem;
    Exit2: TMenuItem;
    mnuContacts: TMenuItem;
    AddPerson1: TMenuItem;
    RemovePerson1: TMenuItem;
    N8: TMenuItem;
    SubscribetoPresence2: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    mnuMessage: TMenuItem;
    mnuChat: TMenuItem;
    N9: TMenuItem;
    mnuConference: TMenuItem;
    ClearMessages1: TMenuItem;
    Properties2: TMenuItem;
    MessageHistory2: TMenuItem;
    presAway: TMenuItem;
    Lunch3: TMenuItem;
    Bank1: TMenuItem;
    presXA: TMenuItem;
    GoneHome1: TMenuItem;
    GonetoWork1: TMenuItem;
    Sleeping1: TMenuItem;
    presDND: TMenuItem;
    presChat: TMenuItem;
    N10: TMenuItem;
    Away2: TMenuItem;
    ExtendedAway1: TMenuItem;
    Busy1: TMenuItem;
    Working1: TMenuItem;
    Mad1: TMenuItem;
    N11: TMenuItem;
    presCustom: TMenuItem;
    N12: TMenuItem;
    ShowXML1: TMenuItem;
    SearchforPerson1: TMenuItem;
    mnuPassword: TMenuItem;
    N14: TMenuItem;
    NewGroup2: TMenuItem;
    Test1: TMenuItem;
    Tools1: TMenuItem;
    mnuBrowser: TMenuItem;
    mnuServer: TMenuItem;
    mnuVersion: TMenuItem;
    mnuTime: TMenuItem;
    mnuServerVCard: TMenuItem;
    mnuVCard: TMenuItem;
    N13: TMenuItem;
    mnuMyVCard: TMenuItem;
    mnuBookmark: TMenuItem;
    ImgLst24b: TImageList;
    mnuExpanded: TMenuItem;
    N2: TMenuItem;
    timFlasher: TTimer;
    mnuOnline: TMenuItem;
    mnuToolbar: TMenuItem;
    mnuStatBar: TMenuItem;
    timAutoAway: TTimer;
    Meeting1: TMenuItem;
    popTabs: TPopupMenu;
    popCloseTab: TMenuItem;
    popFloatTab: TMenuItem;
    popTray: TPopupMenu;
    trayShow: TMenuItem;
    N4: TMenuItem;
    trayConnect: TMenuItem;
    N01: TMenuItem;
    trayExit: TMenuItem;
    trayPresence: TMenuItem;
    trayCustom: TMenuItem;
    N5: TMenuItem;
    DoNotDisturb1: TMenuItem;
    Mad2: TMenuItem;
    Working2: TMenuItem;
    Busy2: TMenuItem;
    XtendedAway1: TMenuItem;
    Sleeping2: TMenuItem;
    GonetoWork2: TMenuItem;
    GoneHome2: TMenuItem;
    ExtendedAway2: TMenuItem;
    Away1: TMenuItem;
    Bank2: TMenuItem;
    Meeting2: TMenuItem;
    Lunch1: TMenuItem;
    Away3: TMenuItem;
    N15: TMenuItem;
    FreeforChat1: TMenuItem;
    Online1: TMenuItem;
    Custom2: TMenuItem;
    N16: TMenuItem;
    Custom3: TMenuItem;
    N18: TMenuItem;
    ApplicationEvents1: TApplicationEvents;
    imgYahooEmoticons: TImageList;
    mnuRegisterService: TMenuItem;
    trayMessage: TMenuItem;
    timReconnect: TTimer;
    ShowEventsWindow1: TMenuItem;
    presToggle: TMenuItem;
    timTrayAlert: TTimer;
    mnuPlugins: TMenuItem;
    mnuRegistration: TMenuItem;
    N3: TMenuItem;
    N17: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    popAdd: TPopupMenu;
    popRoom: TPopupMenu;
    popFind: TPopupMenu;
    mnuAddContact: TMenuItem;
    mnuAddGroup: TMenuItem;
    N31: TMenuItem;
    N110: TMenuItem;
    N22: TMenuItem;
    N32: TMenuItem;
    N111: TMenuItem;
    N23: TMenuItem;
    N33: TMenuItem;
    mnuNewAccount: TMenuItem;
    Panel1: TPanel;
    pnlLeft: TPanel;
    SplitterLeft: TSplitter;
    Tabs: TPageControl;
    tbsRoster: TTabSheet;
    SplitterRight: TSplitter;
    pnlRoster: TPanel;
    pnlRight: TPanel;
    Toolbar: TCoolBar;
    ToolBar1: TToolBar;
    btnOnlineRoster: TToolButton;
    btnAddContact: TToolButton;
    btnRoom: TToolButton;
    btnFind: TToolButton;
    btnExpanded: TToolButton;
    btnConnect: TToolButton;
    btnDelContact: TToolButton;
    mnuEntInfo: TMenuItem;
    N21: TMenuItem;
    timBuildShareList: TTimer;
    XMPPAction: TDdeServerConv;
    popSendFile1: TMenuItem;
    popInstantMail1: TMenuItem;
    InvitetoConference1: TMenuItem;
    N24: TMenuItem;
    popSendContacts1: TMenuItem;
    popHistory1: TMenuItem;
    N26: TMenuItem;
    popGetShareList1: TMenuItem;
    N6: TMenuItem;
    ImageList4: TImageList;
    btnMail: TToolButton;
    ImageList5: TImageList;
    N25: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    N29: TMenuItem;
    popMail: TPopupMenu;
    N30: TMenuItem;
    SMAIL1: TMenuItem;
    SMAIL2: TMenuItem;
    N34: TMenuItem;
    N35: TMenuItem;
    ActionList1: TActionList;
    ActLogin: TAction;
    ActLogout: TAction;
    N36: TMenuItem;
    A1: TMenuItem;
    V1: TMenuItem;
    N37: TMenuItem;
    N38: TMenuItem;
    T1: TMenuItem;
    popStatus: TPopupMenu;
    MenuItem1: TMenuItem;
    presAvailable: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    W1: TMenuItem;
    E1: TMenuItem;
    N39: TMenuItem;
    N40: TMenuItem;
    N41: TMenuItem;
    IdTCPServerV: TIdTCPServer;
    IdTCPClientV: TIdTCPClient;
    IdThreadMgrDefaultV: TIdThreadMgrDefault;
    TimerMailcheck: TTimer;
    I1: TMenuItem;
    IdTCPClientW: TIdTCPClient;
    IdTCPServerW: TIdTCPServer;
    IdThreadMgrDefaultW: TIdThreadMgrDefault;
    W2: TMenuItem;
    WizardAv: TMenuItem;
    SkinStore1: TSkinStore;
    SkinData1: TSkinData;
    imgMSNEmoticons: TImageList;
    S1: TMenuItem;
    imglst16: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnOnlineRosterClick(Sender: TObject);
    procedure btnAddContactClick(Sender: TObject);
    procedure mnuConferenceClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Preferences1Click(Sender: TObject);
    procedure btnExpandedClick(Sender: TObject);
    procedure ClearMessages1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnDelPersonClick(Sender: TObject);
    procedure ShowXML1Click(Sender: TObject);
    procedure SplitterRightMoved(Sender: TObject);
    procedure Exit2Click(Sender: TObject);
    procedure timFlasherTimer(Sender: TObject);
    procedure JabberorgWebsite1Click(Sender: TObject);
    procedure JabberCentralWebsite1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure presOnlineClick(Sender: TObject);
    procedure mnuMyVCardClick(Sender: TObject);
    procedure mnuToolbarClick(Sender: TObject);
    procedure NewGroup2Click(Sender: TObject);
    procedure timAutoAwayTimer(Sender: TObject);
    procedure MessageHistory2Click(Sender: TObject);
    procedure Properties2Click(Sender: TObject);
    procedure mnuVCardClick(Sender: TObject);
    procedure SearchforPerson1Click(Sender: TObject);
    procedure TabsMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure popCloseTabClick(Sender: TObject);
    procedure popFloatTabClick(Sender: TObject);
    procedure mnuChatClick(Sender: TObject);
    procedure mnuBookmarkClick(Sender: TObject);
    procedure presCustomClick(Sender: TObject);
    procedure trayShowClick(Sender: TObject);
    procedure trayExitClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure WinJabWebsite1Click(Sender: TObject);
    procedure JabberBugzilla1Click(Sender: TObject);
    procedure mnuVersionClick(Sender: TObject);
    procedure mnuPasswordClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnuRegisterServiceClick(Sender: TObject);
    procedure TabsUnDock(Sender: TObject; Client: TControl;
      NewTarget: TWinControl; var Allow: Boolean);
    procedure TabsDockDrop(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer);
    procedure mnuMessageClick(Sender: TObject);
    procedure Test1Click(Sender: TObject);
    procedure trayMessageClick(Sender: TObject);
    procedure mnuBrowserClick(Sender: TObject);
    procedure timReconnectTimer(Sender: TObject);
    procedure ShowEventsWindow1Click(Sender: TObject);
    procedure presToggleClick(Sender: TObject);
    procedure ApplicationEvents1Activate(Sender: TObject);
    procedure ApplicationEvents1Deactivate(Sender: TObject);
    procedure TabsChange(Sender: TObject);
    procedure TabsDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TabsDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure timTrayAlertTimer(Sender: TObject);
    procedure JabberUserGuide1Click(Sender: TObject);
    procedure mnuPluginDummyClick(Sender: TObject);
    procedure SubmitAnyQFeatureRequest1Click(Sender: TObject);
    procedure ShowBrandURL(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure mnuRegistrationClick(Sender: TObject);
    procedure mnuAddContactClick(Sender: TObject);
    procedure mnuAddGroupClick(Sender: TObject);
    procedure mnuSignOutClick(Sender: TObject);
    procedure mnuNewAccountClick(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure N110Click(Sender: TObject);
    procedure mnuEntInfoClick(Sender: TObject);
    procedure N33Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure timBuildShareListTimer(Sender: TObject);
    procedure XMPPActionExecuteMacro(Sender: TObject; Msg: TStrings);
    procedure popSendFile1Click(Sender: TObject);
    procedure popInstantMail1Click(Sender: TObject);
    procedure InvitetoConference1Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure popGetShareList1Click(Sender: TObject);
    procedure btnRoomClick(Sender: TObject);
    procedure btnFindClick(Sender: TObject);
    procedure N20Click(Sender: TObject);
    procedure N27Click(Sender: TObject);
    procedure mnuPluginsClick(Sender: TObject);
    procedure SMAIL1Click(Sender: TObject);
    procedure N30Click(Sender: TObject);
    procedure SMAIL2Click(Sender: TObject);
    procedure N34Click(Sender: TObject);
    procedure N35Click(Sender: TObject);
    procedure ActLoginUpdate(Sender: TObject);
    procedure ActLogoutUpdate(Sender: TObject);
    procedure ActLoginExecute(Sender: TObject);
    procedure ActLogoutExecute(Sender: TObject);
    procedure W1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure V1Click(Sender: TObject);
    procedure E1Click(Sender: TObject);
    procedure btnMailClick(Sender: TObject);
    procedure btnFindContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure btnAddContactContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure btnRoomContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure btnMailContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure N39Click(Sender: TObject);
    procedure N40Click(Sender: TObject);
    procedure N41Click(Sender: TObject);
    procedure TimerMailcheckTimer(Sender: TObject);
    procedure I1Click(Sender: TObject);
    procedure W2Click(Sender: TObject);
    procedure WizardAvClick(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure T1Click(Sender: TObject);
    procedure N19Click(Sender: TObject);

  private
    { Private declarations }
    _noMoveCheck: boolean;      // don't check form moves
    _tray_notify: boolean;      // boolean for flashing tray icon
    _edge_snap: integer;        // edge snap fuzziness
    _auto_away: boolean;        // are we auto away
    _auto_away_interval: integer;
    _last_tick: dword;          // last tick when something happened

    // Various state flags
    _windows_ver: integer;
    _is_broadcast: boolean;
    _is_autoaway: boolean;
    _is_autoxa: boolean;
    _is_min: boolean;
    _last_show: Widestring;     // last show for restoring after auto-away
    _last_status: Widestring;   // last status    (ditto)
    _last_priority: integer;    // last priority  (ditto)
    _hidden: boolean;           // are we minimized to the tray
    _logoff: boolean;           // are we logging off on purpose
    _shutdown: boolean;         // are we being shutdown
    _close_min: boolean;        // should the close btn minimize, not close
    _appclosing: boolean;       // is the entire app closing
    _new_tabindex: integer;     // new tab which was just docked
    _new_account: boolean;      // is this a new account

    // Stuff for the Autoaway DLL
    _idle_hooks: THandle;       // handle the lib
    _GetLastTick: TGetLastTick; // function ptrs inside the lib
    _InitHooks: TInitHooks;
    _StopHooks: TStopHooks;
    _valid_aa: boolean;         // do we have a valid auto-away setup?

    // Tray Icon stuff
    _tray: NOTIFYICONDATA;
    _tray_tip: string;
    _tray_icon_idx: integer;
    _tray_icon: TIcon;

    // Some callbacks
    _sessioncb: integer;

    // Reconnect variables
    _reconnect_interval: integer;
    _reconnect_cur: integer;
    _reconnect_tries: integer;

    // Stuff for tracking win32 API events
    _win32_tracker: array of integer;
    _win32_idx: integer;

    procedure presCustomPresClick(Sender: TObject);

    procedure setupTrayIcon();
    procedure setTrayInfo(tip: string);
    procedure SetAutoAway();
    procedure SetAutoXA();
    procedure SetAutoAvailable();
    procedure SetupAutoAwayTimer();

    function win32TrackerIndex(windows_msg: integer): integer;

  protected
    // Hooks for the keyboard and the mouse
    _hook_keyboard: HHOOK;
    _hook_mouse: HHOOK;

    // Window message handlers
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMSysCommand(var msg: TWmSysCommand); message WM_SYSCOMMAND;
    procedure WMWindowPosChanging(var msg: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    procedure WMTray(var msg: TMessage); message WM_TRAY;
    procedure WMQueryEndSession(var msg: TMessage); message WM_QUERYENDSESSION;
    procedure WMEndSession(var msg: TMessage); message WM_ENDSESSION;
    procedure WMShowLogin(var msg: TMessage); message WM_SHOWLOGIN;
    procedure WMCloseApp(var msg: TMessage); message WM_CLOSEAPP;
    procedure WMReconnect(var msg: TMessage); message WM_RECONNECT;
    procedure WMInstaller(var msg: TMessage); message WM_INSTALLER;
    procedure WMDisconnect(var msg: TMessage); message WM_DISCONNECT;
    procedure WMRemoveProfile(var msg: TMessage); message WM_REMOVEPROFILE;
    function WMAppBar(dwMessage: DWORD; var pData: TAppBarData): UINT; stdcall;

  published
    // Callbacks
    procedure ProcessNoAccount; //帐户不存在时的处理
    procedure SessionCallback(event: string; tag: TXMLTag);
    procedure SessionCallbackReg(event: string; tag: TXMLTag);
    procedure ChangePasswordCallback(event: string; tag: TXMLTag);
    procedure DoUpdateJud;
    procedure DoRegJud;

    // This is only used for testing..
    procedure BadCallback(event: string; tag: TXMLTag);

    procedure restoreToolbar;
    procedure restoreAlpha;
    procedure restoreMenus(enable: boolean);
    procedure restoreRoster();

    property newAccount: Boolean read _new_account write _new_account;
  public
    ActiveChat: TfrmBaseChat;

    procedure setTrayIcon(iconNum: integer);

    function getLastTick(): dword;
    function getTabForm(tab: TTabSheet): TForm;
    function IsAutoAway(): boolean;
    function IsAutoXA(): boolean;
    function isMinimized(): boolean;

    procedure Startup();
    procedure DoConnect();
    procedure CancelConnect();
    procedure CTCPCallback(event: string; tag: TXMLTag);
    procedure AcceptFiles(var msg: TWMDropFiles); message WM_DROPFILES;
    procedure DefaultHandler(var msg); override;
    procedure TrackWindowsMsg(windows_msg: integer);
    procedure fireWndMessage(handle: HWND; msg: Cardinal;
      wParam: integer; lParam: integer);

    procedure PreModal(frm: TForm);
    procedure PostModal();

    procedure sendsms(jid, txt: string);
  end;

procedure NewMail(addr: widestring = '');

procedure StartTrayAlert();
procedure StopTrayAlert();

function IsReservedGroup(GroupName: widestring): boolean;

function AnyQGMHook(code: integer; wParam: word; lParam: longword): longword; stdcall;
function AnyQCWPHook(code: integer; wParam: word; lParam: longword): longword; stdcall;

var
  frmAnyQ: TfrmAnyQ;
  sAnyQPresence: Cardinal;
  sAnyQMutex: Cardinal;
  sShellRestart: Cardinal;
  sAnyQGMHook: HHOOK;
  sAnyQCWPHook: HHOOK;

resourcestring
  sCommandLine = 'The following command line parameters are available in AnyQ: '#13#10#13#10;
  sCmdDebug = ' -d '#9#9' : Debug mode on'#13#10;
  sCmdMinimized = ' -m '#9#9' : Start minimized'#13#10;
  sCmdInvisible = ' -v '#9#9' : invisible mode'#13#10;
  sCmdHelp = ' -? '#9#9' : Show Help'#13#10;
  sCmdExpanded = ' -x [yes|no] '#9' : Expanded Mode'#13#10;
  sCmdJID = ' -j [jid] '#9#9' : Jid'#13#10;
  sCmdPassword = ' -p [pass] '#9' : Password'#13#10;
  sCmdResource = ' -r [res] '#9' : Resource'#13#10;
  sCmdPriority = ' -i [pri] '#9' : Priority'#13#10;
  sCmdProfile = ' -f [prof] '#9' : Profile name'#13#10;
  sCmdConfig = ' -c [file] '#9' : Config path name'#13#10;
  sUnkArg = 'Invalid command line:%s';

  sXMPP_Profile = '-*- Temp profile: %s -*-';

  sChat = '对话';

  sGrpUnfiled = '其他联系人';
  sGrpOnline = '联机';
  sGrpAway = '暂时离开';
  sGrpXA = '离开';
  sGrpDND = '请勿打扰';
  sGrpOffline = '脱机';

  sRosterPending = ' (等待认证)';
  sRosterAvail = '联机';
  sRosterChat = 'Wants to chat';
  sRosterAway = '暂时离开';
  sRosterXA = '离开';
  sRosterDND = '请勿打扰';
  sRosterOffline = '脱机';

  sDefaultProfile = 'Default Profile';
  sDefaultGroup = '新建组';

  sCommError = '与服务器通讯出错！';
  sDisconnected = '您的连接已经断开.';
  sAuthError = '无法登录'#13#10'您可能输入了错误的用户名或密码, 或者该用户名已经被其他用户所使用。';
  sRegError = '创建用户出错！该用户名可能已经被其他用户所使用。';
  sAuthNoAccount = '该用户帐号不存在. 要创建该帐号吗?';
  sNewAccount = '您新的帐号已经激活. 您要填写您的详细资料吗?';
  sCancelReconnect = '点击这里取消连接';
  sReconnectIn = '重新连接 ';
  sSeconds = '秒.';

  sSetAutoAvailable = 'Setting Auto Available';
  sSetAutoAway = 'Setting AutoAway';
  sSetAutoXA = 'Setting AutoXA';
  sSetupAutoAway = 'Trying to setup the Auto Away timer.';
  sAutoAwayFail = 'AutoAway Setup FAILED!';
  sAutoAwayWin32 = 'Using Win32 API for Autoaway checks!!';
  sAutoAwayFailWin32 = 'ERROR GETTING WIN32 API ADDR FOR GetLastInputInfo!!';

  sMsgPing = 'Ping Time: %s seconds.';
  sMsgMessage = '消息来自 ';
  sMsgInvite = '邀请来自 ';
  sMsgContacts = '联系人名单来自 ';
  sMsgRosterItems = '这个信息包含 %d 个联系人.';

  sNewGroup = '新组';
  sNewGroupPrompt = '输入新的组名: ';
  sNewGroupExists = '这个组已经存在!';

  sLookupProfile = 'Lookup Profile';
  sSendMessage = '发送消息';
  sStartChat = '开始对话';
  sRegService = 'Register with Service';

  sPasswordError = '修改密码出错.';
  sPasswordChanged = '修改密码成功.';
  sPasswordOldError = '旧密码错误.';
  sPasswordNewError = '新密码不匹配.';
  sPasswordPrompt = '输入密码';

  sAlreadySubscribed = '您已经认证了该用户';
  sBrandingError = 'Branding error!';

  sSoundChatactivity = '对话活动';
  sSoundInvite = '会议邀请';
  sSoundKeyword = '会议关键词';
  sSoundNewchat = '新对话';
  sSoundNormalmsg = '新即时消息';
  sSoundOffline = '联系人联机';
  sSoundOnline = '联系人脱机';
  sSoundRoomactivity = '会议活动';
  sSoundS10n = '请求同意';
  sSoundOOB = '文件传送';
  sSoundAutoResponse = '自动回应';
{---------------------------------------}
{---------------------------------------}
{---------------------------------------}
const
  MaxIcons = 64; // How many icons are in icons.res ??

  ico_Unassigned = -1;
  ico_Offline = 0;
  ico_None = 1;
  ico_Online = 1;
  ico_Chat = 4;
  ico_Away = 2;
  ico_XA = 6;
  ico_DND = 3;
  ico_Folder = 19;
  ico_ResFolder = 17;
  ico_Unknown = 5;
  ico_msg = 7;
  ico_info = 22;
  ico_userbook = 23;

  ico_key = 26;
//  ico_application = 19;
  ico_user = 29;
  ico_conf = 30;
  ico_service = 31;
  ico_headline = 32;
  ico_Unread = 32;
  ico_keyword = 33;
  ico_render = 34;
  ico_down = 36;
  ico_right = 37;
  ico_blocked = 14;
  ico_blockoffline = 15;
  ico_error = 42;

{$IFDEF TRACE_EXCEPTIONS}
procedure ExceptionTracker(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean);
{$ENDIF}


{---------------------------------------}
{---------------------------------------}
{---------------------------------------}
implementation
uses
{$IFDEF TRACE_EXCEPTIONS}
  IdException,
  JclHookExcept, JclDebug, ExceptTracer,
{$ENDIF}

  About, AutoUpdate, AutoUpdateStatus, Bookmark, Browser, Chat,
  ChatController, ChatWin, Debug, Dockable, ExSession, ExUtils,
  GetOpt, InputPassword, Invite, GnuGetText,
  Iq, JUD, JabberID, JabberMsg, IdGlobal,
  JabberConst, ComController, CommCtrl, CustomPres,
  JoinRoom, Login, MsgController, MsgDisplay, MsgQueue, MsgRecv, Password,
  PrefController, Profile, RegForm, RemoveContact, RiserWindow, Room,
  Roster, RosterAdd, Session, StandardAuth, Transfer, Unicode, VCard, xData,
  XMLUtils, XMLParser, NewAccount, FindRoom, newRoom, Options,
  FindEnt, XMLVCard, EntInfo, myShare, ShareUnit, InstantMail,
  GetShare, GetContact, MailUnit, fmInmHistory, whiteboard, AVWizard, UDP;

{$R *.DFM}

var
  RegSession: TJabberSession;
  _rs: Integer;
  Creating: Boolean;
  jud_Name: widestring;
  jud_Nick: widestring;
  jud_company: widestring;
  jud_email: widestring;

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

function IsReservedGroup(GroupName: widestring): boolean;
begin
  Result := (GroupName = sGrpUnfiled) or (GroupName = sGrpOnline) or (GroupName = sGrpOffline);
end;

{---------------------------------------}

procedure TfrmAnyQ.CreateParams(var Params: TCreateParams);
begin
    // Make each window appear on the task bar.
  inherited CreateParams(Params);
  with Params do begin
    ExStyle := ExStyle or WS_EX_APPWINDOW;
    WndParent := GetDesktopWindow();
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.WMSysCommand(var msg: TWmSysCommand);
begin
    // Catch some of the important windows msgs
    // so that we can handle minimizing & stuff properly
  case (msg.CmdType and $FFF0) of
    SC_MINIMIZE: begin
        _hidden := true;
        ShowWindow(Handle, SW_HIDE);
        msg.Result := 0;
      end;
    SC_RESTORE: begin
        ShowWindow(Handle, SW_RESTORE);
        msg.Result := 0;
      end;
    SC_CLOSE: begin
        if ((_close_min) and (not _shutdown)) then begin
          _hidden := true;
          ShowWindow(Handle, SW_HIDE);
          msg.Result := 0;
        end
        else
          inherited;
      end;
  else
    inherited;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.WMTray(var msg: TMessage);
var
  cp: TPoint;
begin
    // this gets fired when the user clicks on the tray icon
    // manually handle popping up the tray menu..
    // since the delphi/vcl impl isn't quite right.
  if (Msg.LParam = WM_LBUTTONDBLCLK) then begin
    if (_hidden) then begin
            // restore our app
      _hidden := false;
      ShowWindow(Handle, SW_RESTORE);
      SetForegroundWindow(Self.Handle);
      msg.Result := 0;
    end
    else begin
            // minimize our app
      _hidden := true;
      self.WindowState := wsMinimized;
      ShowWindow(Handle, SW_HIDE);
      PostMessage(Self.handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
    end;
  end
  else if ((Msg.LParam = WM_LBUTTONDOWN) and (not Application.Active) and (not _hidden)) then begin
    SetForegroundWindow(Self.Handle);
  end

  else if (Msg.LParam = WM_RBUTTONDOWN) then begin
    GetCursorPos(cp);
    SetForegroundWindow(Self.Handle);
    Application.ProcessMessages;
    popTray.Popup(cp.x, cp.y);
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.WMQueryEndSession(var msg: TMessage);
begin
    // Allow windows to shutdown
  _shutdown := true;
  msg.Result := 1;
end;

{---------------------------------------}

procedure TfrmAnyQ.WMEndSession(var msg: TMessage);
begin
    // Kill the application
  _shutdown := true;
  msg.Result := 0;
end;

{---------------------------------------}

procedure TfrmAnyQ.WMShowLogin(var msg: TMessage);
begin
    // Show the login window
  _reconnect_tries := 0;
  _new_account := false;
  ShowLogin();
end;

{---------------------------------------}

procedure TfrmAnyQ.WMCloseApp(var msg: TMessage);
begin
    // Close the main form
  Self.Close();
end;

{---------------------------------------}

procedure TfrmAnyQ.WMReconnect(var msg: TMessage);
begin
    // Enable the reconnect timer
  timReconnect.Enabled := true;
end;

{---------------------------------------}

procedure TfrmAnyQ.WMInstaller(var msg: TMessage);
var
  reg: TRegistry;
  cmd: string;
  i: integer;
begin
    // We are getting a Windows Msg from the installer
  if (not _shutdown) then begin
    reg := TRegistry.Create();
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKey('\Software\Jabber\AnyQ\Restart\' + IntToStr(Application.Handle), true);

    for i := 1 to ParamCount do
      cmd := cmd + ' ' + ParamStr(i);
    reg.WriteString('cmdline', cmd);
    GetDir(0, cmd);
    reg.WriteString('cwd', cmd);
    reg.WriteString('show', MainSession.Show);
    reg.WriteString('status', MainSession.Status);
    if (MainSession.Priority = -1) then
      reg.WriteInteger('priority', 0)
    else
      reg.WriteInteger('priority', MainSession.Priority);

    if (MainSession.Profile <> nil) then
      reg.WriteString('profile', MainSession.Profile.Name);

    reg.CloseKey();
    reg.Free();

    _shutdown := true;
    Self.Close;
  end;
end;

{---------------------------------------}
{---------------------------------------}
{$IFDEF TRACE_EXCEPTIONS}

procedure ExceptionTracker(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean);
var
  e: Exception;
begin
    // trace := TStringList.Create();
  e := Exception(ExceptObj);
  if (e is EConvertError) then exit;
  if (e is EIdSocketError) then exit;
end;
{$ENDIF}

{---------------------------------------}
{---------------------------------------}

procedure TfrmAnyQ.FormCreate(Sender: TObject);
var
  win_ver: string;
  menu_list: TWideStringList;
  i: integer;
  mi: TMenuItem;
begin
  Application.Title := ProductName;
  caption := ProductName;
  About1.Caption := '关于'+ProductName+('&A');
  Creating := false;
{$IFDEF TRACE_EXCEPTIONS}
    // Application.OnException := ApplicationException;
  Include(JclStackTrackingOptions, stRawMode);
{$ENDIF}

  ActiveChat := nil;
  _new_tabindex := -1;

    // Do translation magic
  TranslateProperties(Self);

    // setup our tray icon
  _tray_icon := TIcon.Create();

    // if we are testing auto-away, then fire the
    // timer every 1 second, instead of every 10 secs.
  if (ExStartup.testaa) then
    _auto_away_interval := 1
  else
    _auto_away_interval := 10;
  timAutoAway.Interval := _auto_away_interval * 1000;

  with MainSession.Prefs do begin
        // Setup our caption and the help menus.
    self.Caption := GetString('brand_caption');
    RestorePosition(Self);

    menu_list := TWideStringList.Create();
    fillStringlist('brand_help_menu_list', menu_list);
    for i := 0 to menu_list.Count - 1 do begin
      mi := TMenuItem.Create(self);
      mi.Caption := menu_list.Strings[i];
      mi.OnClick := ShowBrandURL;
      Help1.Insert(i, mi);
    end;
    menu_list.Free();

        // If we are supposed to be hidden, make it so.
    if (ExStartup.minimized) then begin
      _hidden := true;
      self.WindowState := wsMinimized;
      ShowWindow(Handle, SW_HIDE);
      PostMessage(Self.handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
    end;

        // Show the debug form, if they've asked for it.
    if (ExStartup.debug) then ShowDebugForm();
  end;

  _windows_ver := WindowsVersion(win_ver);
    // Setup callbacks
  _sessioncb := MainSession.RegisterCallback(SessionCallback, '/session');

    // Setup the Tabs, toolbar, panel, and roster madness
  Tabs.ActivePage := tbsRoster;
  restoreToolbar();
  pnlRight.Visible := MainSession.Prefs.getBool('expanded');
  restoreRoster();

    // some gui related flags
  _appclosing := false;
  _noMoveCheck := true;
  _noMoveCheck := false;
  _tray_notify := false;
  _reconnect_tries := 0;
  _hidden := false;
  _shutdown := false;
  _close_min := MainSession.prefs.getBool('close_min');

    // Setup the IdleUI stuff..
  _is_autoaway := false;
  _is_autoxa := false;
  _is_min := false;
  _is_broadcast := false;

    // Setup various callbacks, timers, etc.
  setupAutoAwayTimer();
  Self.SessionCallback('/session/prefs', nil);
  Self.setupTrayIcon();
  ConfigEmoticons();

  MainSession.setPresence(ExStartup.show, ExStartup.Status, ExStartup.Priority);

  SetLength(_win32_tracker, 20);
  _win32_idx := 0;

{$IFDEF TRACE_EXCEPTIONS}
  Test1.Visible := true;
{$ENDIF}

  sAnyQCWPHook := 0;
  sAnyQGMHook := 0;
end;

{---------------------------------------}

function TfrmAnyQ.WMAppBar(dwMessage: DWORD; var pData: TAppBarData): UINT; stdcall;
begin
    // what the heck fires this?????
  Result := 0;
  MoveWindow(Self.Handle, pData.rc.Left, pData.rc.Top,
    Self.Width, Screen.Height, true);
end;

{---------------------------------------}

procedure TfrmAnyQ.setupTrayIcon();
var
  picon: TIcon;
begin
    // Create the tray icon, etc..
  picon := TIcon.Create();
  ImgLst24b.GetIcon(0, picon);
  with _tray do begin
    Wnd := Self.Handle;
    uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
    uCallbackMessage := WM_TRAY;
    hIcon := picon.Handle;
    strPCopy(szTip, sAnyQ);
    cbSize := SizeOf(_tray);
  end;
  Shell_NotifyIcon(NIM_ADD, @_tray);
  picon.Free();
end;

{---------------------------------------}

procedure TfrmAnyQ.Startup;
begin
    // load up all the plugins..
  InitPlugins();

    // Creat and dock the MsgQueue if we're in expanded mode
  if (MainSession.Prefs.getBool('expanded')) then begin
    getMsgQueue();
    frmMsgQueue.ManualDock(Self.pnlRight, nil, alClient);
    frmMsgQueue.Align := alClient;
    frmMsgQueue.Show;
  end;

    // auto-login if enabled, otherwise, show the login window
    // Note that we use a Windows Msg to do this to show the login
    // window async since it's a modal dialog.
  with MainSession.Prefs do begin
    if (ExStartup.auto_login) then begin
            // snag default profile, etc..
      if (ExStartup.priority <> -1) then
        MainSession.Priority := ExStartup.priority;
      Self.DoConnect();
    end
    else
      PostMessage(Self.Handle, WM_SHOWLOGIN, 0, 0);
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.DoConnect();
var
  pw: WideString;
begin
    // Make sure that the active profile
    // has the password field filled out.
    // If not, pop up the password prompt,
    // otherwise, just call connect.

    // NB: For non-std auth agents, set prompt_password
    // accordingly.
  if ((MainSession.password = '') and
    (MainSession.getAuthAgent().prompt_password)) then begin
    pw := '';
    if ((not InputQueryW(sPasswordCaption, sPasswordPrompt, pw, True)) or
      (pw = '')) then exit;
    MainSession.Password := pw;
  end;
  MainSession.FireEvent('/session/connecting', nil);
  MainSession.Connect();
end;

{---------------------------------------}

procedure TfrmAnyQ.setupAutoAwayTimer();
begin
    // Setup the auto-away timer
    // Note that for W2k and XP, we are just going to
    // use the special API calls for getting inactivity.
    // For other OS's we need to use the wicked nasty DLL
  _valid_aa := false;
  DebugMsg(sSetupAutoAway);
  if ((_windows_ver < cWIN_2000) or (_windows_ver = cWIN_ME)) then begin
        // Use the DLL
    @_GetLastTick := nil;
    @_InitHooks := nil;
    @_StopHooks := nil;

    _idle_hooks := LoadLibrary(Pchar(SlashSep(ExtractFilePath(Application.ExeName), 'IdleHooks.dll')));
    if (_idle_hooks <> 0) then begin
            // start the hooks
      @_GetLastTick := GetProcAddress(_idle_hooks, 'GetLastTick');
      @_InitHooks := GetProcAddress(_idle_hooks, 'InitHooks');
      @_StopHooks := GetProcAddress(_idle_hooks, 'StopHooks');

      DebugMsg('_GetHookPointer = ' + IntToStr(integer(@_GetLastTick)));
      DebugMsg('_InitHooks = ' + IntToStr(integer(@_InitHooks)));
      DebugMsg('_StopHooks = ' + IntToStr(integer(@_StopHooks)));

      _InitHooks();
      _valid_aa := true;
    end
    else
      DebugMsg(sAutoAwayFail);
    _last_tick := GetTickCount();
  end
  else begin
        // Use the GetLastInputInfo API call
        // do nothing here..
    if (_GetLastInputInfo <> nil) then begin
      DebugMsg(sAutoAwayWin32);
      _valid_aa := true;
    end
    else
      DebugMsg(sAutoAwayFailWin32);
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.setTrayInfo(tip: string);
begin
    // setup the tray tool-tip
  _tray_tip := tip;
  StrPCopy(@_tray.szTip, tip);
  Shell_NotifyIcon(NIM_MODIFY, @_tray);
end;

{---------------------------------------}

procedure TfrmAnyQ.setTrayIcon(iconNum: integer);
begin
    // setup the tray icon based on a specific icon index
  _tray_icon_idx := iconNum;
  imglst16.GetIcon(iconNum, _tray_icon);
  if iconNum<=16 then
    if Win32MajorVersion>=5 then
      if (Win32MinorVersion>=1) or (Win32MajorVersion>5) then
        ImgLst24b.GetIcon(iconNum, _tray_icon);
  _tray.hIcon := _tray_icon.Handle;
  Shell_NotifyIcon(NIM_MODIFY, @_tray);
  case iconNum of
    0: btnFind.ImageIndex := 5;
    1: btnFind.ImageIndex := 4;
    2: btnFind.ImageIndex := 6;
    3: btnFind.ImageIndex := 7;
    6: btnFind.ImageIndex := 9;
    16: btnFind.ImageIndex := 8;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.CancelConnect();
begin
  _logoff := true;
  if (MainSession.Active) then
    MainSession.Stream.Disconnect()
  else
    timReconnect.Enabled := false;
    // MainSession.FireCallback('/session/disconnected', nil);
end;

{---------------------------------------}

procedure TfrmAnyQ.SessionCallback(event: string; tag: TXMLTag);
var
  rtries, rint: integer;
  msg: TMessage;
begin
  mnuNewAccount.Visible := UpperCase(MainSession.Username) = 'ADMIN';
  mnuEntInfo.Visible := UpperCase(MainSession.Username) = 'ADMIN';

    // session related events
  if event = '/session/connected' then begin
    timReconnect.Enabled := false;
    UDPController.GetUDPInfo(nil);
    _logoff := false;
    _reconnect_tries := 0;
    btnConnect.Down := true;
    setTrayIcon(1);
  end

  else if event = '/session/autherror' then begin
    _logoff := true;
    ShowRiserWindow(nil, sAuthError, ico_info);
        //MessageBox(Handle,Pchar(sAuthError), '错误', MB_OK OR MB_ICONERROR);
    PostMessage(Self.Handle, WM_DISCONNECT, 0, 0);
    PostMessage(Self.Handle, WM_SHOWLOGIN, 0, 0);
    exit;
  end

  else if event = '/session/regerror' then begin
    _logoff := true;
    ShowRiserWindow(nil, sRegError, ico_info);
        //MessageBox(Handle,Pchar(sRegError), '错误', MB_OK OR MB_ICONERROR);
    PostMessage(Self.Handle, WM_DISCONNECT, 0, 0);
    exit;
  end

  else if event = '/session/noaccount' then begin
{    _logoff := true;
    ShowRiserWindow(nil, sAuthError, ico_info);
        //MessageBox(Handle,Pchar(sAuthError), '错误', MB_OK OR MB_ICONERROR);
    PostMessage(Self.Handle, WM_DISCONNECT, 0, 0);
    PostMessage(Self.Handle, WM_SHOWLOGIN, 0, 0);
    exit; {}
    ProcessNoAccount;
    exit;
  end

  else if event = '/session/authenticated' then with MainSession do begin
        //帐号认证通过
      mnuNewAccount.Visible := UpperCase(MainSession.Username) = 'ADMIN';
      mnuEntInfo.Visible := UpperCase(MainSession.Username) = 'ADMIN';

      TBuildShareListThread.Create;
      timBuildShareList.Enabled := true;

      Self.Caption := MainSession.Prefs.getString('brand_caption') + ' - ' + MainSession.Username + '@' + MainSession.Server;
      setTrayInfo(Self.Caption);

        // Accept files dragged from Explorer
        // Only do this for normal (non-polling) connections
      if (MainSession.Profile.ConnectionType = conn_normal) then
        DragAcceptFiles(Handle, True);

        // Fetch the roster
      Roster.GrpList.AddStrings(MainSession.Profile.Groups);
      Roster.Fetch;

        // Don't broadcast our initial presence
      _is_broadcast := true;
      if (_last_show <> '') then
        MainSession.setPresence(_last_show, _last_status, _last_priority)
      else
        MainSession.setPresence(MainSession.Show, MainSession.Status, MainSession.Priority);
      _is_broadcast := false;

        // Make the roster the active tab
      Tabs.ActivePage := tbsRoster;

        // Activate the menus
      restoreMenus(true);

        // turn on the auto-away timer
      if (_valid_aa) then timAutoAway.Enabled := true;

        // check for new brand.
{      InitUpdateBranding();  {}  //rem by DoubleWood 2004-7-28 现在不需要 

        // check for new version
      InitAutoUpdate();

        // if we have a new account, prompt for reg info
      if (_new_account) then begin
        if UpperCase(MainSession.Username) = 'ADMIN' then
          Regentinfo;
        RegMyProfile;
//            if (MessageBox(Handle,Pchar(sNewAccount), '确认', MB_YESNO or MB_ICONQUESTION) = mrYes) then begin
//                mnuRegistrationClick(Self);
//            end;

        _new_account := false;
      end;

      PlayXMPPActions();

      MainSession.DoUnAutologin;
    end

  else if (event = '/session/disconnected') then begin
        // Make sure windows knows we don't want files
        // dropped on us anymore.
    if (MainSession.Profile.ConnectionType = conn_normal) then
      DragAcceptFiles(Handle, False);

    timAutoAway.Enabled := false;
    timBuildShareList.Enabled := false;

    Self.Caption := sAnyQ;
    setTrayInfo(Self.Caption);
    setTrayIcon(0);

    if frmRosterWindow<>nil then
      with frmRosterWindow do
      begin
        tbOicq.ImageIndex := 5;
        tbicq.ImageIndex := 6;
        tbMsn.ImageIndex := 7;
        tbaim.ImageIndex := 8;
        tbyahoo.ImageIndex := 9;
      end;

    _new_account := false;
    btnConnect.Down := false;
    restoreMenus(false);

    if (_appclosing) then
      PostMessage(Self.Handle, WM_CLOSEAPP, 0, 0)
    else if (not _logoff) then with timReconnect do begin
        _last_show := MainSession.Show;
        _last_status := MainSession.Status;
        _last_priority := MainSession.Priority;

        inc(_reconnect_tries);

        rtries := MainSession.Prefs.getInt('recon_tries');
        if (rtries <= 0) then rtries := 3;
        rint := MainSession.Prefs.getInt('recon_time');

        if (_reconnect_tries < rtries) then begin
          Randomize();
          if (rint <= 0) then
            _reconnect_interval := Trunc(Random(20)) + 2
          else
            _reconnect_interval := rint;

          Interval := 1000;
          DebugMsg('Setting reconnect timer to: ' + IntToStr(_reconnect_interval));

          _reconnect_cur := 0;
          frmRosterWindow.aniWait.Visible := false;
          PostMessage(Self.Handle, WM_RECONNECT, 0, 0);
        end
        else
          DebugMsg('Attempted to reconnect too many times.');
      end
    else begin
      _last_show := '';
      _last_status := '';
    end;
  end
  else if event = '/session/commtimeout' then begin
    timAutoAway.Enabled := false;
    _logoff := true;
  end

  else if event = '/session/commerror' then begin
    timAutoAway.Enabled := false;
  end

  else if event = '/session/stream:error' then begin
        // we got a stream error.
        // _logoff is set to tell the client to NOT to auto-reconnect
        // This prevents the clients from resource-battling
    _logoff := true;
  end

  else if event = '/session/prefs' then begin
        // some private vars we want to cache
    with MainSession.prefs do begin
      if (getBool('snap_on')) then
        _edge_snap := getInt('edge_snap')
      else
        _edge_snap := -1;
      _close_min := getBool('close_min');
      _auto_away := getBool('auto_away');
      use_emoticons := getBool('emoticons');
    end;

        // setup the AnyQ window..
    if (MainSession.Prefs.getBool('window_ontop')) then
      SetWindowPos(Self.Handle, HWND_TOPMOST, 0, 0, 0, 0,
        SWP_NOMOVE + SWP_NOREPOSITION + SWP_NOSIZE)
    else
      SetWindowPos(Self.Handle, HWND_NOTOPMOST, 0, 0, 0, 0,
        SWP_NOMOVE + SWP_NOREPOSITION + SWP_NOSIZE);

    if (MainSession.Prefs.getBool('window_toolbox')) then begin
      if (Self.BorderStyle <> bsSizeToolWin) then begin
                // requires a restart of the application
        Self.BorderStyle := bsSizeToolWin;
      end;
    end
    else begin
      if (Self.BorderStyle <> bsSizeable) then begin
        Self.BorderStyle := bsSizeable;
      end;
    end;

        // Setup the background colors for emoticons
    imgMSNEmoticons.BkColor := TColor(MainSession.Prefs.getInt('color_bg'));
    imgYahooEmoticons.BkColor := TColor(MainSession.Prefs.getInt('color_bg'));

        // reset the tray icon stuff
    Shell_NotifyIcon(NIM_DELETE, @_tray);
    Self.setupTrayIcon();
    setTrayInfo(_tray_tip);
    setTrayIcon(_tray_icon_idx);

        // do gui stuff
    restoreMenus(MainSession.Active);
    restoreToolbar();
    restoreAlpha();
    restoreRoster();

    if not MainSession.Prefs.getBool('expanded') then
      tbsRoster.TabVisible := false;
  end

  else if (event = '/session/presence') then begin
        // Our presence was changed.. reflect that in the tray icon
    if (MainSession.Show = '') then
      SetTrayIcon(1)
    else if (MainSession.Show = 'away') then
      SetTrayIcon(2)
    else if (MainSession.Show = 'dnd') then
      SetTrayIcon(3)
    else if (MainSession.Show = 'chat') then
      SetTrayIcon(4)
    else if (MainSession.Show = 'xa') then
      SetTrayIcon(6);

        // don't send message on autoaway or auto-return
    if (_is_autoaway or _is_autoxa or _is_broadcast) then exit;

        // Send a windows msg so other copies of AnyQ will change their
        // status to match ours.
    if (not MainSession.Prefs.getBool('presence_message_send')) then exit;
    msg.LParamHi := GetPresenceAtom(MainSession.Show);
    msg.LParamLo := GetPresenceAtom(MainSession.Status);
    PostMessage(HWND_BROADCAST, sAnyQPresence, self.Handle, msg.LParam);
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.restoreToolbar;
begin
    // setup the toolbar based on prefs
  with MainSession.Prefs do begin
    mnuExpanded.Checked := getBool('expanded');

    btnOnlineRoster.Down := getBool('roster_only_online');
    mnuOnline.Checked := btnOnlineRoster.Down;

    if getBool('expanded') then begin
      btnExpanded.ImageIndex := 9;
    end
    else begin
      btnExpanded.ImageIndex := 8;
    end;
    Toolbar.Visible := getBool('toolbar');
    mnuToolbar.Checked := Toolbar.Visible;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.restoreAlpha;
var
  alpha: boolean;
begin
    // setup the alpha-transparency for the main window
    // based on the prefs
  with MainSession.Prefs do begin
    alpha := getBool('roster_alpha');
    Self.AlphaBlend := (alpha);
    if alpha then
      Self.AlphaBlendValue := MainSession.Prefs.getInt('roster_alpha_val')
    else
      Self.AlphaBlendValue := 255;
    if (frmMsgQueue <> nil) then begin
      frmMsgQueue.lstEvents.Color := TColor(getInt('roster_bg'));
      frmMsgQueue.txtMsg.Color := TColor(getInt('roster_bg'));
      AssignDefaultFont(frmMsgQueue.txtMsg.Font);
    end;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.restoreMenus(enable: boolean);
var
  plist: TList;
  imidx, i: integer;
  mnu: TMenuItem;
  cp: TJabberCustompres;
begin
    // (dis)enable the menus
  mnuMessage.Enabled := enable;
  mnuChat.Enabled := enable;
  mnuConference.Enabled := enable;
  mnuPassword.Enabled := enable;
  mnuRegisterService.Enabled := enable;

  mnuContacts.Enabled := enable;
  mnuPresence.Enabled := enable;
  trayPresence.Enabled := enable;

  mnuRegistration.Enabled := enable;
  mnuMyVCard.Enabled := enable;
  mnuVCard.Enabled := enable;

  mnuBookmark.Enabled := enable;
  mnuBrowser.Enabled := enable;
  mnuServer.Enabled := enable;

    // (dis)enable the tray menus
  trayPresence.Enabled := enable;
  trayMessage.Enabled := enable;


    // Enable toolbar btns
  btnOnlineRoster.Enabled := enable;
  btnAddContact.Enabled := enable;
  btnRoom.Enabled := enable;
  btnFind.Enabled := enable;
  btnMail.Enabled := enable;

    // Build the custom presence menus.
    // make sure to leave the main "Custom" entry and the divider
  for i := presCustom.Count - 1 downto 2 do
    presCustom.Items[i].Free;
  for i := trayCustom.Count - 1 downto 2 do
    trayCustom.Items[i].Free;

  plist := MainSession.prefs.getAllPresence();
  for i := 0 to plist.count - 1 do begin
    cp := TJabberCustomPres(plist[i]);

    if (cp.show = 'chat') then imidx := ico_Chat
    else if (cp.show = 'away') then imidx := ico_Away
    else if (cp.Show = 'xa') then imidx := ico_XA
    else if (cp.show = 'dnd') then imidx := ico_DND
    else imidx := ico_Online;

    mnu := TMenuItem.Create(presCustom);
    mnu.Caption := cp.title;
    mnu.tag := i;
    mnu.OnClick := presCustomPresClick;
    mnu.ShortCut := TextToShortcut(cp.hotkey);
    mnu.ImageIndex := imidx;
    presCustom.Add(mnu);

    mnu := TMenuItem.Create(trayCustom);
    mnu.Caption := cp.title;
    mnu.tag := i;
    mnu.OnClick := presCustomPresClick;
    mnu.ImageIndex := imidx;

    trayCustom.Add(mnu);
    cp.Free();
  end;

  plist.Clear();
  plist.Free();
end;

{---------------------------------------}

procedure TfrmAnyQ.CTCPCallback(event: string; tag: TXMLTag);
var
  e: TJabberEvent;
begin
    // record some kind of CTCP result
  if ((tag <> nil) and (tag.getAttribute('type') = 'result')) then begin
    if MainSession.IsPaused then
      MainSession.QueueEvent(event, tag, Self.CTCPCallback)
    else begin
      e := CreateJabberEvent(tag);
      e.elapsed_time := SafeInt(tag.GetAttribute('iq_elapsed_time'));
      RenderEvent(e);
    end;
  end
end;

{---------------------------------------}

procedure TfrmAnyQ.btnConnectClick(Sender: TObject);
begin
  if not MainSession.Active then begin
    timReconnect.Enabled := false;
    _reconnect_tries := 0;
    ShowLogin;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
    // If we are not already disconnected, then
    // disconnect. Once we successfully disconnect,
    // we'll close the form properly (xref _appclosing)
  if ((_close_min) and (not _shutdown)) then begin
    _hidden := true;
    ShowWindow(Handle, SW_HIDE);
    CanClose := false;
    exit;
  end;


  if (MainSession <> nil) then begin

    if ((MainSession.Active) and (not _appclosing)) then begin
      _appclosing := true;
      _logoff := true;
      MainSession.Stream.Disconnect();
      CanClose := false;
      exit;
    end;

  end;

    // Unhook the auto-away DLL
  if (_idle_hooks <> 0) then begin
    _StopHooks();
    _idle_hooks := 0;
  end;

    // Unhook the other Win32 hooks.
  if (sAnyQGMHook <> 0) then begin
    UnHookWindowsHookEx(sAnyQGMHook);
    sAnyQGMHook := 0;
  end;
  if (sAnyQCWPHook <> 0) then begin
    UnhookWindowsHookEx(sAnyQCWPHook);
    sAnyQCWPHook := 0;
  end;

    // Close up the msg queue
  if (frmMsgQueue <> nil) then begin
    frmMsgQueue.lstEvents.Items.Clear;
    frmMsgQueue.Close;
  end;

    // If we have a session, close it up
    // and all of the associated windows
  if MainSession <> nil then begin
    CloseDebugForm();
//        frmRosterWindow.ClearNodes();
    if frmRosterWindow<>nil then
      if not (csDestroying in frmRosterWindow.ComponentState) then
        frmRosterWindow.Close;
    CloseAllChats();

        // Unload all of the remaining plugins
    UnloadPlugins();

        // Unregister callbacks, etc.
    MainSession.UnRegisterCallback(_sessioncb);
    MainSession.Prefs.SavePosition(Self);

    TeardownSession();
  end;

  if RegSession <> nil then
  begin
    RegSession.UnRegisterCallback(_sessioncb);
    RegSession.Free;
    RegSession := nil;
  end;


    // Kill the tray icon stuff
  if (_tray_icon <> nil) then
    FreeAndNil(_tray_icon);
end;

{---------------------------------------}

procedure TfrmAnyQ.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    // Kill the application
  timBuildShareList.Enabled := false;
  Shell_NotifyIcon(NIM_DELETE, @_tray);
  Action := caFree;
end;

{---------------------------------------}

procedure TfrmAnyQ.btnOnlineRosterClick(Sender: TObject);
var
  filter: boolean;
begin
    // show only online
  with MainSession.Prefs do begin
    filter := not getBool('roster_only_online');
    setBool('roster_only_online', filter);
    btnOnlineRoster.Down := filter;
    mnuOnline.Checked := filter;
  end;

  if MainSession.Active then begin
    frmRosterWindow.SessionCallback('/session/prefs', nil);
    frmRosterWindow.Redraw;

    if ((MainSession.Prefs.getBool('expanded')) and
      (Tabs.ActivePage <> tbsRoster)) then
      Tabs.ActivePage := tbsRoster;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.btnAddContactClick(Sender: TObject);
var
  cp: TPoint;
begin
  if MainSession.Active then begin
    cp := btnAddContact.ClientToScreen(point(btnAddContact.Width div 2, btnAddContact.Height));
    popAdd.Popup(cp.x, cp.y);
  end;
    // add a contact
//    ShowAddContact();
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuConferenceClick(Sender: TObject);
begin
    // Join a TC Room
  //StartJoinRoom();
  ShowJoinRoom;
end;

{---------------------------------------}

procedure TfrmAnyQ.FormResize(Sender: TObject);
begin
    // When we are resized, save the new position
  if MainSession <> nil then
    MainSession.Prefs.SavePosition(Self);
end;

{---------------------------------------}

procedure TfrmAnyQ.Preferences1Click(Sender: TObject);
begin
    // Show the prefs
//    StartPrefs();
  StartOptions;
end;

{---------------------------------------}

procedure TfrmAnyQ.btnExpandedClick(Sender: TObject);
//var
//    delta, w: longint;
//    newval: boolean;
begin
//    // either expand or compress the whole thing
//    newval := not MainSession.Prefs.getBool('expanded');
//    mnuExpanded.Checked := newval;
//
//    // this is how much we're changing
//    if ((pnlLeft.Visible) and (pnlLeft.Width > 0)) then
//        delta := -SplitterRight.Width
//    else
//        delta := Self.ClientWidth - tbsRoster.Width + SplitterLeft.Width;
//
//    MainSession.Prefs.setBool('expanded', newval);
//    if newval then begin
//        // we are expanded now
//        // the width of the msg queue
//        w := MainSession.Prefs.getInt('event_width');
//        Self.ClientWidth := Self.ClientWidth + w - delta;
//        restoreRoster();
//    end
//    else begin
//        // we are compressed now
//        w := pnlRight.Width;
//        MainSession.Prefs.setInt('event_width', w);
//        restoreRoster();
//        Self.ClientWidth := Self.ClientWidth - w;
//        Self.Show;
//    end;
//
//
//    MainSession.Prefs.RestorePosition(Self);
//    restoreToolbar();
//    restoreRoster();
//
//    Self.Width := Self.Width + 1;
//    Self.Width := Self.Width - 1;
end;

{---------------------------------------}

procedure TfrmAnyQ.restoreRoster();
var
  docked: TfrmDockable;
  expanded, messenger: boolean;
  roster_w, event_w: integer;
  i, active_tab: integer;
  rpanel: TPanel;
  cc: TChatController;
  cw: TfrmChat;
begin
    // figure out the width of the msg queue
  event_w := MainSession.Prefs.getInt(P_EVENT_WIDTH);
  roster_w := Self.ClientWidth - event_w;
  if (event_w < 0) then event_w := Self.ClientWidth div 2;

    // make sure the roster is docked in the appropriate place.
  messenger := MainSession.Prefs.getBool('roster_messenger');
  expanded := MainSession.Prefs.getBool('expanded');
  if (messenger) then begin
    if ((frmRosterWindow <> nil) and (not frmRosterWindow.inMessenger)) then
      frmRosterWindow.DockRoster();

        // setup panels for the roster
    pnlRoster.Visible := true;
    SplitterRight.Visible := (expanded);
    SplitterLeft.Visible := false;
    pnlLeft.Visible := false;
    pnlLeft.Width := 0;
    pnlRoster.Width := roster_w;

    rpanel := pnlRoster;
    if (expanded) then begin
      pnlRoster.Align := alLeft;
      SplitterRight.align := alRight;
      SplitterRight.align := alLeft;
    end
    else begin
      pnlRoster.Align := alClient;
    end;
  end
  else begin
    if ((frmRosterWindow <> nil) and (frmRosterWindow.inMessenger)) then
      frmRosterWindow.DockRoster();

        // setup panels for the roster
    pnlLeft.Visible := true;
    SplitterLeft.Visible := (expanded);
    SplitterRight.Visible := false;
    pnlRoster.Visible := false;
    if ((frmRosterWindow <> nil) and (frmRosterWindow.inMessenger)) then
      frmRosterWindow.DockRoster();
    pnlRoster.Width := 0;
    pnlLeft.Width := roster_w;

    rpanel := pnlLeft;
    if (expanded) then begin
      pnlLeft.Align := alLeft;
      SplitterLeft.align := alRight;
      SplitterLeft.Align := alLeft;
    end
    else begin
      pnlLeft.Align := alClient;
    end;
  end;

    // Show or hide the MsgQueue
    // Tabs.Visible := (expanded);
  Tabs.DockSite := (expanded);
  pnlRight.Visible := (expanded);
  tbsRoster.TabVisible := (expanded);
  if (expanded) then begin
        // Show the msg queue panel, and dock it.
    pnlRight.Visible := true;
    pnlRight.Width := event_w;
    getMsgQueue();
    if (frmMsgQueue <> nil) then begin
      frmMsgQueue.ManualDock(pnlRight, nil, alClient);
      frmMsgQueue.Show;
      frmMsgQueue.Align := alClient;
    end;

        // make sure the debug window is docked
    active_tab := Tabs.ActivePage.PageIndex;
    DockDebugForm();
    Tabs.ActivePage := Tabs.Pages[active_tab];
    if (frmRosterWindow <> nil) then
      frmRosterWindow.Refresh();
  end

  else begin
        // Undock the MsgQueue... if it's empty, close it.
    if (frmMsgQueue <> nil) then begin
      if ((frmMsgQueue.lstEvents.Items.Count > 0) and
        (not MainSession.Prefs.getBool('close_queue'))) then begin
        frmMsgQueue.Align := alNone;
        frmMsgQueue.FloatForm;
      end
      else
        frmMsgQueue.Close;
    end;

        // make sure we undock all of the tabs..
    while (Tabs.DockClientCount > 0) do begin
      docked := TfrmDockable(Tabs.DockClients[0]);
      docked.FloatForm;
    end;

        // make sure all invisible chat windows are undocked
    for i := 0 to MainSession.ChatList.Count - 1 do begin
      cc := TChatController(MainSession.ChatList.Objects[i]);
      cw := TfrmChat(cc.window);
      if ((cw <> nil) and (cw.Visible = false) and (cw.Docked)) then begin
        cw.FloatForm();
      end;
    end;

    Tabs.ActivePage := tbsRoster;
    FloatDebugForm();
    if (frmRosterWindow <> nil) then
      frmRosterWindow.Refresh();
    rpanel.Align := alClient;
    Self.Width := Self.Width + 1;
    Self.Refresh();
    Self.Width := Self.Width - 1;
    Self.Refresh;
  end;
end;


{---------------------------------------}

procedure TfrmAnyQ.ClearMessages1Click(Sender: TObject);
begin
    // Clear events from the list view.
  if (frmMsgQueue <> nil) then with frmMsgQueue do begin
      while (lstEvents.Items.Count > 0) do
        frmMsgQueue.RemoveItem(0);
    end;
end;

{---------------------------------------}

procedure TfrmAnyQ.WMWindowPosChanging(var msg: TWMWindowPosChanging);
var
  r: TRect;
begin
    // Handle snapping this window to the screen edges.
  if _noMoveCheck then exit;
  if _edge_snap = -1 then exit;

  if ((SWP_NOMOVE or SWP_NOSIZE) and msg.WindowPos^.flags) <>
    (SWP_NOMOVE or SWP_NOSIZE) then begin
        {  Window is moved or sized, get usable screen area. }

    SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);

        {
        Check if operation would move part of the window out of this area.
        If so correct position and, if required, size, to keep window fully
        inside the workarea. Note that simply adding the SWM_NOMOVE and
        SWP_NOSIZE flags to the flags field does not work as intended if
        full dragging of windows is disabled. In this case the window would
        snap back to the start position instead of stopping at the edge of the
        workarea, and you could still move the drag rectangle outside that
        area.
        }

    with msg.WindowPos^ do begin
      if abs(x - r.left) < _edge_snap then x := r.left;
      if abs(y - r.top) < _edge_snap then y := r.top;

      if abs((x + cx) - r.right) < _edge_snap then begin
        x := r.right - cx;
        if abs(x - r.left) < _edge_snap then begin
          cx := cx - (r.left - x);
          x := r.Left;
        end; { if }
      end; { if }

      if abs((y + cy) - r.bottom) < _edge_snap then begin
        y := r.bottom - cy;
        if abs(y - r.top) < _edge_snap then begin
          cy := cy - (r.top - y);
          y := r.top;
        end; { if }
      end; { if }
    end; { With }

  end;

  inherited;
end;

{---------------------------------------}

procedure TfrmAnyQ.FormShow(Sender: TObject);
var
  idx: Integer;
  skinfn: string;
begin
  _noMoveCheck := false;
  TMailCheckThread.Create;
  idx := MainSession.Prefs.getInt('skinindex');
  if idx>=0 then
    SkinData1.LoadFromCollection(SkinStore1,idx)
  else
  begin
    skinfn := MainSession.Prefs.getString('skinfile');
    if skinfn<>'' then
      SkinData1.LoadFromFile(skinfn)
    else
      SkinData1.LoadFromCollection(SkinStore1,0)
  end;
  SkinData1.Active := true;
end;

{---------------------------------------}

procedure TfrmAnyQ.btnDelPersonClick(Sender: TObject);
begin
    // delete the current contact
  frmRosterWindow.popRemoveClick(Self);
end;

{---------------------------------------}

procedure TfrmAnyQ.ShowXML1Click(Sender: TObject);
begin
    // show the debug window if it's hidden
  ShowDebugForm();
end;

{---------------------------------------}

procedure TfrmAnyQ.SplitterRightMoved(Sender: TObject);
begin
    // Save the current width
  MainSession.Prefs.setInt('event_width', pnlRight.Width);
end;

{---------------------------------------}

procedure TfrmAnyQ.Exit2Click(Sender: TObject);
begin
    // Close the whole honkin' thing
  _shutdown := true;
  Self.Close;
end;

{---------------------------------------}

procedure TfrmAnyQ.timFlasherTimer(Sender: TObject);
begin
    // Flash the window
  FlashWindow(Application.Handle, true);
end;

{---------------------------------------}

procedure TfrmAnyQ.JabberorgWebsite1Click(Sender: TObject);
begin
    // goto www.jabber.org
  ShellExecute(0, 'open', 'http://www.jabber.org', '', '', SW_SHOW);
end;

{---------------------------------------}

procedure TfrmAnyQ.JabberCentralWebsite1Click(Sender: TObject);
begin
    // goto www.jabberstudio.org
  ShellExecute(0, 'open', 'http://www.jabberstudio.org', '', '', SW_SHOW);
end;

{---------------------------------------}

procedure TfrmAnyQ.SubmitAnyQFeatureRequest1Click(Sender: TObject);
begin
    // goto http://www.jabberstudio.org/projects/AnyQ/features/add.php
  ShellExecute(0, 'open', 'http://www.jabberstudio.org', '', '', SW_SHOW);

end;

{---------------------------------------}

procedure TfrmAnyQ.About1Click(Sender: TObject);
begin
    // Show some about dialog box
  if not Assigned(frmAbout) then
    frmAbout := TfrmAbout.Create(Application);
  frmAbout.Show;
end;

{---------------------------------------}

procedure TfrmAnyQ.presOnlineClick(Sender: TObject);
var
  m: TMenuItem;
  show, status: string;
begin
    // Set some presence..
    // TMenuItem.tag represent the show to use..

  m := TMenuItem(Sender);
  case m.Tag of
    0: Show := '';
    1: Show := 'chat';
    2: Show := 'away';
    3: Show := 'xa';
    4: Show := 'dnd';
  end;

  Status := m.Caption;
  MainSession.setPresence(show, status, MainSession.Priority);
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuMyVCardClick(Sender: TObject);
begin
  ShowMyProfile();
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuToolbarClick(Sender: TObject);
begin
//    // toggle toolbar on/off
//    Toolbar.Visible := not Toolbar.Visible;
//    mnuToolbar.Checked := Toolbar.Visible;
//    MainSession.Prefs.setBool('toolbar', Toolbar.Visible);
end;

{---------------------------------------}

procedure TfrmAnyQ.NewGroup2Click(Sender: TObject);
var
  new_grp: WideString;
  gl: TWideStringList;
  x: TXMLTag;
begin
    // Add a roster grp.
  new_grp := sDefaultGroup;
  if InputQueryW(sNewGroup, sNewGroupPrompt, new_grp) = false then exit;

    // add the new grp.
  gl := MainSession.Roster.GrpList;
  if (gl.IndexOf(new_grp) >= 0) then begin
        // this grp already exists
    ShowRiserWindow(nil, sNewGroupExists, ico_info);
        //MessageBox(Handle,Pchar(sNewGroupExists), '错误', MB_OK OR MB_ICONERROR);
  end
  else begin
        // add the new grp.
    gl.Add(new_grp);
    with frmRosterWindow do begin
      with Lvusers.Items.Add do
      begin
        SubItems.Add(new_grp);
        ImageIndex := ico_right;
        caption := '';
        Data := nil;
      end;
      Lvusers.AlphaSort;
    end;
    x := TXMLTag.Create('group');
    x.setAttribute('name', new_grp);
    MainSession.FireEvent('/roster/newgroup', x);
    x.Free();
  end;
end;

{---------------------------------------}

function TfrmAnyQ.getLastTick(): dword;
var
  last_info: TLastInputInfo;
begin
    // Return the last tick count of activity
  Result := 0;
  if ((_windows_ver < cWIN_2000) or (_windows_ver = cWIN_ME)) then begin
    if ((_idle_hooks <> 0) and (@_GetLastTick <> nil)) then
      Result := _GetLastTick();
  end
  else begin
        // use GetLastInputInfo
    last_info.cbSize := sizeof(last_info);
    if (GetLastInputInfo(last_info)) then
      Result := last_info.dwTime
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.timAutoAwayTimer(Sender: TObject);
var
  mins, away, xa: integer;
  tick: Cardinal;
  cur_idle: longword;
{$IFDEF TEST_AUTOAWAY}
  dmsg: string;
{$ENDIF}
  avail: boolean;
begin
    {
    Auto-away mad-ness......

    Get the current idle time, and based on that, "do the right thing".

    Note that we don't want to set a-away if we're already
    away, XA, or DND.

    getLasTick() uses either the idleHooks.dll or the appropriate
    API call if they are available (w2k and xp) to get the last
    tick count which had activity.
    }

  if (MainSession = nil) then exit;
  if (not MainSession.Active) then exit;
  if MainSession.Invisible then exit;

  with MainSession.Prefs do begin
    if ((_auto_away)) then begin

      _last_tick := getLastTick();
      if (_last_tick = 0) then exit;

      tick := GetTickCount;
      if tick < _last_tick then
        cur_idle := 0
      else
        cur_idle := ((tick - _last_tick));
      cur_idle := cur_idle div 1000;
      if (not ExStartup.testaa) then
        mins := cur_idle div 60
      else
        mins := cur_idle;

{$IFDEF TEST_AUTOAWAY}
      if (not _is_autoaway) and (not _is_autoxa) then begin
        dmsg := 'Idle Check: ' + SafeBoolStr(_is_autoaway) + ', ' +
          SafeBoolStr(_is_autoxa) + ', ' +
          IntToStr(cur_idle) + ' secs'#13#10;
        DebugMsg(dmsg);
      end;
{$ENDIF}

      away := getInt('away_time');
      xa := getInt('xa_time');

      avail := (MainSession.Show <> 'dnd') and (MainSession.Show <> 'xa') and
        (MainSession.Show <> 'away');

      if ((mins = 0) and ((_is_autoaway) or (_is_autoxa))) then SetAutoAvailable()
      else if (_is_autoxa) then exit
      else if ((mins >= xa) and (_is_autoaway)) then SetAutoXA()
      else if ((mins >= away) and (not _is_autoaway) and (avail)) then SetAutoAway();
    end;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.SetAutoAway;
var
  new_pri: integer;
begin
    // set us to away
  DebugMsg(sSetAutoAway);
  Application.ProcessMessages;

  MainSession.Pause();
  if ((MainSession.Show = 'away') or
    (MainSession.Show = 'xa') or
    (MainSession.Show = 'dnd')) then exit;

  _last_show := MainSession.Show;
  _last_status := MainSession.Status;
  _last_priority := MainSession.Priority;

    // must be before SetPresence
  _is_autoaway := true;
  _is_autoxa := false;

  if MainSession.Prefs.getBool('aa_reduce_pri') then
    new_pri := 0
  else
    new_pri := _last_priority;

  MainSession.SetPresence('away', MainSession.prefs.getString('away_status'),
    new_pri);

  timAutoAway.Interval := 1000;
end;

{---------------------------------------}

procedure TfrmAnyQ.SetAutoXA;
begin
    // set us to xa
  DebugMsg(sSetAutoXA);

    // must be before SetPresence
  _is_autoaway := false;
  _is_autoxa := true;

  MainSession.SetPresence('xa', MainSession.prefs.getString('xa_status'),
    MainSession.Priority);
end;

{---------------------------------------}

procedure TfrmAnyQ.SetAutoAvailable;
begin
    // reset our status to available
  DebugMsg(sSetAutoAvailable);
  timAutoAway.Enabled := false;
  timAutoAway.Interval := _auto_away_interval * 1000;
  MainSession.SetPresence(_last_show, _last_status, _last_priority);

    // must be *after* SetPresence
  _is_autoaway := false;
  _is_autoxa := false;

  if (_valid_aa) then
    timAutoAway.Enabled := true;

  MainSession.Play();
end;

{---------------------------------------}

procedure TfrmAnyQ.MessageHistory2Click(Sender: TObject);
begin
    // show a history dialog
  frmRosterWindow.popHistoryClick(Sender);
end;

{---------------------------------------}

procedure TfrmAnyQ.Properties2Click(Sender: TObject);
begin
    // Show a properties dialog
  frmRosterWindow.popPropertiesClick(Sender);
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuVCardClick(Sender: TObject);
//var
//    jid: WideString;
begin
//    // lookup some arbitrary vcard..
//    if InputQueryW(sLookupProfile, sEnterJID, jid) then
//        ShowProfile(jid);
end;

{---------------------------------------}

procedure TfrmAnyQ.SearchforPerson1Click(Sender: TObject);
begin
    // Start a default search
//    StartSearch('users.'+MainSession.Server);
  StartSearchNew(MainSession.MyAgents.getFirstSearch);
end;

{---------------------------------------}

procedure TfrmAnyQ.TabsMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  v, i, tab: integer;
  R: TRect;
  cp: TTabSheet;
begin
    // select a tab automatically if we have a right click.
  if Button = mbRight then begin
        {
        pgm: EEK! this is really gross because the pagecontrol sucks.
        Make sure the tab is visible before fetching it's bounding rect,
        and checking the hit test.

        BUT, the pageindex we need is the "raw" tabindex. Apparently,
        the pagecontrol just makes tabs invisible when something gets
        undocked, or somthing equally insane.
        }
    tab := -1;
    v := 0;
    for i := 0 to Tabs.PageCount - 1 do begin
      if (Tabs.Pages[i].TabVisible) then begin
        SendMessage(Tabs.Handle, TCM_GETITEMRECT, v, lParam(@R));
        if PtInRect(R, Point(x, y)) then begin
          tab := i;
          break;
        end;
        inc(v);
      end;
    end;

    if (tab = -1) then exit;
    cp := Tabs.Pages[tab];
    if (cp <> Tabs.ActivePage) then
      Tabs.ActivePage := cp;
  end;
end;

{---------------------------------------}

function TfrmAnyQ.getTabForm(tab: TTabSheet): TForm;
begin
    // Get an associated form for a specific tabsheet
  Result := nil;
  if (tab.ControlCount = 1) then begin
    if (tab.Controls[0] is TForm) then begin
      Result := TForm(tab.Controls[0]);
      exit;
    end;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.popCloseTabClick(Sender: TObject);
var
  t: TTabSheet;
  f: TForm;
begin
    // Close the window docked to this tab..
  if Tabs.TabIndex = 0 then exit;
  t := Tabs.ActivePage;
  f := getTabForm(t);
  if (f <> nil) then
    f.Close();
end;

{---------------------------------------}

procedure TfrmAnyQ.popFloatTabClick(Sender: TObject);
var
  t: TTabSheet;
  f: TForm;
begin
    // Undock this window
  t := Tabs.ActivePage;
  if (t = tbsRoster) then begin
        // Float the msg queue window
    getMsgQueue().Align := alNone;
    getMsgQueue().FloatForm();
        //FloatMsgQueue();
  end
  else begin
    f := getTabForm(t);
    if ((f <> nil) and (f is TfrmDockable)) then
      TfrmDockable(f).FloatForm();
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuChatClick(Sender: TObject);
var
  n: TListItem;
  ritem: TJabberRosterItem;
  jid: WideString;
begin
    // Start a chat w/ a specific JID
  jid := '';
  if (frmRosterWindow.Lvusers.SelCount > 0) then begin
    n := frmRosterWindow.Lvusers.Selected;
    if (TObject(n.Data) is TJabberRosterItem) then begin
      ritem := TJabberRosterItem(n.Data);
      if ritem <> nil then
        jid := ritem.jid.jid
    end;
  end;
  if GetContactSID('开始对话', '请在下面选择您想与之对话的人的名字，然后单击“确定”。', '请输入您想与之对话的人的'+sJid+'。', jid) then
    StartChat(jid, '', true);
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuBookmarkClick(Sender: TObject);
begin
//     Add a new bookmark to our list..
//    ShowBookmark('');
end;

{---------------------------------------}

procedure TfrmAnyQ.presCustomClick(Sender: TObject);
begin
    // Custom presence
  ShowCustomPresence();
end;

{---------------------------------------}

procedure TfrmAnyQ.presCustomPresClick(Sender: TObject);
var
  i: integer;
  cp: TJabberCustomPres;
begin
    // Our own Custom presence
  i := TMenuItem(Sender).Tag;
  cp := MainSession.prefs.getPresIndex(i);
  if (cp <> nil) then
    MainSession.setPresence(cp.show, cp.status, cp.priority);
end;

{---------------------------------------}

procedure TfrmAnyQ.trayShowClick(Sender: TObject);
begin
    // Show the application from the popup Menu
  _hidden := false;
  ShowWindow(Handle, SW_RESTORE);
end;

{---------------------------------------}

procedure TfrmAnyQ.trayExitClick(Sender: TObject);
begin
    // Close the application
  _shutdown := true;  
  Self.Close;
end;

{---------------------------------------}

procedure TfrmAnyQ.FormActivate(Sender: TObject);
begin
    // FlashWindow(Self.Handle, false);
  if (frmRosterWindow <> nil) then
    if frmRosterWindow.Lvusers <> nil then
      frmRosterWindow.Lvusers.Invalidate();
  StopTrayAlert();
end;

{---------------------------------------}

function TfrmAnyQ.IsAutoAway(): boolean;
begin
  Result := _is_autoaway;
end;

{---------------------------------------}

function TfrmAnyQ.IsAutoXA(): boolean;
begin
  Result := _is_autoxa;
end;

{---------------------------------------}

procedure TfrmAnyQ.WinJabWebsite1Click(Sender: TObject);
begin
    // goto AnyQ.jabberstudio.org
  ShellExecute(0, 'open', 'http://AnyQ.jabberstudio.org', '', '', SW_SHOW);
end;

{---------------------------------------}

procedure TfrmAnyQ.JabberBugzilla1Click(Sender: TObject);
begin
    // submit a bug on JS.org
  ShellExecute(0, 'open', 'http://www.jabberstudio.org/projects/AnyQ/bugs/', '', '', SW_SHOW);
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuVersionClick(Sender: TObject);
begin
//    // get either version of time request from the jabber server
//    if Sender = mnuVersion then
//        jabberSendCTCP(MainSession.Server, XMLNS_VERSION)
//    else if Sender = mnuTime then
//        jabberSendCTCP(MainSession.Server, XMLNS_TIME);
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuPasswordClick(Sender: TObject);
var
  iq: TJabberIQ;
  f: TfrmPassword;
begin
    {
    // change the password.. send the following XML to do this
    // This only works if we're authenticated
    <iq type='set' to='jabberhostname[e.g., jabber.org]'>
      <query xmlns='jabber:iq:register'>
        <username>username</username>
        <password>newpassword</password>
      </query>
    </iq>
    }

  f := TfrmPassword.Create(self);
  if (f.ShowModal() = mrCancel) then
    exit;

  if (f.txtOldPassword.Text <> MainSession.Password) then begin
    ShowRiserWindow(nil, sPasswordOldError, ico_info);
        //MessageBox(Handle,Pchar(sPasswordOldError), '错误', MB_OK OR MB_ICONERROR);
    exit;
  end;
  if (f.txtNewPassword.Text <> f.txtConfirmPassword.Text) then begin
    ShowRiserWindow(nil, sPasswordNewError, ico_info);
        //MessageBox(Handle,Pchar(sPasswordNewError), '错误', MB_OK OR MB_ICONERROR);
    exit;
  end;

  iq := TJabberIQ.Create(MainSession, MainSession.generateID, Self.ChangePasswordCallback, 120);
  with iq do begin
    iqType := 'set';
    toJid := MainSession.Server;
    Namespace := XMLNS_REGISTER;
    qTag.AddBasicTag('username', MainSession.Username);
    qTag.AddBasicTag('password', f.txtNewPassword.Text);
  end;
  f.Free();
  iq.Send();
end;

{---------------------------------------}

procedure TfrmAnyQ.ChangePasswordCallback(event: string; tag: TXMLTag);
begin
  if (event <> 'xml') then
    ShowRiserWindow(nil, sPasswordError, ico_info)
        //MessageBox(Handle,Pchar(sPasswordError), '错误', MB_OK OR MB_ICONERROR)
  else begin
    if (tag.GetAttribute('type') = 'result') then
      ShowRiserWindow(nil, sPasswordChanged, ico_info)
            //MessageBox(Handle,Pchar(sPasswordChanged), '信息', MB_OK OR MB_ICONINFORMATION)
    else
      ShowRiserWindow(nil, sPasswordError, ico_info);
            //MessageBox(Handle,Pchar(sPasswordError), '错误', MB_OK OR MB_ICONERROR);
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.AcceptFiles(var msg: TWMDropFiles);
const
  cnMaxFileNameLen = 255;
var
  i,
    nCount: integer;
  acFileName: array[0..cnMaxFileNameLen] of char;
  p: TPoint;
  Node: TListItem;
  ri: TJabberRosterItem;
  f: TForm;
begin
    // Accept some files being dropped on this form
    // If we are expaned, and not showing the roster tab,
    // and the current tab has a chat window, then
    // call the chat window's AcceptFiles() method.
  if ((MainSession.Prefs.getBool('expanded')) and
    (Tabs.ActivePage <> tbsRoster)) then begin
    f := getTabForm(Tabs.ActivePage);
    if (f is TfrmChat) then begin
      TfrmChat(f).AcceptFiles(msg);
    end;
    exit;
  end;

    // figure out which node was the drop site.
  if (DragQueryPoint(msg.Drop, p) = false) then exit;

    // Translate to screen coordinates, then back to client coordinates
    // for the roster window.  This would have been easier if RosterWindow
    // had worked as the target of DragAcceptFiles.
  p := ClientToScreen(p);
  p := frmRosterWindow.Lvusers.ScreenToClient(p);
  Node := frmRosterWindow.Lvusers.GetItemAt(p.X, p.Y);
  if ((Node = nil) or (Node.Indent = 0)) then exit;

    // get the roster item attached to this node.
  if (Node.Data = nil) then exit;
  if (TObject(Node.Data) is TJabberBookmark) then exit;
  ri := TJabberRosterItem(Node.Data);

    // find out how many files we're accepting
  nCount := DragQueryFile(msg.Drop,
    $FFFFFFFF,
    acFileName,
    cnMaxFileNameLen);

    // query Windows one at a time for the file name
  for i := 0 to nCount - 1 do begin
    DragQueryFile(msg.Drop, i,
      acFileName, cnMaxFileNameLen);
    FileSend(ri.jid.full, acFileName);
  end;

    // let Windows know that we're done
  DragFinish(msg.Drop);
end;

{---------------------------------------}

procedure TfrmAnyQ.FormDestroy(Sender: TObject);
begin
//  FreeVACComponents;
    //
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuRegisterServiceClick(Sender: TObject);
//var
//    tmps: WideString;
//    f: TfrmRegister;
begin
//    // kick off a service registration..
////    tmps := '';
////    if (InputQueryW(sRegService, sEnterSvcJID, tmps) = false) then
////        exit;
//
//    f := TfrmRegister.Create(Application);
//    f.StartFixed;
////    f.jid := tmps;
////    f.Start();
end;

{---------------------------------------}

procedure TfrmAnyQ.TabsUnDock(Sender: TObject; Client: TControl;
  NewTarget: TWinControl; var Allow: Boolean);
begin
    // check to see if the tab is a frmDockable
  Allow := true;
  if (Client is TfrmDockable) then begin
    TfrmDockable(Client).Docked := false;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.TabsDockDrop(Sender: TObject; Source: TDragDockObject; X,
  Y: Integer);
begin
    // We got a new form dropped on us.
  if (Source.Control is TfrmDockable) then begin
    TfrmDockable(Source.Control).Docked := true;
    TfrmDockable(Source.Control).TabSheet := Tabs.Pages[Tabs.PageCount - 1];
    _new_tabindex := Tabs.PageCount;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuMessageClick(Sender: TObject);
var
  jid: WideString;
  n: TListItem;
  ritem: TJabberRosterItem;
begin
    // Message someone
  jid := '';
  if (frmRosterWindow.Lvusers.SelCount > 0) then begin
    n := frmRosterWindow.Lvusers.Selected;
    if (TObject(n.Data) is TJabberRosterItem) then begin
      ritem := TJabberRosterItem(n.Data);
      if ritem <> nil then
        jid := ritem.jid.jid
    end;
  end;

  if InputQueryW(sSendMessage, sEnterJID, jid) then
    StartMsg(jid);
end;

{---------------------------------------}

procedure TfrmAnyQ.Test1Click(Sender: TObject);
{
var
    i: integer;
}
{
var
    i: integer;
    c: TChatController;
}
begin
    // Test something..
    // LoadPlugin('RosterClean.AnyQRosterClean');

    // Cause an AV
    // PInteger(nil)^ := 0;

    // Show a toast window
    {
    i := Random(2);
    if (i = 0) then
        ShowRiserWindow(Self, 'Test Toast ' + IntToStr(i) + ' Some more text to Some more text to Some more text to Some more text to make toast really long.', i)
    else
        ShowRiserWindow(Self, 'Test Toast ' + IntToStr(i) + ' cvs commit from cvsnotify@jabberstudio.org', i);
    }
    //ShowRiserWindow(Self, 'Test Toast ' + IntToStr(i), i);

    //TrackWindowsMsg(WM_ACTIVATEAPP);
    //TrackWindowsMsg(WM_ACTIVATE);
    {
    TrackWindowsMsg(WM_LBUTTONDOWN);
    TrackWindowsMsg(BM_CLICK);
    TrackWindowsMsg(WM_SETTEXT);
    TrackWindowsMsg(WM_COMMAND);
    }

    {
    for i := MainSession.ChatList.Count - 1 downto 0 do begin
        c := TChatController(MainSession.ChatList.Objects[i]);
        if ((c <> nil) and (c.window is TfrmChat)) then
            c.window.Free();
    end;
    }

    //FileReceive('pgmillard@jabber.org', 'http://AnyQ.jabberstudio.org/indy_openssl096g.zip', 'SSL Zip Files');
  MainSession.RegisterCallback(BadCallback, '/packet/message/x[@xmlns="AnyQ:puke"]');
end;

{---------------------------------------}

procedure TfrmAnyQ.trayMessageClick(Sender: TObject);
var
  fsel: TfrmSelContact;
  jid: string;
begin
    // Send a msg via the tray menu popup
  fsel := TfrmSelContact.Create(Application);
  fsel.frameTreeRoster1.DrawRoster(true);
  fsel.frameTreeRoster1.treeRoster.MultiSelect := false;

  if (fsel.ShowModal = mrOK) then begin
    jid := fsel.GetSelectedJID();
    if (jid = '') then exit;

        // do the send
    if (MainSession.Prefs.getBool(P_CHAT)) then
      StartChat(jid, '', true)
    else
      StartMsg(jid);

  end;
  fSel.Free();
end;

{---------------------------------------}

procedure TfrmAnyQ.DefaultHandler(var msg);
var
  m: TMessage;
  status: string;
  show: string;
begin
    // Is this a replacement defualt windows msg handler??
  m := TMessage(msg);
  if (m.Msg = sAnyQPresence) then begin
    if (HWND(m.WParam) = Self.Handle) then exit;
    if (not MainSession.Prefs.getBool('presence_message_listen')) then
      exit;
    show := GetPresenceString(m.LParamHi);
    status := GetPresenceString(m.LParamLo);
        // already there.
    if ((MainSession.Show = show) and (MainSession.Status = status)) then exit;
    _is_broadcast := true;
    MainSession.setPresence(show, status, MainSession.Priority);
    _is_broadcast := false;
  end
  else if (m.Msg = sAnyQMutex) then begin
        // show the form
    Self.Show;
    ShowWindow(Handle, SW_RESTORE);
    SetForegroundWindow(Self.Handle);
  end
  else if (m.Msg = sShellRestart) then begin
        // the shell was restarted...
        // reshow our tray icons
    setupTrayIcon();
    setTrayInfo(_tray_tip);
    setTrayIcon(_tray_icon_idx);
  end
  else
    inherited;
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuBrowserClick(Sender: TObject);
begin
    // Show a jabber browser.
  ShowBrowser();
end;

{---------------------------------------}

procedure TfrmAnyQ.timReconnectTimer(Sender: TObject);
begin
    // try to reconnect...
  inc(_reconnect_cur);
  if (_reconnect_cur >= _reconnect_interval) then begin
    timReconnect.Enabled := false;
    DoConnect();
  end
  else begin
    frmRosterWindow.lblLogin.Caption := sCancelReconnect;
    frmRosterWindow.lblStatus.Caption := sReconnectIn +
      IntToStr(_reconnect_interval - _reconnect_cur) + ' ' + sSeconds;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.ShowEventsWindow1Click(Sender: TObject);
begin
  getMsgQueue.Show();
end;

{---------------------------------------}

procedure TfrmAnyQ.presToggleClick(Sender: TObject);
begin
  if (MainSession.Show = '') then
    MainSession.setPresence('away', sRosterAway, MainSession.Priority)
  else
    MainSession.setPresence('', sRosterAvail, MainSession.Priority)
end;

{---------------------------------------}

procedure TfrmAnyQ.ApplicationEvents1Activate(Sender: TObject);
begin
    // do something here maybe
end;

{---------------------------------------}

procedure TfrmAnyQ.PreModal(frm: TForm);
begin
    // make not on top.
  if MainSession = nil then
    exit;
  if (MainSession.Prefs.getBool('window_ontop')) then begin
    SetWindowPos(frmAnyQ.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE);
    BringWindowToTop(frm.Handle);
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.PostModal();
begin
    // make on top if applicable.
  if MainSession = nil then
    exit;
  if (MainSession.Prefs.getBool('window_ontop')) then
    SetWindowPos(frmAnyQ.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE);
end;

{---------------------------------------}

procedure TfrmAnyQ.ApplicationEvents1Deactivate(Sender: TObject);
begin
    // app was deactivated..
  if (Self.ActiveChat <> nil) then begin
    Self.ActiveChat.HideEmoticons();
    Self.ActiveChat := nil;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.TabsChange(Sender: TObject);
begin
    // Don't show any notification images on the current tab
  if (Tabs.ActivePage.ImageIndex <> -1) then
    Tabs.ActivePage.ImageIndex := -1;
end;

{---------------------------------------}

procedure TfrmAnyQ.TabsDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  form: TForm;
  dest_tab: integer;
begin
    // drag if the source is the roster,
    // and the target is a conf room tab
  Accept := false;
  dest_tab := Tabs.IndexOfTabAt(X, Y);
  if (dest_tab > -1) then begin
    form := getTabForm(Tabs.Pages[dest_tab]);
    Accept := ((Source = frmRosterWindow.Lvusers) and
      ((form is TfrmRoom) or (form is TfrmChat)));
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.TabsDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  dest_tab: integer;
  form: TForm;
  sel_contacts: TList;
begin
    // dropping something on a tab.
  dest_tab := Tabs.IndexOfTabAt(X, Y);
  if (dest_tab > -1) then begin
    form := getTabForm(Tabs.Pages[dest_tab]);
    if (form <> nil) then begin
      if ((form is TfrmRoom) and (Source = frmRosterWindow.Lvusers)) then begin
                // fire up an invite for this room using the selected contacts
        sel_contacts := frmRosterWindow.getSelectedContacts(true);
        if (sel_contacts.count > 0) then
          ShowInvite(TfrmRoom(form).getJid, sel_contacts)
        else
          ShowRiserWindow(nil, sNoContactsSel, ico_info);
                    //MessageBox(Handle,Pchar(sNoContactsSel), '错误', MB_OK OR MB_ICONERROR);
        sel_contacts.Free();
      end

      else if ((form is TfrmChat) and (Source = frmRosterWindow.Lvusers)) then begin
                // send roster items to this contact.
        sel_contacts := frmRosterWindow.getSelectedContacts(false);
        if (sel_contacts.count > 0) then
          jabberSendRosterItems(TfrmChat(form).getJid, sel_contacts)
        else
          ShowRiserWindow(nil, sNoContactsSel, ico_info);
                    //MessageBox(Handle,Pchar(sNoContactsSel), '错误', MB_OK OR MB_ICONERROR);
        sel_contacts.Free();
      end;
    end;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.timTrayAlertTimer(Sender: TObject);
var
  iconNum: integer;
begin
  _tray_notify := not _tray_notify;
  if (_tray_notify) then begin
    iconNum := _tray_icon_idx + 8;
    if (iconNum > 13) then iconNum := 13;
  end
  else
    iconNum := _tray_icon_idx;

  imglst16.GetIcon(iconNum, _tray_icon);
  if iconNum<=16 then
    if Win32MajorVersion>=5 then
      if (Win32MinorVersion>=1) or (Win32MajorVersion>5) then
        ImgLst24b.GetIcon(iconNum, _tray_icon);
  _tray.hIcon := _tray_icon.Handle;
  Shell_NotifyIcon(NIM_MODIFY, @_tray);
end;

{---------------------------------------}

procedure StartTrayAlert();
begin
  frmAnyQ.timTrayAlert.Enabled := true;
end;

{---------------------------------------}

procedure StopTrayAlert();
begin
  if (frmAnyQ.timTrayAlert.Enabled) then begin
    frmAnyQ.timTrayAlert.Enabled := false;
    frmAnyQ._tray_notify := false;
    frmAnyQ.setTrayIcon(frmAnyQ._tray_icon_idx);
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.JabberUserGuide1Click(Sender: TObject);
begin
  ShellExecute(0, 'open', pchar(string(MainSession.Prefs.getString('brand_help_userguide'))), '', '', SW_SHOW);
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuPluginDummyClick(Sender: TObject);
begin
    // call the COM Controller
  ExCOMController.fireMenuClick(Sender);
end;

{---------------------------------------}

function TfrmAnyQ.win32TrackerIndex(windows_msg: integer): integer;
var
  i: integer;
begin
  Result := -1;
  for i := 0 to _win32_idx - 1 do begin
    if (_win32_tracker[i] = windows_msg) then begin
      Result := i;
      break;
    end;
  end;
end;

{---------------------------------------}

procedure TfrmAnyQ.TrackWindowsMsg(windows_msg: integer);
var
  idx: integer;
begin

  if (sAnyQCWPHook = 0) then begin
    sAnyQCWPHook := SetWindowsHookEx(WH_CALLWNDPROC, @AnyQCWPHook,
      0, GetCurrentThreadID);
    sAnyQGMHook := SetWindowsHookEx(WH_GETMESSAGE, @AnyQGMHook,
      0, GetCurrentThreadID);
  end;

  idx := win32TrackerIndex(windows_msg);
  if (idx = -1) then begin
    _win32_tracker[_win32_idx] := windows_msg;
    inc(_win32_idx);
    if (_win32_idx >= Length(_win32_tracker)) then begin
      SetLength(_win32_tracker, _win32_idx + 20);
    end;
  end;

  ApplicationEvents1.Activate();
end;

{---------------------------------------}

procedure TfrmAnyQ.fireWndMessage(handle: HWND; msg: Cardinal;
  wParam: integer; lParam: integer);
var
  etag: TXMLTag;
begin
    // check to see if this Msg is one we are tracking..
    // and fire the appropriate event if it is.
  etag := TXMLTag.Create('event');
  etag.setAttribute('msg', IntToStr(msg));
  etag.setAttribute('hwnd', IntToStr(Handle));
  etag.setAttribute('lparam', IntToStr(lParam));
  etag.setAttribute('wparam', IntToStr(wParam));
  MainSession.FireEvent('/windows/msg', etag);
end;

{---------------------------------------}

procedure TfrmAnyQ.ShowBrandURL(Sender: TObject);
var
  i: integer;
  url_list: TWideStringList;
begin
  i := Help1.IndexOf(TMenuItem(Sender));
  if (i < 0) then exit;

  url_list := TWideStringList.Create();
  MainSession.Prefs.fillStringlist('brand_help_url_list', url_list);

  if (i < url_list.Count) then
    ShellExecute(0, 'open',
      pchar(string(url_list.Strings[i])),
      '', '', SW_SHOW)
  else
    ShowRiserWindow(nil, sBrandingError, ico_info);
        //MessageBox(Handle,Pchar(sBrandingError), '警告', MB_OK OR MB_ICONWARNING);

  url_list.Free();
end;

{---------------------------------------}

function AnyQGMHook(code: integer; wParam: word; lParam: longword): longword; stdcall;
var
  idx: integer;
  msg: TMsg;
begin
    // Something is coming from our WH_GETMESSAGE Hook
  msg := TMsg(Ptr(lParam)^);

  if (frmAnyQ <> nil) then begin
    idx := frmAnyQ.win32TrackerIndex(msg.message);
    if (idx >= 0) then
      frmAnyQ.fireWndMessage(msg.hwnd, msg.message, msg.wParam, msg.lParam);
  end;

  Result := CallNextHookEx(sAnyQGMHook, Code, wParam, lParam);
end;

{---------------------------------------}

function AnyQCWPHook(code: integer; wParam: word; lParam: longword): longword; stdcall;
var
  idx: integer;
  cwp: TCWPStruct;
begin
    // Something is coming from CALLWNDPROC Hook
  if ((Code = HC_ACTION) and (frmAnyQ <> nil)) then begin
    cwp := TCWPStruct(Ptr(lParam)^);
    idx := frmAnyQ.win32TrackerIndex(cwp.message);
    if (idx >= 0) then
      frmAnyQ.fireWndMessage(cwp.hwnd, cwp.message, cwp.wParam, cwp.lParam);
  end;

  Result := CallNextHookEx(sAnyQCWPHook, Code, wParam, lParam);
end;

{---------------------------------------}

procedure TfrmAnyQ.FormPaint(Sender: TObject);
begin
  StopTrayAlert();
end;

{---------------------------------------}

function TfrmAnyQ.isMinimized(): boolean;
begin
  Result := (_hidden) or (Self.Windowstate = wsMinimized);
end;

{---------------------------------------}

procedure TfrmAnyQ.mnuRegistrationClick(Sender: TObject);
//var
//    f: TfrmRegister;
begin
//    // register with the server..
//    f := TfrmRegister.Create(Application);
//    f.jid := MainSession.Server;
//    f.Start();
end;

procedure TfrmAnyQ.mnuAddContactClick(Sender: TObject);
begin
    // add a contact
  ShowAddContact();
end;

procedure TfrmAnyQ.mnuAddGroupClick(Sender: TObject);
begin
  // 直接调用主菜单上的事件
  NewGroup2.Click;
end;

procedure TfrmAnyQ.mnuSignOutClick(Sender: TObject);
begin
//
end;

procedure TfrmAnyQ.mnuNewAccountClick(Sender: TObject);
var
  _username: string;
  _password: string;
begin
  if Creating then
  begin
    ShowRiserWindow(nil, '正在创建用户中', ico_info);
    //MessageBox(handle, '正在创建用户中', '错误',MB_OK or MB_ICONERROR);
    Exit;
  end;
  with TfmNewAccount.Create(application) do
  try
    if ShowModal <> mrok then
      Exit;
    _username := txtUserName.Text;
    _password := txtPassword.Text;
    jud_Name := txtName.Text;
    jud_Nick := txtNick.Text;
    jud_company := txtCompany.Text;
    jud_email := txtmail.Text;
  finally
    free;
  end;
  {#TODO1: 新建帐号}
  Creating := true;
  if RegSession = nil then
  begin
    RegSession := TJabberSession.create('');
    RegSession.setAuthAgent(TStandardAuth.Create(RegSession));
    _rs := RegSession.RegisterCallback(SessionCallbackReg, '/session');
  end;

  with RegSession.Prefs.CreateProfile('createnewaccount') do
  begin
    temp := true;
    Username := _username;
    password := _password;
    Server := MainSession.Server;
    ConnectionType := MainSession.Profile.ConnectionType;
    Priority := MainSession.Profile.Priority;
    Host := MainSession.Profile.Host;
    Port := MainSession.Profile.Port;
    ssl := MainSession.Profile.ssl;
    SocksType := MainSession.Profile.SocksType;
    SocksHost := MainSession.Profile.SocksHost;
    SocksPort := MainSession.Profile.SocksPort;
    SocksAuth := MainSession.Profile.SocksAuth;
    SocksUsername := MainSession.Profile.SocksUsername;
    SocksPassword := MainSession.Profile.SocksPassword;
    URL := MainSession.Profile.URL;
    Poll := MainSession.Profile.Poll;
    NumPollKeys := MainSession.Profile.NumPollKeys;
  end;
  RegSession.ActivateProfile(RegSession.Prefs.Profiles.Count - 1);
  RegSession.Connect;
end;

var
  tmppassword: string;

procedure TfrmAnyQ.SessionCallbackReg(event: string; tag: TXMLTag);
var
  msg: TMessage;
begin
  if event = '/session/connected' then begin
    tmppassword := RegSession.Password;
//        RegSession.Password:='';
  end
  else if event = '/session/autherror' then begin
    Creating := false;
    ShowRiserWindow(nil, sAuthError, ico_info);
        //MessageBox(Handle,Pchar(sAuthError), '错误', MB_OK OR MB_ICONERROR);
    RegSession.Disconnect;
    abort;
  end

  else if event = '/session/regerror' then begin
    Creating := false;
    RegSession.Disconnect;
    ShowRiserWindow(nil, sRegError, ico_info);
        //MessageBox(handle, PChar(sRegError), '错误',MB_OK or MB_ICONERROR);
    Exit;
  end

  else if event = '/session/noaccount' then begin
    RegSession.Password := tmppassword;
    RegSession.CreateAccount();
  end

  else if event = '/session/authenticated' then with MainSession do begin
      Creating := false;
      ShowRiserWindow(nil, '创建用户成功！', ico_info);
        //MessageBox(handle,'创建用户成功！','成功',MB_OK or MB_ICONINFORMATION);
      DoRegJud;
      RegSession.Disconnect;
      Exit;
    end
  else if (event = '/session/disconnected') then begin
    Creating := false;
//      RegSession.Disconnect;
//      ShowRiserWindow(nil,sRegError,ico_info);
      //MessageBox(handle, PChar(sRegError), '错误',MB_OK or MB_ICONERROR);
    Exit;
  end
  else if event = '/session/commtimeout' then begin
    Creating := false;
    ShowRiserWindow(nil, sRegError, ico_info);
    RegSession.Disconnect;
        //MessageBox(handle, PChar(sRegError), '错误',MB_OK or MB_ICONERROR);
    Exit;
  end
  else if event = '/session/commerror' then begin
    Creating := false;
    ShowRiserWindow(nil, sRegError, ico_info);
    RegSession.Disconnect;
        //MessageBox(handle, PChar(sRegError), '错误',MB_OK or MB_ICONERROR);
    Exit;
  end

  else if event = '/session/stream:error' then begin
    Creating := false;
    RegSession.Disconnect;
    ShowRiserWindow(nil, sRegError, ico_info);
      //MessageBox(handle, PChar(sRegError), '错误',MB_OK or MB_ICONERROR);
    Exit;
  end;
end;

procedure TfrmAnyQ.N23Click(Sender: TObject);
begin
  ShowFindRoom;
end;

procedure TfrmAnyQ.N110Click(Sender: TObject);
begin
  ShowNewRoom;
end;

procedure TfrmAnyQ.BadCallback(event: string; tag: TXMLTag);
begin
    // Cause an AV
  PInteger(nil)^ := 0;
end;

procedure TfrmAnyQ.mnuEntInfoClick(Sender: TObject);
begin
  showMyentinfo;
end;

procedure TfrmAnyQ.N33Click(Sender: TObject);
begin
  StartFindEnt;
end;

procedure TfrmAnyQ.DoUpdateJud;
var
  iq: TXMLTag;
  _vcard: TXMLVCard;
begin
  _vcard := TXMLVCard.Create();
    // Save the vcard..
  with _vcard do begin
    nick := jud_Nick;
    FullName := jud_Name;
    email := jud_email;
    OrgName := jud_company;
  end;

  iq := TXMLTag.Create('iq');
  iq.setAttribute('id', MainSession.generateID());
  iq.setAttribute('type', 'set');
  _vcard.fillTag(iq);

  MainSession.SendTag(iq);
  _vcard.Free;

  iq := TXMLTag.Create('iq');
  iq.setAttribute('id', MainSession.generateID());
  iq.setAttribute('type', 'set');
  iq.setAttribute('to', 'user.' + MainSession.Server);

  with iq.AddTag('query') do
  begin
    setAttribute('xmlns', XMLNS_REGISTER);
    AddBasicTag('AnyQ', MainSession.BareJid);
    AddBasicTag('nick', jud_Nick);
    AddBasicTag('name', jud_Name);
    AddBasicTag('company', jud_company);
    AddBasicTag('email', jud_email);
    AddBasicTag('domain', MainSession.Server);
  end;
  MainSession.SendTag(iq);
end;

procedure TfrmAnyQ.N21Click(Sender: TObject);
begin
  ShowMyShare;
end;

procedure TfrmAnyQ.timBuildShareListTimer(Sender: TObject);
begin
  TBuildShareListThread.Create;
end;

procedure TfrmAnyQ.WMDisconnect(var msg: TMessage);
begin
    //
  MainSession.Disconnect();
end;

procedure TfrmAnyQ.XMPPActionExecuteMacro(Sender: TObject;
  Msg: TStrings);
var
  c_node: TXMLTag;
  c_jid: TJabberID;
  m: string;
begin
    // Explorer is giving is something about a XMPP file..
  if (Msg.Count = 0) then exit;
  m := Msg[0];
  if (m = 'ignore') then exit;
  if (Pos('open', m) = 1) then begin
    Delete(m, 1, 6);
    Delete(m, Length(m), 1);
    c_node := nil;
    c_jid := nil;
    ParseXMPPFile(m, c_node, c_jid);
    if (MainSession.Active) then
            // ignore c_node, c_jid
      PlayXMPPActions()
    else begin
            // TODO: Handle xmpp connect's via DDE
    end;
  end;
end;

procedure TfrmAnyQ.popSendFile1Click(Sender: TObject);
var
  jid: WideString;
  n: TListItem;
  ritem: TJabberRosterItem;
begin
    // Message someone
  jid := '';
  if (frmRosterWindow.Lvusers.SelCount > 0) then begin
    n := frmRosterWindow.Lvusers.Selected;
    if (TObject(n.Data) is TJabberRosterItem) then begin
      ritem := TJabberRosterItem(n.Data);
      if ritem <> nil then
        jid := ritem.jid.jid
    end;
  end;

  if GetContactSID('发送文件', '请在下面选择您想发送文件的人的名字，然后单击“确定”。', '请输入您想向其发送文件的人的'+sJid+'。', jid, true) then
    FileSend(jid);
end;

procedure TfrmAnyQ.popInstantMail1Click(Sender: TObject);
var
  jid: WideString;
  n: TListItem;
  ritem: TJabberRosterItem;
begin
    // Message someone
  jid := '';
  if (frmRosterWindow.Lvusers.SelCount > 0) then begin
    n := frmRosterWindow.Lvusers.Selected;
    if (TObject(n.Data) is TJabberRosterItem) then begin
      ritem := TJabberRosterItem(n.Data);
      if ritem <> nil then
        jid := ritem.jid.jid
    end;
  end;

  if GetContactSID('发送即时邮件', '请在下面选择您想发送即时邮件的人的名字，然后单击“确定”。', '请输入您想向其发送即时邮件的人的'+sJid+'。', jid, true) then
    InstantMailSend(jid);
end;

procedure TfrmAnyQ.InvitetoConference1Click(Sender: TObject);
begin
  ShowNewRoom;
end;

procedure TfrmAnyQ.N24Click(Sender: TObject);
begin
  frmRosterWindow.N8.Click;
end;

procedure TfrmAnyQ.popGetShareList1Click(Sender: TObject);
var
  jid: WideString;
  n: TListItem;
  ritem: TJabberRosterItem;
begin
    // Message someone
  jid := '';
  if (frmRosterWindow.Lvusers.SelCount > 0) then begin
    n := frmRosterWindow.Lvusers.Selected;
    if (TObject(n.Data) is TJabberRosterItem) then begin
      ritem := TJabberRosterItem(n.Data);
      if ritem <> nil then
        jid := ritem.jid.full
    end;
  end;

  if GetContactSID('获取共享', '请在下面选择您想获取其共享列表的人的名字，然后单击“确定”。', '请输入您想获取其共享列表的人的'+sJid+'。', jid) then
    GetShareList(jid);
end;

procedure TfrmAnyQ.btnRoomClick(Sender: TObject);
var
  cp: TPoint;
begin
  if MainSession.Active then begin
    cp := btnRoom.ClientToScreen(point(btnRoom.Width div 2, btnRoom.Height));
    popRoom.Popup(cp.x, cp.y);
  end;
//  ShowNewRoom;
end;

procedure TfrmAnyQ.btnFindClick(Sender: TObject);
var
  cp: TPoint;
begin
  if MainSession.Active then begin
    cp := btnFind.ClientToScreen(point(btnFind.Width div 2, btnFind.Height));
    popStatus.Popup(cp.x, cp.y);
  end;
//  SearchforPerson1.Click;
end;

procedure TfrmAnyQ.N20Click(Sender: TObject);
begin
  N20.Checked := not N20.Checked;
  if N20.Checked then
    SetWindowPos(Self.Handle, HWND_TOPMOST, 0, 0, 0, 0,
      SWP_NOMOVE + SWP_NOREPOSITION + SWP_NOSIZE)
  else
    SetWindowPos(Self.Handle, HWND_NOTOPMOST, 0, 0, 0, 0,
      SWP_NOMOVE + SWP_NOREPOSITION + SWP_NOSIZE);
end;

procedure TfrmAnyQ.N27Click(Sender: TObject);
var
  t: TXMLTag;
begin
  MainSession.Invisible := true;
  t := TXMLTag.Create('presence');
  t.setAttribute('type', 'invisible');
  MainSession.SendTag(t);
  setTrayIcon(N27.ImageIndex);
  frmRosterWindow.ChangeStatusImage(N27.ImageIndex);
  frmRosterWindow.lblStatusLink.Caption := ' [隐身]';
  MainSession.Status := '隐身';
end;

procedure TfrmAnyQ.mnuPluginsClick(Sender: TObject);
begin
  N27.Click;
end;

procedure TfrmAnyQ.ProcessNoAccount;
  procedure disconnect;
  begin
    _logoff := true;
    PostMessage(Self.Handle, WM_DISCONNECT, 0, 0);
  end;
  procedure createaccount;
  begin
    _new_account := true;
    MainSession.CreateAccount();
  end;
  function checkpop: boolean;
  var
    pop3: TIdPOP3;
  begin
    Result := false;
    pop3 := TIdPOP3.Create(nil);
    try
      try
        pop3.Host := MainSession.Server;
        pop3.Port := 110;
        pop3.Username := MainSession.Username;
        pop3.Password := MainSession.Password;
        pop3.Connect(5000); //超时设置，默认5秒
        Result := pop3.Connected;
      except
      end;
    finally
      pop3.Free;
    end;
  end;
begin
{
  if MainSession.PopAuth then
  begin
    if checkpop then
      createaccount
    else
    begin
      disconnect;
      MainSession.ClearCurrProfile;
    end;
//    PostMessage(Self.Handle, WM_REMOVEPROFILE, 0, 0);
    exit;
  end;

  if MainSession.AdminMode then
  begin
    if UpperCase(MainSession.Username) <> 'ADMIN' then
    begin
//      _logoff := true;
      disconnect;
      ShowRiserWindow(nil, '该用户不存在', ico_info);
      MainSession.ClearCurrProfile;
      PostMessage(Self.Handle, WM_SHOWLOGIN, 0, 0);
//      PostMessage(Self.Handle, WM_REMOVEPROFILE, 0, 0);
//      PostMessage(Self.Handle, WM_DISCONNECT, 0, 0);
      //MessageBox(Handle,'该用户不存在', '错误', MB_OK OR MB_ICONERROR);
      exit;
    end;
  end;
{}
  if (MessageBox(Handle, Pchar(sAuthNoAccount), '确认', MB_YESNO or MB_ICONQUESTION) = mrNo) then begin
      // Just disconnect, they don't want an account
    disconnect;
  end
  else begin
      // create the new account
    createaccount;
  end;
end;

procedure TfrmAnyQ.SMAIL1Click(Sender: TObject);
begin
  ShellExecute(0, 'open', pchar(extractfilepath(application.ExeName) + '\SMAIL\smail.exe'), nil, nil, SW_SHOW);
end;

procedure TfrmAnyQ.N30Click(Sender: TObject);
begin
  NewMail;
//  ShellExecute(0, 'open',pchar(extractfilepath(application.ExeName)+'\SMAIL\smail.exe'),'-newmail',nil,SW_SHOW);
end;

procedure TfrmAnyQ.SMAIL2Click(Sender: TObject);
var
  h: THANDLE;
begin
  h := FindWindow('TMainForm', 'SMAIL');
  if h < 32 then exit;
  postmessage(h, WM_CLOSE, 0, 0);
//  CloseWindow(h);
end;

procedure TfrmAnyQ.N34Click(Sender: TObject);
var
  jid: WideString;
  n: TListItem;
  ritem: TJabberRosterItem;
begin
    // Message someone
  jid := '';
  if (frmRosterWindow.Lvusers.SelCount > 0) then begin
    n := frmRosterWindow.Lvusers.Selected;
    if (TObject(n.Data) is TJabberRosterItem) then begin
      ritem := TJabberRosterItem(n.Data);
      if ritem <> nil then
        jid := ritem.jid.jid
    end;
  end;

  if GetContactSID('发送即时邮件', '请在下面选择您想发送即时邮件的人的名字，然后单击“确定”。', '请输入您想向其发送即时邮件的人的'+sJid+'。', jid) then
    NewMail(GetMailAddr(jid));
end;

procedure NewMail(addr: widestring);
begin
  if addr <> '' then
  begin
    addr := '"' + addr + '"';
    ShellExecute(0, 'open', pchar(extractfilepath(application.ExeName) + '\SMAIL\smail.exe'),
      pchar('-newmail ' + addr), pchar(extractfilepath(application.ExeName) + '\SMAIL\'), SW_NORMAL);
  end
  else
    ShellExecute(0, 'open', pchar(extractfilepath(application.ExeName) + '\SMAIL\smail.exe'), '-newmail', pchar(extractfilepath(application.ExeName) + '\SMAIL\'), SW_SHOW);
end;

procedure TfrmAnyQ.N35Click(Sender: TObject);
begin
  if MainSession.Active then begin
    _logoff := true;
    MainSession.Disconnect();
  end
end;

procedure TfrmAnyQ.ActLoginUpdate(Sender: TObject);
begin
  ActLogin.Enabled := not MainSession.Active;
end;

procedure TfrmAnyQ.ActLogoutUpdate(Sender: TObject);
begin
  ActLogout.Enabled := MainSession.Active;
end;

procedure TfrmAnyQ.ActLoginExecute(Sender: TObject);
begin
  if not MainSession.Active then begin
    timReconnect.Enabled := false;
    _reconnect_tries := 0;
    ShowLogin;
  end;
end;

procedure TfrmAnyQ.ActLogoutExecute(Sender: TObject);
begin
  if MainSession.Active then begin
    _logoff := true;
    MainSession.Disconnect();
  end
end;

procedure TfrmAnyQ.W1Click(Sender: TObject);
begin
//    StartSearch('users.'+MainSession.Server);
  StartSearchNew(MainSession.MyAgents.getFirstSearch);
end;

procedure TfrmAnyQ.A1Click(Sender: TObject);
var
  jid: WideString;
  n: TListItem;
  ritem: TJabberRosterItem;
begin
    // Message someone
  jid := '';
  if (frmRosterWindow.Lvusers.SelCount > 0) then begin
    n := frmRosterWindow.Lvusers.Selected;
    if (TObject(n.Data) is TJabberRosterItem) then begin
      ritem := TJabberRosterItem(n.Data);
      if ritem <> nil then
        jid := ritem.jid.jid
    end;
  end;

  if GetContactSID('开始语音对话', '请在下面选择您想进行语音对话的人的名字，然后单击“确定”。', '请输入您想进行语音对话的人的'+sJid+'。', jid, true) then
    StartAudioChat(jid)
end;

procedure TfrmAnyQ.V1Click(Sender: TObject);
var
  jid: WideString;
  n: TListItem;
  ritem: TJabberRosterItem;
begin
    // Message someone
  jid := '';
  if (frmRosterWindow.Lvusers.SelCount > 0) then begin
    n := frmRosterWindow.Lvusers.Selected;
    if (TObject(n.Data) is TJabberRosterItem) then begin
      ritem := TJabberRosterItem(n.Data);
      if ritem <> nil then
        jid := ritem.jid.jid
    end;
  end;

  if GetContactSID('开始视频对话', '请在下面选择您想进行视频对话的人的名字，然后单击“确定”。', '请输入您想进行视频对话的人的'+sJid+'。', jid, true) then
    StartVideoChat(jid)
end;

procedure TfrmAnyQ.E1Click(Sender: TObject);
begin
  StartFindEnt;
end;

procedure TfrmAnyQ.btnMailClick(Sender: TObject);
var
  cp: TPoint;
begin
  if MainSession.Active then begin
    cp := btnMail.ClientToScreen(point(btnMail.Width div 2, btnMail.Height));
    popMail.Popup(cp.x, cp.y);
  end;
end;

procedure TfrmAnyQ.btnFindContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
var
  cp: TPoint;
begin
  if MainSession.Active then begin
    cp := btnFind.ClientToScreen(point(btnFind.Width div 2, btnFind.Height));
    popStatus.Popup(cp.x, cp.y);
  end;
  Handled := true;
end;

procedure TfrmAnyQ.btnAddContactContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
var
  cp: TPoint;
begin
  if MainSession.Active then begin
    cp := btnAddContact.ClientToScreen(point(btnAddContact.Width div 2, btnAddContact.Height));
    popAdd.Popup(cp.x, cp.y);
  end;
  Handled := true;
end;

procedure TfrmAnyQ.btnRoomContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
var
  cp: TPoint;
begin
  if MainSession.Active then begin
    cp := btnRoom.ClientToScreen(point(btnRoom.Width div 2, btnRoom.Height));
    popRoom.Popup(cp.x, cp.y);
  end;
  Handled := true;
end;

procedure TfrmAnyQ.btnMailContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
var
  cp: TPoint;
begin
  if MainSession.Active then begin
    cp := btnMail.ClientToScreen(point(btnMail.Width div 2, btnMail.Height));
    popMail.Popup(cp.x, cp.y);
  end;
  Handled := true;
end;

procedure TfrmAnyQ.N39Click(Sender: TObject);
begin
  ShellExecute(0, 'open', pchar(extractfilepath(application.ExeName) + '\SMAIL\smail.exe'),
    pchar('-findmail '), pchar(extractfilepath(application.ExeName) + '\SMAIL\'), SW_NORMAL);
end;

procedure TfrmAnyQ.N40Click(Sender: TObject);
begin
  ShellExecute(0, 'open', pchar(extractfilepath(application.ExeName) + '\SMAIL\smail.exe'),
    pchar('-findaddress '), pchar(extractfilepath(application.ExeName) + '\SMAIL\'), SW_NORMAL);
end;

procedure TfrmAnyQ.N41Click(Sender: TObject);
begin
  ShellExecute(0, 'open', pchar(extractfilepath(application.ExeName) + '\SMAIL\smail.exe'),
    pchar('-sendreceivemail '), pchar(extractfilepath(application.ExeName) + '\SMAIL\'), SW_NORMAL);
end;

procedure TfrmAnyQ.DoRegJud;
var
  iq: TXMLTag;
  _vcard: TXMLVCard;
begin
  if RegSession = nil then exit;
  if not RegSession.Active then exit;
  _vcard := TXMLVCard.Create();
    // Save the vcard..
  with _vcard do begin
    nick := jud_Nick;
    FullName := jud_Name;
    email := jud_email;
    OrgName := jud_company;
  end;

  iq := TXMLTag.Create('iq');
  iq.setAttribute('id', RegSession.generateID());
  iq.setAttribute('type', 'set');
  _vcard.fillTag(iq);

  MainSession.SendTag(iq);
  _vcard.Free;

  iq := TXMLTag.Create('iq');
  iq.setAttribute('id', RegSession.generateID());
  iq.setAttribute('type', 'set');
  iq.setAttribute('to', 'user.' + RegSession.Server);

  with iq.AddTag('query') do
  begin
    setAttribute('xmlns', XMLNS_REGISTER);
    AddBasicTag('AnyQ', RegSession.BareJid);
    AddBasicTag('nick', jud_Nick);
    AddBasicTag('name', jud_Name);
    AddBasicTag('company', jud_company);
    AddBasicTag('email', jud_email);
    AddBasicTag('domain', RegSession.Server);
  end;
  RegSession.SendTag(iq);
end;

procedure TfrmAnyQ.TimerMailcheckTimer(Sender: TObject);
begin
  //
  TMailCheckThread.Create;
  TimerMailcheck.Enabled := false;
end;

procedure TfrmAnyQ.I1Click(Sender: TObject);
begin
  with TInmHistoryForm.Create(Application) do
  try
    ShowModal;
  finally
    Free;
  end;
end;

procedure TfrmAnyQ.W2Click(Sender: TObject);
var
  jid: WideString;
  n: TListItem;
  ritem: TJabberRosterItem;
begin
    // Message someone
  jid := '';
  if (frmRosterWindow.Lvusers.SelCount > 0) then begin
    n := frmRosterWindow.Lvusers.Selected;
    if (TObject(n.Data) is TJabberRosterItem) then begin
      ritem := TJabberRosterItem(n.Data);
      if ritem <> nil then
        jid := ritem.jid.full
    end;
  end;

  if GetContactSID('启用白板', '请在下面选择您想启用白板的人的名字，然后单击“确定”。', '请输入您想启用白板的人的'+sJid+'。', jid, true) then
    StartWhiteboard(jid);
end;

procedure TfrmAnyQ.WMRemoveProfile(var msg: TMessage);
begin
  MainSession.Prefs.RemoveProfile(MainSession.Profile);
end;

procedure TfrmAnyQ.WizardAvClick(Sender: TObject);
begin
  StartAVWizard;
end;

function UrlEncode(const DecodedStr: String; Pluses: Boolean): String;
var
  I: Integer;
begin
  Result := '';
  if Length(DecodedStr) > 0 then
    for I := 1 to Length(DecodedStr) do
    begin
      if not (DecodedStr[I] in ['0'..'9', 'a'..'z',
                                       'A'..'Z', ' ']) then
        Result := Result + '%' + IntToHex(Ord(DecodedStr[I]), 2)
      else if not (DecodedStr[I] = ' ') then
        Result := Result + DecodedStr[I]
      else
        begin
          if not Pluses then
            Result := Result + '%20'
          else
            Result := Result + '+';
        end;
    end;
end;

function HexToInt(HexStr: String): Int64;
var RetVar : Int64;
    i : byte;
begin
  HexStr := UpperCase(HexStr);
  if HexStr[length(HexStr)] = 'H' then
     Delete(HexStr,length(HexStr),1);
  RetVar := 0;

  for i := 1 to length(HexStr) do begin
      RetVar := RetVar shl 4;
      if HexStr[i] in ['0'..'9'] then
         RetVar := RetVar + (byte(HexStr[i]) - 48)
      else
         if HexStr[i] in ['A'..'F'] then
            RetVar := RetVar + (byte(HexStr[i]) - 55)
         else begin
            Retvar := 0;
            break;
         end;
  end;

  Result := RetVar;
end;

function UrlDecode(const EncodedStr: String): String;
var
  I: Integer;
begin
  Result := '';
  if Length(EncodedStr) > 0 then
  begin
    I := 1;
    while I <= Length(EncodedStr) do
    begin
      if EncodedStr[I] = '%' then
        begin
          Result := Result + Chr(HexToInt(EncodedStr[I+1]
                                       + EncodedStr[I+2]));
          I := Succ(Succ(I));
        end
      else if EncodedStr[I] = '+' then
        Result := Result + ' '
      else
        Result := Result + EncodedStr[I];

      I := Succ(I);
    end;
  end;
end;


procedure TfrmAnyQ.sendsms(jid, txt: string);
var
  mobile: string;
  smstxt: string;
  idhttp: TIdHTTP;
begin
  if not MainSession.Active then
    exit;
  mobile := MainSession.roster.Find(jid).mobile;
  if mobile='' then
    exit;
  idhttp := TIDHttp.Create(nil);
  try
//    smstxt := HTML_EscapeChars(MainSession.BareJid+':'+txt,True);
    smstxt := UrlEncode(MainSession.BareJid+':'+txt, false);
    idhttp.Get('http://user-register.openext.com/op4/test.php?mobile='+mobile+'&ch1=1&mmessage='+smstxt);
  finally
    idhttp.Free;
  end;
end;

procedure TfrmAnyQ.S1Click(Sender: TObject);
begin
  frmRosterWindow.BroadcastSMS.Click;
end;

procedure TfrmAnyQ.T1Click(Sender: TObject);
var
  helpname: string;
begin
  helpname := ExtractFilePath(Application.ExeName)+'使用条款.txt';
  ShellExecute(Application.Handle, 'open', pchar(helpname), nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmAnyQ.N19Click(Sender: TObject);
var
  helpname: string;
begin
  helpname := ExtractFilePath(Application.ExeName)+'Manual.chm';
  ShellExecute(Application.Handle, 'open', pchar(helpname), nil, nil, SW_SHOWNORMAL);
end;

initialization
  sAnyQPresence := RegisterWindowMessage('AnyQ_PRESENCE');
  sAnyQMutex := RegisterWindowMessage('AnyQ_MESSAGE');
  sShellRestart := RegisterWindowMessage('TaskbarCreated');
end.

