开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
RealMessengerImpl.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：121k
源码类别：

Delphi控件源码

开发平台：

Delphi

RealMessengerImpl.pas：源码内容
  1. unit RealMessengerImpl;
  3. {$WARN SYMBOL_PLATFORM OFF}
  5. interface
  7. uses
  8.   Windows, ShellAPI, SysUtils, StrUtils, Classes, Graphics, Controls, Forms, Dialogs,
  9.   ActiveX, AxCtrls, StdVcl, ExtCtrls, StdCtrls, Contnrs,
  10.   ComCtrls, ToolWin, ImgList, UrlMon, MSHtml, MMSystem, Menus, Registry,
  11.   Global, CoolTrayIcon, AppEvnts, Messages, MMPCMSup,
  12.   WinSock, vfw, Color, ShlObj, WNDES, SyncObjs, ChatingFrm,
  13.   RealMessengerUnit, MyInputBoxFrm, SelFaceFrm, MsgFrm, HistoryFrm,
  14.   SystemSetFrm, Tabs, DSUtil, DirectShow9, VideoConsts,
  15.   IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  16.   IdMessageClient, IdPOP3, Pop3ServerFrm, MMObj, MMDevice, MD5,
  17.   MMMixer, MySocket, IdUDPBase, IdUDPClient,
  18.   IdIOHandler, IdIOHandlerSocket, IdSocks, Gauges, IdAntiFreezeBase,
  19.   IdAntiFreeze, IdHTTP, bsSkinMenus, bsSkinData, BusinessSkinForm,
  20.   OleCtrls, SHDocVw, Mask, bsSkinBoxCtrls, bsSkinCtrls, bsSkinTabs, RxGIF;
  22. type
  23.   TViewStyle = (vsTree, vsOnlineOffline, vsGroup);
  25.   TRealMessengerX = class(TForm)
  26.     ImgToolbarLeft: TImage;
  27.     ImgTitle: TImage;
  28.     ImgDraw: TImage;
  29.     ImgTitleLeft: TImage;
  30.     ImgTitleRight: TImage;
  31.     ImgToolbarRight: TImage;
  32.     ImgToolbar: TImage;
  33.     ImgBorderLeft: TImage;
  34.     ImgBottomLeft: TImage;
  35.     ImgBottom: TImage;
  36.     ImgBottomRight: TImage;
  37.     ImgBorderRight: TImage;
  38.     ImgClosed: TImage;
  39.     ImgMin: TImage;
  40.     bsSkinPanel1: TbsSkinPanel;
  41.     ImgEmail: TImage;
  42.     LblMyState: TLabel;
  43.     ImgMyState: TImage;
  44.     LblMailCount: TLabel;
  45.     bsSkinMenuSpeedButton1: TbsSkinMenuSpeedButton;
  46.     LblFile: TLabel;
  47.     bsSkinMenuSpeedButton2: TbsSkinMenuSpeedButton;
  48.     PnlRoot: TPanel;
  49.     Image1: TImage;
  50.     bsSkinPageControl1: TbsSkinPageControl;
  51.     bsSkinTabSheet1: TbsSkinTabSheet;
  52.     PnlWorkSpace: TPanel;
  53.     PBLogin: TPanel;
  54.     Gauge: TGauge;
  55.     LblLoging: TLabel;
  56.     LblCancelLogin: TLabel;
  57.     bsSkinScrollBar1: TbsSkinScrollBar;
  58.     bsSkinScrollBar2: TbsSkinScrollBar;
  59.     TrevUserList: TbsSkinTreeView;
  60.     bsSkinPanel3: TbsSkinPanel;
  61.     Image2: TImage;
  62.     edturl: TbsSkinEdit;
  63.     bsSkinPanel4: TbsSkinPanel;
  64.     bsSkinButton2: TbsSkinButton;
  65.     bsSkinPanel5: TbsSkinPanel;
  66.     bsSkinTabSheet2: TbsSkinTabSheet;
  67.     bsSkinPanel2: TbsSkinPanel;
  68.     WBSMS: TWebBrowser;
  69.     bsSkinTabSheet3: TbsSkinTabSheet;
  70.     WBHY: TWebBrowser;
  71.     HartTimer: TTimer;
  72.     PpMenuRight: TPopupMenu;
  73.     NR1: TMenuItem;
  74.     NR2: TMenuItem;
  75.     NR3: TMenuItem;
  76.     NR4: TMenuItem;
  77.     N5: TMenuItem;
  78.     sdfa1: TMenuItem;
  79.     NR5: TMenuItem;
  80.     NSplitOfGroup: TMenuItem;
  81.     NNewGroup: TMenuItem;
  82.     NDelGroup: TMenuItem;
  83.     NAddGroupMember: TMenuItem;
  84.     NRemoveFromGroup: TMenuItem;
  85.     CoolTrayIcon: TCoolTrayIcon;
  86.     ImgLstTrayIcon: TImageList;
  87.     ImgLstMsgAlert: TImageList;
  88.     STimer: TTimer;
  89.     PpMenuStates: TPopupMenu;
  90.     NS1: TMenuItem;
  91.     NS2: TMenuItem;
  92.     NS3: TMenuItem;
  93.     NS4: TMenuItem;
  94.     NS5: TMenuItem;
  95.     NS6: TMenuItem;
  96.     NS7: TMenuItem;
  97.     NS8: TMenuItem;
  98.     N15: TMenuItem;
  99.     NS9: TMenuItem;
  100.     TimerAutoConnect: TTimer;
  101.     TimerTopBar: TTimer;
  102.     PopupMenuShortCut: TPopupMenu;
  103.     N8: TMenuItem;
  104.     ClientPOP3: TIdPOP3;
  105.     Device: TMMMixerDevice;
  106.     TimeCheckTransmitFileError: TTimer;
  107.     ClientTCP: TIdTCPClient;
  108.     IdIOHandlerSocket1: TIdIOHandlerSocket;
  109.     IdSocksInfo1: TIdSocksInfo;
  110.     MsgTimer: TTimer;
  111.     KeepP2PSessionTimer: TTimer;
  112.     ApplicationEvents1: TApplicationEvents;
  113.     TimerLoging: TTimer;
  114.     TimeCheckAVError: TTimer;
  115.     IdAntiFreeze1: TIdAntiFreeze;
  116.     bsBusinessSkinForm1: TbsBusinessSkinForm;
  117.     bsSkinData1: TbsSkinData;
  118.     Skin1: TbsCompressedStoredSkin;
  119.     Timer1: TTimer;
  120.     PopHelp: TbsSkinPopupMenu;
  121.     N14: TMenuItem;
  122.     N16: TMenuItem;
  123.     Timer2: TTimer;
  124.     IdHTTP1: TIdHTTP;
  125.     ImglstTreeIcons: TImageList;
  126.     PopFile: TPopupMenu;
  127.     MOpen: TMenuItem;
  128.     MConnect: TMenuItem;
  129.     MConnectSet: TMenuItem;
  130.     MDisconnect: TMenuItem;
  131.     C1: TMenuItem;
  132.     MChangeNameAndPassword: TMenuItem;
  133.     N3: TMenuItem;
  134.     MMyState: TMenuItem;
  135.     MOnline: TMenuItem;
  136.     MBusy: TMenuItem;
  137.     MWillBack: TMenuItem;
  138.     MLeave: TMenuItem;
  139.     MPhone: TMenuItem;
  140.     MRepast: TMenuItem;
  141.     NMeeting: TMenuItem;
  142.     MOther: TMenuItem;
  143.     N9: TMenuItem;
  144.     MOffline: TMenuItem;
  145.     N2: TMenuItem;
  146.     MAutoLeave: TMenuItem;
  147.     MAutoBusy: TMenuItem;
  148.     N6: TMenuItem;
  149.     MSendMsg: TMenuItem;
  150.     MSendFile: TMenuItem;
  151.     MSendVoice: TMenuItem;
  152.     MSendVideo: TMenuItem;
  153.     N11: TMenuItem;
  154.     MAVSets: TMenuItem;
  155.     N7: TMenuItem;
  156.     MShowHistory: TMenuItem;
  157.     N4: TMenuItem;
  158.     MExit: TMenuItem;
  159.     Label1: TLabel;
  160.     procedure TrevUserListGetImageIndex(Sender: TObject; Node: TTreeNode);
  161.     procedure TrevUserListCustomDrawItem(Sender: TCustomTreeView;
  162.       Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
  163.     procedure MConnectClick(Sender: TObject);
  164.     procedure MTreeClick(Sender: TObject);
  165.     procedure MOnOrOffClick(Sender: TObject);
  166.     procedure MOfflineClick(Sender: TObject);
  167.     procedure MOtherClick(Sender: TObject);
  168.     procedure TrevUserListDblClick(Sender: TObject);
  169.     procedure ClientLogin();
  170.     procedure ClientLogout();
  171.     procedure ActiveFormCreate(Sender: TObject);
  172.     procedure MDisconnectClick(Sender: TObject);
  173.     procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
  174.     procedure LblMyStateClick(Sender: TObject);
  175.     procedure HartTimerTimer(Sender: TObject);
  176.     procedure TrevUserListMouseDown(Sender: TObject; Button: TMouseButton;
  177.       Shift: TShiftState; X, Y: Integer);
  178.     procedure TrevUserListChange(Sender: TObject; Node: TTreeNode);
  179.     procedure MAutoLeaveClick(Sender: TObject);
  180.     procedure MAutoBusyClick(Sender: TObject);
  181.     procedure NR2Click(Sender: TObject);
  182.     procedure NR3Click(Sender: TObject);
  183.     procedure NR4Click(Sender: TObject);
  184.     procedure CoolTrayIconDblClick(Sender: TObject);
  185.     procedure NR5Click(Sender: TObject);
  186.     procedure TrevUserListMouseMove(Sender: TObject; Shift: TShiftState; X,
  187.       Y: Integer);
  188.     procedure STimerTimer(Sender: TObject);
  189.     procedure ActiveFormDestroy(Sender: TObject);
  190.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  191.     procedure MExitClick(Sender: TObject);
  192.     procedure FormShow(Sender: TObject);
  193.     procedure TimerAutoConnectTimer(Sender: TObject);
  194.     procedure MGroupClick(Sender: TObject);
  195.     procedure NNewGroupClick(Sender: TObject);
  196.     procedure NDelGroupClick(Sender: TObject);
  197.     procedure NRemoveFromGroupClick(Sender: TObject);
  198.     procedure NAddGroupMemberClick(Sender: TObject);
  199.     procedure MConnectSetClick(Sender: TObject);
  200.     procedure MShowSysHistoryClick(Sender: TObject);
  201.     procedure LblFileClick(Sender: TObject);
  202.     procedure ImgClosedClick(Sender: TObject);
  203.     procedure ImgMinMouseDown(Sender: TObject; Button: TMouseButton;
  204.       Shift: TShiftState; X, Y: Integer);
  205.     procedure ImgMinMouseUp(Sender: TObject; Button: TMouseButton;
  206.       Shift: TShiftState; X, Y: Integer);
  207.     procedure LblFileMouseMove(Sender: TObject; Shift: TShiftState; X,
  208.       Y: Integer);
  209.     procedure TimerTopBarTimer(Sender: TObject);
  210.     procedure LblFileMouseDown(Sender: TObject; Button: TMouseButton;
  211.       Shift: TShiftState; X, Y: Integer);
  212.     procedure ImgMinClick(Sender: TObject);
  213.     procedure ImgTitleMouseDown(Sender: TObject; Button: TMouseButton;
  214.       Shift: TShiftState; X, Y: Integer);
  215.     procedure LblMailCountClick(Sender: TObject);
  216.     procedure MAVSetsClick(Sender: TObject);
  217.     procedure ClientTCPDisconnected(Sender: TObject);
  218.     procedure ClientTCPConnected(Sender: TObject);
  219.     procedure TimeCheckTransmitFileErrorTimer(Sender: TObject);
  220.     procedure FormResize(Sender: TObject);
  221.     procedure MsgTimerTimer(Sender: TObject);
  222.     procedure KeepP2PSessionTimerTimer(Sender: TObject);
  223.     procedure TimerLogingTimer(Sender: TObject);
  224.     procedure TimeCheckAVErrorTimer(Sender: TObject);
  225.     procedure MChangeNameAndPasswordClick(Sender: TObject);
  226.     procedure bsSkinMenuSpeedButton2Click(Sender: TObject);
  227.     procedure N14Click(Sender: TObject);
  228.     procedure N17Click(Sender: TObject);
  229.     procedure N16Click(Sender: TObject);
  230.   private
  231.     ImgIndex, LastImgIndex: Integer;
  232.   protected
  233.     { Protected declarations }
  234.   public
  235.     IsInIE: Boolean;
  236.     HotKeyMgrIsProcessing: Boolean;
  237.     CurNode: TTreeNode;
  238.     procedure SendIdentity;
  239.     procedure GetInit();
  240.     procedure UpdateListViewStates(TV: TbsSkinTreeView; Node: TTreeNode);
  241.     procedure UpdateMyState();
  242.     procedure ChangeMyState(State: string; IsAutoState: Boolean = False);
  243.     procedure ChangeLblMyStateCaption();
  244.     procedure FlashTray(ChatingForm: TChatingForm);
  245.     procedure Login();
  246.     procedure GetListViewData(TV: TbsSkinTreeView; ViewStyle: TViewStyle = vsTree; IsForSelForm: Boolean = False); //显示用户列表
  247.     procedure TestVideoDevice();
  248.     procedure TestAudioDevice();
  249.     procedure ShowImage(PHandle: HWND; BitMap: HBitMap; Buf: PByte);
  250.     procedure WMDEVICECHANGE(var msgx: Tmessage); message WM_DEVICECHANGE;
  251.     procedure WMMOVE(var Msg: Tmessage); message WM_MOVE;
  252.     procedure ProcessCBInputing(CBInputing: TCBInputing);
  253.     procedure ProcessCBReturnMessage(CBReturnMessage: TCBReturnMessage);
  254.     procedure ProcessCBMessage(CBMessage: TCBMessage);
  255.     procedure ProcessCBSendFileResult(CBSendFileResult: TCBSendFileResult);
  256.     procedure ProcessCBSendFilePackage(CBSendFilePackage: TCBSendFilePackage);
  257.     procedure ProcessCBAudio(CBAudio: TCBAudio);
  258.     procedure ProcessCBVideo(CBVideo: TCBVideo);
  259.   end;
  261.   TClientHandleThread = class(TThread)
  262.   private
  263.     FLock: TCriticalSection;
  264.     CBLoginResult: TCBLoginResult;
  265.     CBSendBranch: TCBSendBranch;
  266.     CBSendEmployee: TCBSendEmployee;
  267.     CBStateChanged: TCBStateChanged;
  268.     CBInputing: TCBInputing;
  269.     CBMessage: TCBMessage;
  270.     CBReturnMessage: TCBReturnMessage;
  271.     CBAddUser: TCBAddUser;
  272.     CBSendFileRequest: TCBSendFileRequest;
  273.     CBSendFileCancle: TCBSendFileCancle;
  274.     CBSendFileStop: TCBSendFileStop;
  275.     CBSendFileResponse: TCBSendFileResponse;
  276.     CBSendFileResult: TCBSendFileResult;
  277.     CBSendFilePackage: TCBSendFilePackage;
  278.     CBSendFileResume: TCBSendFileResume;
  279.     CBSendFileCompleted: TCBSendFileCompleted;
  280.     CBAudioRequest: TCBAudioRequest;
  281.     CBAudioResponse: TCBAudioResponse;
  282.     CBAudioCancel: TCBAudioCancel;
  283.     CBAudio: TCBAudio;
  284.     CBAudioStop: TCBAudioStop;
  285.     CBVideoRequest: TCBVideoRequest;
  286.     CBVideoResponse: TCBVideoResponse;
  287.     CBVideoCancel: TCBVideoCancel;
  288.     CBVideoStop: TCBVideoStop;
  289.     CBSetBitmapInfo: TCBSetBitmapInfo;
  290.     CBSetCompvars: TCBSetCompvars;
  291.     CBVideo: TCBVideo;
  292.     CBBeginTalk: TCBBeginTalk;
  293.     CBPleaseUseTCP: TCBPleaseUseTCP;
  294.     CBNameAndPasswordChanged: TCBNameAndPasswordChanged;
  295.     procedure ProcessCBSendBranch;
  296.     procedure ProcessCBSendEmployee;
  297.     procedure ProcessCBLoginResult;
  298.     procedure ProcessCBStateChanged;
  299.     procedure ProcessCBInputing;
  300.     procedure ProcessCBMessage;
  301.     procedure ProcessCBReturnMessage;
  302.     procedure ProcessCBAddUser;
  303.     procedure ProcessCBSendFileRequest;
  304.     procedure ProcessCBSendFileCancle;
  305.     procedure ProcessCBSendFileStop;
  306.     procedure ProcessCBSendFileResponse;
  307.     procedure ProcessCBSendFileResult;
  308.     procedure ProcessCBSendFilePackage;
  309.     procedure ProcessCBSendFileResume;
  310.     procedure ProcessCBSendFileCompleted;
  311.     procedure ProcessCBAudioRequest;
  312.     procedure ProcessCBAudioResponse;
  313.     procedure ProcessCBAudioCancel;
  314.     procedure ProcessCBAudio;
  315.     procedure ProcessCBAudioStop;
  316.     procedure ProcessCBVideoRequest;
  317.     procedure ProcessCBVideoResponse;
  318.     procedure ProcessCBVideoCancel;
  319.     procedure ProcessCBVideoStop;
  320.     procedure ProcessCBSetBitmapInfo;
  321.     procedure ProcessCBSetCompvars;
  322.     procedure ProcessCBVideo;
  323.     procedure ProcessCBBeginTalk;
  324.     procedure ProcessCBPleaseUseTCP;
  325.     procedure ProcessCBNameAndPasswordChanged;
  326.   public
  327.     constructor Create;
  328.     destructor Destroy; override;
  329.     procedure Execute; override;
  330.   end;
  332. var
  333.   ConnectedTicket: Cardinal;
  334.   RealMessengerX: TRealMessengerX;
  335.   CheckPOP3ThreadHandle: THandle;
  336.   ClientHandleThread: TClientHandleThread;
  337.   LastMailCount, CurrentMailCount: Integer;
  339. implementation
  341. uses ComObj, ComServ, LoginFrm, SelUserFrm, AboutFrm, TempFrm, VideoFrm,
  342.   CopyScreenFrm, AVSetFrm, ChangeNameAndPasswordFrm;
  344. {$R *.DFM}
  346. function GetFormNameAt(X, Y: Integer): string;
  347. var
  348.   P: TPoint;
  349.   W: TWinControl;
  350. begin
  351.   P.X := X;
  352.   P.Y := Y;
  353.   W := FindVCLWindow(P);
  354.   if (nil <> W) then
  355.   begin
  356.     while W.Parent <> nil do
  357.       W := W.Parent;
  358.     Result := W.Name;
  359.   end
  360.   else
  361.   begin
  362.     Result := '';
  363.   end;
  364. end;
  366. {------------------------------------------------------------------------------}
  367. {邮箱监测}
  368. function CheckPOP3Thread(Info: Pointer): Integer; stdcall;
  369. begin
  370.   LastMailCount := -1;
  371.   CurrentMailCount := -1;
  372.   while True do
  373.   begin
  374.     if RealMessengerX.ClientPOP3.Host <> '' then
  375.     begin
  376.       try
  377.         try
  378.           if RealMessengerX.ClientPOP3.Connected then RealMessengerX.ClientPOP3.Disconnect;
  379.           RealMessengerX.ClientPOP3.Connect();
  380.           LastMailCount := CurrentMailCount;
  381.           CurrentMailCount := RealMessengerX.ClientPOP3.CheckMessages;
  382.           RealMessengerX.LblMailCount.Caption := IntToStr(CurrentMailCount) + ' 封电子邮件';
  383.         except
  384.           LastMailCount := -1;
  385.           CurrentMailCount := -1;
  386.           RealMessengerX.LblMailCount.Caption := '未能连接至POP3服务器';
  387.         end;
  388.       finally
  389.         RealMessengerX.ClientPOP3.Disconnect;
  390.       end;
  391.     end
  392.     else
  393.     begin
  394.       RealMessengerX.LblMailCount.Caption := '点击设置您的邮箱';
  395.     end;
  396.     Sleep(60000);
  397.   end;
  398.   Result := 0;
  399. end;
  401. {------------------------------------------------------------------------------}
  402. {
  403. 功能：设置窗口样式（无标题栏，有边框）
  404. }
  405. {------------------------------------------------------------------------------}
  406. procedure TRealMessengerX.WMDEVICECHANGE(var msgx: Tmessage);
  407. const
  408.   DBT_DEVICEARRIVAL = $8000;
  409.   DBT_DEVICEREMOVECOMPLETE = $8004;
  410. begin
  411.   inherited;
  412.   if Me = nil then exit;
  413.   TestVideoDevice();
  414.   ChangeMyState(Me.State);
  415. end;
  417. {------------------------------------------------------------------------------}
  418. procedure TRealMessengerX.WMMOVE(var Msg: Tmessage);
  419. begin
  420. //
  421. end;
  423. {------------------------------------------------------------------------------}
  424. procedure TRealMessengerX.TestAudioDevice();
  425. begin
  426.   try
  427.     if Device.DeviceCount > 0 then
  428.       HaveAudioDevice := True
  429.     else
  430.       HaveAudioDevice := False;
  431.   except
  432.     HaveAudioDevice := False;
  433.   end;
  434. end;
  436. {------------------------------------------------------------------------------}
  437. procedure TRealMessengerX.TestVideoDevice();
  438. var
  439.   SysDev: TSysDevEnum;
  440. begin
  441.   SysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  442.   if SysDev.CountFilters > 0 then
  443.     HaveVideoDevice := True
  444.   else
  445.     HaveVideoDevice := False;
  446.   SysDev.Free;
  447. end;
  449. {------------------------------------------------------------------------------}
  450. procedure TRealMessengerX.ActiveFormCreate(Sender: TObject);
  451. var
  452.   TempReg: TRegistry;
  453.   lgtick1, lgtick2: Int64;
  454. begin
  456.   queryperformancefrequency(performancefrequency_s);
  457.   performancefrequency_ms := performancefrequency_s / 1000;
  459.   //DoubleBuffered:=True;
  460.   try
  461.     InitCompressor;
  462.   finally
  463.     UnInitCompressor;
  464.   end;
  466.   MySockets := Classes.TThreadList.Create;
  467.   ReceivedMessages := Classes.TThreadList.Create;
  468.   MsgReturnCheck := Classes.TThreadList.Create;
  469.   Branchs := Classes.TThreadList.Create;
  470.   Employees := Classes.TThreadList.Create;
  471.   TransmitFiles := Classes.TThreadList.Create;
  472.   AudioHandShakes := Classes.TThreadList.Create;
  473.   VideoHandShakes := Classes.TThreadList.Create;
  475.   ChatingFormList := TList.Create;
  476.   MsgFormList := TList.Create;
  478.   MsgAlertQueue := TList.Create();
  480.   if ApplicationPath = '' then
  481.   begin
  482.     ApplicationPath := ExtractFilePath(Application.ExeName);
  483.     ResPath := ApplicationPath;
  484.     SoundPath := ApplicationPath + 'Sound';
  485.     CachePath := ApplicationPath + 'Cache';
  486.     HistoryPath := ApplicationPath + 'History';
  487.     PicPath := ApplicationPath + 'Pic';
  488.   end;
  490.   ImgListMain := ImglstTreeIcons;
  491.   TVMain := TrevUserList;
  493.   MACNO := GetNetBIOSAddress;
  494.   CoolTrayIcon.Hint := Application.Title + ' -- 未登录';
  495.   Caption := Application.Title;
  497.   TestAudioDevice();
  498.   TestVideoDevice();
  500.   TempReg := TRegistry.Create;
  501.   try
  502.     TempReg.RootKey := HKEY_LOCAL_MACHINE;
  503.     if TempReg.OpenKey(AppKey + 'FormStore', True) then
  504.     begin
  505.       Width := 218;
  506.       Height := Screen.WorkAreaHeight - (Screen.WorkAreaHeight div 3);
  507.       Left := Screen.WorkAreaWidth - 218;
  508.       top := (Screen.WorkAreaHeight - Height) div 2;
  509.       if trim(TempReg.ReadString('Left')) <> '' then Left := StrToInt(TempReg.ReadString('Left'));
  510.       if trim(TempReg.ReadString('Top')) <> '' then top := StrToInt(TempReg.ReadString('Top'));
  511.       if trim(TempReg.ReadString('Width')) <> '' then Width := StrToInt(TempReg.ReadString('Width'));
  512.       if trim(TempReg.ReadString('Height')) <> '' then Height := StrToInt(TempReg.ReadString('Height'));
  513.     end;
  515.     if TempReg.OpenKey(AppKey + 'Login', True) then
  516.     begin
  517.       LoginName := TempReg.ReadString('UserName');
  518.       Password := DESryStrHex(TempReg.ReadString('Password'), DESKEY);
  520.       if trim(TempReg.ReadString('LoginState')) = '' then TempReg.WriteString('LoginState', '联机');
  521.       LoginState := TempReg.ReadString('LoginState');
  523.       HostName := TempReg.ReadString('HostName');
  524.       HostToIP(HostName, HostIP);
  526.       if trim(TempReg.ReadString('ProxyCategory')) = '' then TempReg.WriteString('ProxyCategory', '0');
  527.       ProxyCategory := TProxyCategory(StrToInt(TempReg.ReadString('ProxyCategory')));
  529.       ProxyAddress := TempReg.ReadString('ProxyAddress');
  530.       if TempReg.ReadString('ProxyPort') = '' then TempReg.WriteString('ProxyPort', '1080');
  531.       ProxyPort := StrToInt(TempReg.ReadString('ProxyPort'));
  532.       ProxyUsername := TempReg.ReadString('ProxyUsername');
  533.       ProxyPassword := TempReg.ReadString('ProxyPassword');
  534.       if ProxyAddress <> '' then HostToIP(ProxyAddress, ProxyAddress);
  536.       if TempReg.ReadString('ServerPort') = '' then TempReg.WriteString('ServerPort', '0');
  537.       ServerPort := StrToInt(TempReg.ReadString('ServerPort'));
  539.       if TempReg.ReadString('MsgSound') = '' then TempReg.WriteString('MsgSound', SoundPath + 'Type.wav');
  540.       MsgSound := TempReg.ReadString('MsgSound');
  542.       if TempReg.ReadString('DontPlaySound') = '' then TempReg.WriteString('DontPlaySound', '0');
  543.       DontPlaySound := Boolean(StrToInt(TempReg.ReadString('DontPlaySound')));
  545.       if TempReg.ReadString('AutoConnectInterval') = '' then TempReg.WriteString('AutoConnectInterval', '180');
  546.       AutoConnectInterval := StrToInt(TempReg.ReadString('AutoConnectInterval'));
  548.       if TempReg.ReadString('DontAutoConnect') = '' then TempReg.WriteString('DontAutoConnect', '0');
  549.       DontAutoConnect := Boolean(StrToInt(TempReg.ReadString('DontAutoConnect')));
  551.       if (TempReg.ReadString('SavePass') = '1') and (LoginName <> '') and (HostName <> '') then
  552.       begin
  553.         GetInit();
  555.         SendIdentity();
  556.       end
  557.       else
  558.       begin
  559.         Login();
  560.       end;
  561.     end;
  562.   finally
  563.     TempReg.Free;
  564.   end;
  565. end;
  567. {------------------------------------------------------------------------------}
  568. procedure TRealMessengerX.GetListViewData(TV: TbsSkinTreeView; ViewStyle: TViewStyle = vsTree; IsForSelForm: Boolean = False);
  569. var
  570.   iLoop, jLoop, kLoop: Integer;
  571.   BranchPointer, TmpBranch: PBranch;
  572.   EmployeePointer: PEmployee;
  573.   TempReg: TRegistry;
  574.   Keys, Values: TStrings;
  575.   GroupNode: TTreeNode;
  576.   TempEmployees, TempBranchs: TThreadList;
  577. begin
  578.   OnlineNode := nil;
  579.   OfflineNode := nil;
  581.   if IsForSelForm then
  582.   begin
  583.     TempEmployees := TThreadList.Create;
  584.     TempBranchs := TThreadList.Create;
  586.     with Employees.LockList do
  587.     try
  588.       for iLoop := 0 to Count - 1 do
  589.       begin
  590.         GetMem(EmployeePointer, SizeOf(Employee));
  591.         CopyMemory(EmployeePointer, Items[iLoop], SizeOf(Employee));
  592.         TempEmployees.Add(EmployeePointer);
  593.       end;
  594.     finally
  595.       Employees.UnlockList;
  596.     end;
  598.     with Branchs.LockList do
  599.     try
  600.       for iLoop := 0 to Count - 1 do
  601.       begin
  602.         GetMem(BranchPointer, SizeOf(Employee));
  603.         CopyMemory(BranchPointer, Items[iLoop], SizeOf(Branch));
  604.         TempBranchs.Add(BranchPointer);
  605.       end;
  606.     finally
  607.       Branchs.UnlockList;
  608.     end;
  609.   end
  610.   else
  611.   begin
  612.     TempEmployees := Employees;
  613.     TempBranchs := Branchs;
  614.   end;
  616.   try
  617.     TV.Items.Clear;
  618.     if ViewStyle = vsTree then {显示树型方式}
  619.     begin
  620.       TV.ShowButtons := True;
  621.       TV.ShowLines := True;
  623.       with TempBranchs.LockList do
  624.       try
  626.         for iLoop := 0 to Count - 1 do {添加顶层部门列表}
  627.         begin
  628.           BranchPointer := Items[iLoop];
  629.           BranchPointer.Node := TV.Items.AddChildObject(nil, BranchPointer.Name, BranchPointer);
  630.           BranchPointer.Node.StateIndex := 1 {1表示为部门};
  631.         end; //for
  633.         for iLoop := 0 to Count - 1 do {添加子部门列表}
  634.         begin
  635.           BranchPointer := Items[iLoop];
  636.           for jLoop := 0 to Count - 1 do
  637.           begin
  638.             TmpBranch := Items[jLoop];
  639.             if BranchPointer.ParentID = TmpBranch.ID then
  640.             begin
  641.               BranchPointer.Node.MoveTo(TmpBranch.Node, naAddChild);
  642.               TmpBranch.Node.Expanded := False;
  643.               break;
  644.             end;
  645.           end;
  646.         end;
  648.       finally
  649.         TempBranchs.UnlockList;
  650.       end;
  652.       with TempEmployees.LockList do
  653.       try
  654.         for iLoop := Count - 1 downto 0 do {添加用户列表}
  655.         begin
  656.           EmployeePointer := Items[iLoop];
  657.           with TempBranchs.LockList do
  658.           try
  659.             for jLoop := 0 to Count - 1 do
  660.             begin
  661.               if (PBranch(Items[jLoop])^.ID = EmployeePointer.BranchID) then
  662.               begin
  663.                 EmployeePointer.Node := TV.Items.AddChildObjectFirst(PBranch(Items[jLoop])^.Node, EmployeePointer.Name, EmployeePointer);
  664.                 EmployeePointer.Node.StateIndex := 2 {2表示为用户};
  665.                 UpdateListViewStates(TV, EmployeePointer.Node); {更新用户状态}
  666.                 break;
  667.               end;
  668.             end; //for
  669.           finally
  670.             TempBranchs.UnlockList;
  671.           end;
  672.         end; //for
  673.       finally
  674.         TempEmployees.UnlockList;
  675.       end;
  677.       if not IsForSelForm then Me.Node.MakeVisible; {展开当前户名所在的节点}
  678.     end;
  680.     if ViewStyle = vsOnlineOffline then
  681.     begin
  682.       TV.ShowButtons := False;
  683.       TV.ShowLines := False;
  685.       OnlineNode := TV.Items.AddChild(nil, '联机');
  686.       OnlineNode.StateIndex := -1;
  688.       OfflineNode := TV.Items.AddChild(nil, '没有联机');
  689.       OfflineNode.StateIndex := -1;
  691.       with TempEmployees.LockList do
  692.       try
  693.         for iLoop := 0 to Count - 1 do
  694.         begin
  695.           EmployeePointer := Items[iLoop];
  696.           EmployeePointer.Node := TV.Items.AddChildObject(OfflineNode, EmployeePointer.Name, EmployeePointer);
  697.           EmployeePointer.Node.StateIndex := 2;
  698.           UpdateListViewStates(TV, EmployeePointer.Node)
  699.         end;
  700.       finally
  701.         TempEmployees.UnlockList;
  702.       end;
  704.       OfflineNode.Expanded := True;
  705.     end;
  707.     if ViewStyle = vsGroup then {显示组方式}
  708.     begin
  709.       TV.ShowButtons := False;
  710.       TV.ShowLines := False;
  712.       with TempEmployees.LockList do
  713.       try
  714.         for iLoop := 0 to Count - 1 do
  715.         begin
  716.           EmployeePointer := Items[iLoop];
  717.           EmployeePointer.Node := nil;
  718.         end;
  719.       finally
  720.         TempEmployees.UnlockList;
  721.       end;
  724.       TempReg := TRegistry.Create;
  725.       try
  726.         TempReg.RootKey := HKEY_LOCAL_MACHINE;
  727.         if not TempReg.KeyExists(AppKey + '' + LoginName + 'Group') then
  728.         begin
  729.           if TempReg.OpenKey(AppKey + '' + LoginName + 'Group本部门', True) then
  730.           begin
  731.             with TempEmployees.LockList do
  732.             try
  733.               for iLoop := 0 to Count - 1 do
  734.               begin
  735.                 EmployeePointer := Items[iLoop];
  736.                 if EmployeePointer.BranchID = Me.BranchID then TempReg.WriteString(IntToStr(EmployeePointer.ID), EmployeePointer.LoginName);
  737.               end;
  738.             finally
  739.               TempEmployees.UnlockList;
  740.             end;
  741.           end;
  742.         end;
  744.         if TempReg.OpenKey(AppKey + '' + LoginName + 'Group', True) then
  745.         begin
  746.           Keys := TStringList.Create;
  747.           TempReg.GetKeyNames(Keys);
  748.           for iLoop := 0 to Keys.Count - 1 do
  749.           begin
  750.             GroupNode := TV.Items.AddChild(nil, Keys.Strings[iLoop]);
  751.             GroupNode.StateIndex := -1; {-1表示自定义组方式}
  752.             if TempReg.OpenKey(AppKey + '' + LoginName + 'Group' + Keys.Strings[iLoop], True) then
  753.             begin
  754.               Values := TStringList.Create;
  755.               TempReg.GetValueNames(Values);
  756.               for jLoop := 0 to Values.Count - 1 do
  757.               begin
  758.                 with TempEmployees.LockList do
  759.                 try
  760.                   for kLoop := 0 to Count - 1 do
  761.                   begin
  762.                     EmployeePointer := Items[kLoop];
  763.                     if EmployeePointer.ID = StrToInt(Values.Strings[jLoop]) then
  764.                     begin
  765.                       EmployeePointer.Node := TV.Items.AddChildObject(GroupNode, EmployeePointer.Name, EmployeePointer);
  766.                       EmployeePointer.Node.StateIndex := 2 {2表示为用户};
  767.                       UpdateListViewStates(TV, EmployeePointer.Node); {更新用户状态}
  768.                     end;
  769.                   end;
  770.                 finally
  771.                   TempEmployees.UnlockList
  772.                 end;
  773.               end; //for
  774.               Values.Free;
  775.             end; //if
  776.             GroupNode.Expanded := True;
  777.           end; //for
  778.           Keys.Free;
  779.         end; //if
  780.       finally
  781.         TempReg.Free;
  782.       end;
  783.     end;
  785.     if TV.Items.GetFirstNode <> nil then TV.Items.GetFirstNode.Selected := True;
  786.     if TV.Items.GetFirstNode <> nil then TV.Items.GetFirstNode.Selected := False;
  788.   finally
  789.     if IsForSelForm then
  790.     begin
  791.       TempEmployees.Clear;
  792.       TempEmployees.Free;
  793.       TempBranchs.Clear;
  794.       TempBranchs.Free;
  795.     end;
  796.   end;
  797. end;
  799. {------------------------------------------------------------------------------}
  800. {更改当前用户的显示状态}
  801. procedure TRealMessengerX.ChangeLblMyStateCaption();
  802. var
  803.   iLoop, jLoop, GBBytes, IconIndex: Integer;
  804.   ShowName: string;
  805. begin
  806.   if Me <> nil then
  807.   begin
  808.     LblMyState.Caption := Me.Name + '（' + Me.State + '）';
  809.     CoolTrayIcon.Hint := Application.Title + ' -- ' + Me.Name + '（' + Me.State + '）';
  811.     IconIndex := 2;
  812.     NS8.Checked := True;
  813.     MOther.Checked := True;
  815.     if Me.State = '断开' then
  816.     begin
  817.       IconIndex := 0;
  818.       NS8.Checked := False;
  819.       MOther.Checked := False;
  820.     end;
  822.     if Me.State = '显示为脱机' then
  823.     begin
  824.       IconIndex := 4;
  825.       NS9.Checked := True;
  826.       MOffline.Checked := True;
  827.     end;
  829.     if Me.State = '联机' then
  830.     begin
  831.       IconIndex := 1;
  832.       NS1.Checked := True;
  833.       MOnline.Checked := True;
  834.     end;
  836.     if Me.State = '忙碌' then
  837.     begin
  838.       IconIndex := 3;
  839.       NS2.Checked := True;
  840.       MBusy.Checked := True;
  841.     end;
  843.     if Me.State = '马上回来' then
  844.     begin
  845.       IconIndex := 2;
  846.       NS3.Checked := True;
  847.       MWillBack.Checked := True;
  848.     end;
  850.     if Me.State = '离开' then
  851.     begin
  852.       IconIndex := 2;
  853.       NS4.Checked := True;
  854.       MLeave.Checked := True;
  855.     end;
  857.     if Me.State = '接听电话' then
  858.     begin
  859.       IconIndex := 3;
  860.       NS5.Checked := True;
  861.       MPhone.Checked := True;
  862.     end;
  864.     if Me.State = '外出就餐' then
  865.     begin
  866.       IconIndex := 2;
  867.       NS6.Checked := True;
  868.       MRepast.Checked := True;
  869.     end;
  871.     if Me.State = '参加会议' then
  872.     begin
  873.       IconIndex := 3;
  874.       NS7.Checked := True;
  875.       NMeeting.Checked := True;
  876.     end;
  877.   end
  878.   else
  879.   begin
  880.     LblMyState.Caption := '未登录';
  881.     CoolTrayIcon.Hint := Application.Title + ' -- 未登录';
  882.     IconIndex := 0;
  883.   end;
  885.   if not CoolTrayIcon.CycleIcons then ImgLstTrayIcon.GetIcon(IconIndex, CoolTrayIcon.Icon);
  886.   if Me = nil then exit;
  888.   iLoop := 1;
  889.   while (LblMyState.Canvas.TextWidth(LblMyState.Caption) > LblMyState.Width) and (iLoop < Length(Me.Name)) do
  890.   begin
  891.     ShowName := Copy(Me.Name, 1, Length(Me.Name) - iLoop);
  892.     GBBytes := 0;
  893.     for jLoop := 1 to Length(ShowName) do
  894.     begin
  895.       if Ord(ShowName[jLoop]) > 128 then Inc(GBBytes);
  896.     end;
  897.     if GBBytes mod 2 <> 0 then ShowName := Copy(ShowName, 1, Length(ShowName) - 1);
  898.     LblMyState.Caption := ShowName + ' ...（' + Me.State + '）';
  899.     Inc(iLoop);
  900.   end;
  901. end;
  903. {------------------------------------------------------------------------------}
  904. procedure TRealMessengerX.UpdateMyState();
  905. begin
  906.   ChangeLblMyStateCaption();
  907. end;
  909. {------------------------------------------------------------------------------}
  910. procedure TRealMessengerX.UpdateListViewStates(TV: TbsSkinTreeView; Node: TTreeNode);
  911. var
  912.   BaseImageIndex: Integer;
  913.   Employee: PEmployee;
  914. begin
  915.   try
  916.     if Node = nil then exit;
  917.     Employee := Node.Data;
  918.     BaseImageIndex := 6;
  919.     Employee.Node.Text := '';
  920.     Employee.Node.ImageIndex := BaseImageIndex;
  922.     if (AnsiSameText(Employee.State, '显示为脱机') or AnsiSameStr(Employee.State, '断开')) then
  923.     begin
  924.       Employee.Node.ImageIndex := BaseImageIndex;
  925.       Employee.Node.Text := Employee.Name;
  926.       if (Employee.Node.Parent <> nil) and (Employee.Node.Parent = OnlineNode) then
  927.       begin
  928.         try
  929.           Employee.Node.MoveTo(OfflineNode, naAddChildFirst);
  930.           if OfflineNode.Count > 0 then OfflineNode.Expanded := True;
  931.         except
  932.         end;
  933.       end;
  934.       exit;
  935.     end;
  937.     if (Employee.Node.Parent = OfflineNode) then
  938.     begin
  939.       try
  940.         Employee.Node.MoveTo(OnlineNode, naAddChildFirst);
  941.         if OnlineNode.Count > 0 then OnlineNode.Expanded := True;
  942.       except
  943.       end;
  944.     end;
  946.     if AnsiSameText(Employee.State, '联机') then
  947.     begin
  948.       Employee.Node.ImageIndex := BaseImageIndex + 1;
  949.       Employee.Node.Text := Employee.Name;
  950.       exit;
  951.     end;
  953.     if AnsiSameText(Employee.State, '忙碌') then
  954.     begin
  955.       Employee.Node.ImageIndex := BaseImageIndex + 3;
  956.       Employee.Node.Text := Employee.Name + '（' + Employee.State + '）';
  957.       exit;
  958.     end;
  960.     if AnsiSameText(Employee.State, '马上回来') then
  961.     begin
  962.       Employee.Node.ImageIndex := BaseImageIndex + 2;
  963.       Employee.Node.Text := Employee.Name + '（' + Employee.State + '）';
  964.       exit;
  965.     end;
  967.     if AnsiSameText(Employee.State, '离开') then
  968.     begin
  969.       Employee.Node.ImageIndex := BaseImageIndex + 2;
  970.       Employee.Node.Text := Employee.Name + '（' + Employee.State + '）';
  971.       exit;
  972.     end;
  974.     if AnsiSameText(Employee.State, '接听电话') then
  975.     begin
  976.       Employee.Node.ImageIndex := BaseImageIndex + 3;
  977.       Employee.Node.Text := Employee.Name + '（' + Employee.State + '）';
  978.       exit;
  979.     end;
  981.     if AnsiSameText(Employee.State, '外出就餐') then
  982.     begin
  983.       Employee.Node.ImageIndex := BaseImageIndex + 2;
  984.       Employee.Node.Text := Employee.Name + '（' + Employee.State + '）';
  985.       exit;
  986.     end;
  988.     if AnsiSameText(Employee.State, '参加会议') then
  989.     begin
  990.       Employee.Node.ImageIndex := BaseImageIndex + 3;
  991.       Employee.Node.Text := Employee.Name + '（' + Employee.State + '）';
  992.       exit;
  993.     end;
  995.     Employee.Node.ImageIndex := BaseImageIndex + 2;
  996.     Employee.Node.Text := Employee.Name + '（' + Employee.State + '）';
  997.   finally
  998.     //TV.Refresh
  999.   end;
  1000. end;
  1002. {------------------------------------------------------------------------------}
  1003. procedure TRealMessengerX.TrevUserListGetImageIndex(Sender: TObject;
  1004.   Node: TTreeNode);
  1005. begin
  1006.   if Node.StateIndex = -1 then
  1007.   begin
  1008.     if Node.Expanded then
  1009.       Node.ImageIndex := 4
  1010.     else
  1011.       Node.ImageIndex := 5;
  1012.   end;
  1014.   if Node.StateIndex = 0 then
  1015.   begin
  1016.     if Node.Expanded then
  1017.       Node.ImageIndex := 1
  1018.     else
  1019.       Node.ImageIndex := 0;
  1020.   end;
  1022.   if Node.StateIndex = 1 then
  1023.   begin
  1024.     if Node.Expanded then
  1025.       Node.ImageIndex := 3
  1026.     else
  1027.       Node.ImageIndex := 2;
  1028.   end;
  1030.   Node.SelectedIndex := Node.ImageIndex;
  1031. end;
  1033. {------------------------------------------------------------------------------}
  1034. procedure TRealMessengerX.TrevUserListCustomDrawItem(
  1035.   Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
  1036.   var DefaultDraw: Boolean);
  1037. begin
  1038.   DefaultDraw := True;
  1039.   if Node.Selected then
  1040.   begin
  1041.     TrevUserList.Canvas.Font.Color := clWhite;
  1042.   end
  1043.   else
  1044.   begin
  1045.     if Node.StateIndex = 2 then
  1046.     begin
  1047.       if (Node.ImageIndex = 6) or (Node.ImageIndex = 10) then
  1048.         TrevUserList.Canvas.Font.Color := clRed
  1049.       else
  1050.         TrevUserList.Canvas.Font.Color := clGreen;
  1051.     end
  1052.     else if Node.StateIndex = -1 then
  1053.     begin
  1054.       TrevUserList.Canvas.Font.Color := $00934A46;
  1055.       TrevUserList.Canvas.Font.Style := [fsBold];
  1056.     end
  1057.     else
  1058.       TrevUserList.Canvas.Font.Color := clBlack;
  1059.   end;
  1061.   TrevUserList.Canvas.Textout(Node.DisplayRect(True).Left + 2, Node.DisplayRect(True).top + 2, Node.Text);
  1062. end;
  1064. {------------------------------------------------------------------------------}
  1065. procedure TRealMessengerX.Login();
  1066. var
  1067.   LoginForm: TLoginForm;
  1068.   TempReg: TRegistry;
  1069. begin
  1070.   LoginForm := TLoginForm.Create(Application);
  1071.   try
  1072.     TempReg := TRegistry.Create;
  1073.     try
  1074.       TempReg.RootKey := HKEY_LOCAL_MACHINE;
  1075.       if TempReg.OpenKey(AppKey + 'Login', True) then
  1076.       begin
  1077.         LoginForm.EDUserName.Text := TempReg.ReadString('UserName');
  1078.         if LoginForm.ShowModal <> mrOK then exit;
  1079.         Show;
  1080.         TempReg.WriteString('UserName', trim(LoginForm.EDUserName.Text));
  1081.         if LoginForm.CBSavePass.Checked then
  1082.         begin
  1083.           TempReg.WriteString('SavePass', '1');
  1084.           TempReg.WriteString('Password', EncryStrHex(trim(LoginForm.EDPassword.Text), DESKEY));
  1085.           TempReg.WriteString('LoginState', trim(LoginForm.CBState.Text));
  1086.         end
  1087.         else
  1088.         begin
  1089.           TempReg.WriteString('SavePass', '0');
  1090.           TempReg.WriteString('Password', '');
  1091.           TempReg.WriteString('LoginState', '联机');
  1092.         end;
  1093.         LoginName := trim(LoginForm.EDUserName.Text);
  1094.         Password := trim(LoginForm.EDPassword.Text);
  1095.         LoginState := trim(LoginForm.CBState.Text);
  1096.       end;
  1097.     finally
  1098.       TempReg.Free;
  1099.     end;
  1100.     GetInit();
  1101.     SendIdentity();
  1102.   finally
  1103.     LoginForm.Free;
  1104.   end;
  1105. end;
  1107. {------------------------------------------------------------------------------}
  1108. {点击了登录菜单}
  1109. procedure TRealMessengerX.MConnectClick(Sender: TObject);
  1110. begin
  1111.   if MConnect.Caption = '取消登录(&I)' then
  1112.   begin
  1113.     ClientLogout();
  1114.   end
  1115.   else
  1116.   begin
  1117.     TimerAutoConnect.Enabled := False;
  1118.     Login();
  1119.   end;
  1120. end;
  1122. {------------------------------------------------------------------------------}
  1123. procedure TRealMessengerX.ClientLogin();
  1124. var
  1125.   ThreadId: DWORD;
  1126. begin
  1127.   if CheckPOP3ThreadHandle = 0 then CheckPOP3ThreadHandle := CreateThread(nil, 0, @CheckPOP3Thread, nil, 0, ThreadId);
  1128.   LblMailCount.Enabled := True;
  1130.   TimerAutoConnect.Enabled := False;
  1131.   TimerLoging.Enabled := False;
  1133.   PBLogin.Visible := False;
  1134.   LblLoging.Visible := False;
  1135.   LblCancelLogin.Visible := False;
  1137.   TrevUserList.Show;
  1139.   if MAutoLeave.Checked or MAutoBusy.Checked then
  1140.   begin
  1141.     STimer.Enabled := True;
  1142.     Snoop := 0;
  1143.   end;
  1145.   ConnectedTicket := GetTickCount;
  1146.   MConnect.Enabled := False;
  1147.   MConnect.Caption := '登录(&I)';
  1148.   MConnectSet.Enabled := True;
  1149.   MDisconnect.Enabled := True;
  1150.   MMyState.Enabled := True;
  1151.   MSendMsg.Enabled := True;
  1152.   MSendFile.Enabled := True;
  1153.   MSendVoice.Enabled := True;
  1154.   MSendVideo.Enabled := True;
  1155.   MShowHistory.Enabled := True;
  1156.   //MChangeNameAndPassword.Enabled :=True;
  1158.   NR1.Enabled := True;
  1159.   NR2.Enabled := True;
  1160.   NR3.Enabled := True;
  1161.   NR4.Enabled := True;
  1162.   NR5.Enabled := True;
  1164.   HartTimer.Enabled := True;
  1165.   KeepP2PSessionTimer.Enabled := True;
  1166.   LastReturnHartTick := GetTickCount;
  1168.   GetListViewData(TrevUserList, vsTree);
  1169.   if Me <> nil then
  1170.   begin
  1171.     UpdateMyState;
  1172.     CoolTrayIcon.ShowBalloonHint('登录成功', '您好：' + Me.Name + #13 + '您已登录至 ' + Application.Title + ' 服务器！', bitInfo, 10);
  1173.   end;
  1174. end;
  1177. {------------------------------------------------------------------------------}
  1178. procedure TRealMessengerX.ClientLogout();
  1179. var
  1180.   iLoop: Integer;
  1181.   EmployeePointer: PEmployee;
  1182.   ChatingForm: TChatingForm;
  1183.   AudioHandShake: TAudioHandShake;
  1184.   VideoHandShake: TVideoHandShake;
  1185.   TransmitFile: TTransmitFile;
  1186.   MySocket: TMySocket;
  1187. begin
  1188.   if ClientTCP.Connected then
  1189.   begin
  1190.     ClientTCP.OnDisconnected := nil;
  1191.     ClientTCP.Disconnect;
  1192.   end;
  1193.   if CheckPOP3ThreadHandle <> 0 then TerminateThread(CheckPOP3ThreadHandle, 4);
  1194.   CheckPOP3ThreadHandle := 0;
  1195.   LblMailCount.Caption := '0 封电子邮件';
  1196.   LblMailCount.Enabled := False;
  1198.   TimerAutoConnect.Enabled := False;
  1199.   TimerLoging.Enabled := False;
  1200.   KeepP2PSessionTimer.Enabled := False;
  1202.   PBLogin.Visible := False;
  1203.   LblLoging.Visible := False;
  1204.   LblCancelLogin.Visible := False;
  1205.   CoolTrayIcon.CycleIcons := False;
  1206.   MsgAlertQueue.Clear;
  1208.   TrevUserList.Hide;
  1210.   STimer.Enabled := False;
  1212.   MConnect.Enabled := True;
  1213.   MConnect.Caption := '登录(&I)';
  1214.   MConnectSet.Enabled := True;
  1215.   MDisconnect.Enabled := False;
  1216.   MMyState.Enabled := False;
  1217.   MSendMsg.Enabled := False;
  1218.   MSendFile.Enabled := False;
  1219.   MSendVoice.Enabled := False;
  1220.   MSendVideo.Enabled := False;
  1221.   MShowHistory.Enabled := False;
  1222.   MChangeNameAndPassword.Enabled := False;
  1223.   NR1.Enabled := False;
  1224.   NR2.Enabled := False;
  1225.   NR3.Enabled := False;
  1226.   NR4.Enabled := False;
  1227.   NR5.Enabled := False;
  1228.   HartTimer.Enabled := False;
  1230.   for iLoop := ChatingFormList.Count - 1 downto 0 do
  1231.   begin
  1232.     ChatingForm := ChatingFormList.Items[iLoop];
  1233.     ChatingFormList.Remove(ChatingForm);
  1234.     try
  1235.       if (ChatingForm is TChatingForm) then ChatingForm.Free;
  1236.     except
  1237.     end;
  1238.   end;
  1240.   with VideoHandShakes.LockList do
  1241.   try
  1242.     for iLoop := Count - 1 downto 0 do
  1243.     begin
  1244.       VideoHandShake := Items[iLoop];
  1245.       VideoHandShake.Free;
  1246.       VideoHandShakes.Remove(VideoHandShake);
  1247.     end;
  1248.   finally
  1249.     VideoHandShakes.UnlockList;
  1250.   end;
  1252.   with AudioHandShakes.LockList do
  1253.   try
  1254.     for iLoop := Count - 1 downto 0 do
  1255.     begin
  1256.       AudioHandShake := Items[iLoop];
  1257.       AudioHandShake.Free;
  1258.       AudioHandShakes.Remove(AudioHandShake);
  1259.     end;
  1260.   finally
  1261.     AudioHandShakes.UnlockList;
  1262.   end;
  1264.   with TransmitFiles.LockList do
  1265.   try
  1266.     for iLoop := Count - 1 downto 0 do
  1267.     begin
  1268.       TransmitFile := Items[iLoop];
  1269.       TransmitFile.Free;
  1270.       TransmitFiles.Remove(TransmitFile);
  1271.     end;
  1272.   finally
  1273.     TransmitFiles.UnlockList;
  1274.   end;
  1276.   with Employees.LockList do
  1277.   try
  1278.     for iLoop := 0 to Count - 1 do
  1279.     begin
  1280.       EmployeePointer := Items[iLoop];
  1281.       EmployeePointer.State := '断开';
  1282.       EmployeePointer.HaveAudioDevice := False;
  1283.       EmployeePointer.HaveVideoDevice := False;
  1284.       UpdateListViewStates(TrevUserList, EmployeePointer.Node); {更新用户状态}
  1285.       FreeMem(EmployeePointer, SizeOf(Employee));
  1286.     end;
  1287.   finally
  1288.     Employees.UnlockList;
  1289.   end;
  1290.   Employees.Clear;
  1291.   with Branchs.LockList do
  1292.   try
  1293.     for iLoop := 0 to Count - 1 do FreeMem(Items[iLoop], SizeOf(Branch));
  1294.   finally
  1295.     Branchs.UnlockList;
  1296.   end;
  1297.   Branchs.Clear;
  1299.   UpdateMyState();
  1300.   TrevUserList.Items.Clear;
  1301.   Me := nil;
  1303.   if not DontAutoConnect then
  1304.   begin
  1305.     TimerAutoConnect.Interval := AutoConnectInterval * 1000;
  1306.     TimerAutoConnect.Enabled := True;
  1307.   end;
  1309.   with MySockets.LockList do
  1310.   try
  1311.     for iLoop := Count - 1 downto 0 do
  1312.     begin
  1313.       try
  1314.         MySocket := Items[iLoop];
  1315.         MySocket.Free;
  1316.         MySocket := nil;
  1317.       except
  1318.       end;
  1319.     end;
  1320.   finally
  1321.     MySockets.UnlockList;
  1322.   end;
  1323. end;
  1325. {------------------------------------------------------------------------------}
  1326. procedure TRealMessengerX.SendIdentity;
  1327. var
  1328.   LoginTime: Integer;
  1329.   CBLogin: TCBLogin;
  1330.   Buffer: array[1..2048] of char;
  1331.   StrHttpProxySend, StrHttpProxyRecive: string;
  1332. begin
  1333.   if ClientTCP.Connected = False then
  1334.   begin
  1335.    //  showmessage(trim(SystemSetForm.EDHostName.Text));
  1336.    // showmessage(SystemSetForm.EDHostName.Text);
  1337.     if inet_addr(PChar(HostIP))=INADDR_NONE then
  1338.       ClientTCP.Host:=HostName
  1339.     else
  1340.       ClientTCP.Host:=HostIP;
  1341.     ClientTCP.Port:=ServerPort;
  1344.     {ClientTCP.Host := trim(SystemSetForm.EDHostName.Text);
  1345.     ClientTCP.Port := StrToInt(SystemSetForm.EDHostName.Text);}
  1348.     try
  1349.       MConnect.Caption := '取消登录(&I)';
  1350.       Gauge.Progress := 0;
  1351.       PBLogin.Visible := True;
  1352.       LblLoging.Caption := '正在连接...';
  1353.       LblLoging.Visible := True;
  1354.       LblCancelLogin.Visible := True;
  1356.       if ProxyCategory <> pcHTTP then
  1357.       begin
  1358.         IdSocksInfo1.Version := TSocksVersion(ProxyCategory);
  1359.         IdSocksInfo1.Host := ProxyAddress;
  1360.         IdSocksInfo1.Port := ProxyPort;
  1361.         if ProxyUsername = '' then
  1362.         begin
  1363.           IdSocksInfo1.Authentication := saNoAuthentication;
  1364.         end
  1365.         else
  1366.         begin
  1367.           IdSocksInfo1.Authentication := saUsernamePassword;
  1368.           IdSocksInfo1.Username := ProxyUsername;
  1369.           IdSocksInfo1.Password := ProxyPassword;
  1370.         end;
  1372.         LoginTime := 0;
  1373.         while LoginTime < 3 do
  1374.         try
  1375.           ClientTCP.Connect(8000);
  1376.           break;
  1377.         except
  1378.           Inc(LoginTime);
  1379.         end;
  1380.       end
  1381.       else
  1382.       begin
  1383.         IdSocksInfo1.Version := svNoSocks;
  1384.         StrHttpProxySend := Format('CONNECT %s:%d HTTP/1.0'#$d#$a#$d#$a + 'Host %s'#$d#$a, [ClientTCP.Host, ClientTCP.Port, ClientTCP.Host]);
  1385.         ClientTCP.Host := ProxyAddress;
  1386.         ClientTCP.Port := ProxyPort;
  1387.         ClientTCP.Connect(8000);
  1388.         ClientTCP.Write(StrHttpProxySend);
  1389.         StrHttpProxyRecive := ClientTCP.ReadLn; //(EOL);
  1390.         ClientTCP.ReadLn;
  1391.         ClientTCP.ReadLn;
  1392.         if Copy(StrHttpProxyRecive, 1, 12) <> 'HTTP/1.0 200' then ClientTCP.Disconnect;
  1393.       end;
  1395.     except
  1396.     end;
  1398.     if not ClientTCP.Connected then
  1399.     begin
  1400.       ClientLogout;
  1401.       CoolTrayIcon.ShowBalloonHint('连接失败', '未能连接至服务器，请检查网络设置！', bitError, 10);
  1402.       exit;
  1403.     end;
  1405.     ClientHandleThread := TClientHandleThread.Create;
  1406.     ClientHandleThread.FreeOnTerminate := True;
  1407.     ClientHandleThread.Resume;
  1408.   end;
  1410.   CBLogin.LoginName := LoginName;
  1411.   CBLogin.Password := Password;
  1412.   CBLogin.State := LoginState;
  1413.   CBLogin.LocalIP := GetHostIP('');
  1414.   CBLogin.LocalPort := ClientTCP.Socket.Binding.Port;
  1415.   CBLogin.HaveAudioDevice := HaveAudioDevice;
  1416.   CBLogin.HaveVideoDevice := HaveVideoDevice;
  1417.   CBLogin.MACNO := MACNO;
  1418.   CBLogin.Version := 40000;
  1419.   Buffer[1] := skLogin;
  1420.   CopyMemory(@Buffer[2], @CBLogin, SizeOf(CBLogin));
  1421.   ClientTCP.Socket.Send(Buffer, SizeOf(CBLogin) + 1);
  1422.   LblMyState.Caption := '正在登录...';
  1423. end;
  1425. {------------------------------------------------------------------------------}
  1426. procedure TRealMessengerX.GetInit();
  1427. var
  1428.   TempReg: TRegistry;
  1429.   ID: string;
  1430. begin
  1431.   ID := LoginName;
  1432.   TempReg := TRegistry.Create;
  1433.   try
  1434.     TempReg.RootKey := HKEY_LOCAL_MACHINE;
  1435.     if TempReg.OpenKey(AppKey + '' + ID + 'Init', True) then
  1436.     begin
  1437.       if trim(TempReg.ReadString('ViewStyle')) = '' then
  1438.         TempReg.WriteString('ViewStyle', 'Tree');
  1439.       if trim(TempReg.ReadString('HiddenState')) = '' then
  1440.         TempReg.WriteString('HiddenState', '0');
  1441.       if trim(TempReg.ReadString('AutoLeave')) = '' then
  1442.         TempReg.WriteString('AutoLeave', '1');
  1443.       if trim(TempReg.ReadString('AutoBusy')) = '' then
  1444.         TempReg.WriteString('AutoBusy', '1');
  1446.       if StrToInt(TempReg.ReadString('AutoLeave')) = 0 then MAutoLeave.Checked := False;
  1447.       if StrToInt(TempReg.ReadString('AutoBusy')) = 0 then MAutoBusy.Checked := False;
  1449.       if TempReg.ReadString('CustomColor') <> '' then
  1450.       begin
  1451.         EndColor := TColor(StrToInt(TempReg.ReadString('CustomColor')));
  1452.         ChangeAllColor(EndColor);
  1453.       end
  1454.       else begin
  1455.         EndColor := TColor(13816530);
  1456.         ChangeAllColor(EndColor);
  1457.       end;
  1459.       if TempReg.ReadString('POP3Server') <> '' then
  1460.       begin
  1461.         ClientPOP3.Host := TempReg.ReadString('POP3Server');
  1462.         ClientPOP3.Port := StrToInt(TempReg.ReadString('POP3Port'));
  1463.         ClientPOP3.Username := TempReg.ReadString('POP3User');
  1464.         ClientPOP3.Password := DESryStrHex(TempReg.ReadString('POP3Pass'), DESKEY);
  1465.       end
  1466.       else
  1467.       begin
  1468.         LblMailCount.Caption := '点击设置您的邮箱';
  1469.       end;
  1471.     end;
  1472.   finally
  1473.     TempReg.Free;
  1474.   end;
  1475. end;
  1477. {------------------------------------------------------------------------------}
  1478. {选择了树型方式查看部门及用户列表}
  1479. procedure TRealMessengerX.MTreeClick(Sender: TObject);
  1480. var
  1481.   TempReg: TRegistry;
  1482. begin
  1483.   TempReg := TRegistry.Create;
  1484.   try
  1485.     TempReg.RootKey := HKEY_LOCAL_MACHINE;
  1486.     if TempReg.OpenKey(AppKey + '' + LoginName + 'Init', True) then TempReg.WriteString('ViewStyle', 'Tree');
  1487.   finally
  1488.     TempReg.Free;
  1489.   end;
  1490.   GetListViewData(TrevUserList, vsTree);
  1491. end;
  1493. {------------------------------------------------------------------------------}
  1494. {选择了联机/脱机方式查看部门及用户列表}
  1495. procedure TRealMessengerX.MOnOrOffClick(Sender: TObject);
  1496. var
  1497.   TempReg: TRegistry;
  1498. begin
  1499.   TempReg := TRegistry.Create;
  1500.   try
  1501.     TempReg.RootKey := HKEY_LOCAL_MACHINE;
  1502.     if TempReg.OpenKey(AppKey + '' + LoginName + 'Init', True) then TempReg.WriteString('ViewStyle', 'OnOrOff');
  1503.   finally
  1504.     TempReg.Free;
  1505.   end;
  1506.   GetListViewData(TrevUserList, vsOnlineOffline);
  1507. end;
  1509. {------------------------------------------------------------------------------}
  1510. procedure TRealMessengerX.MGroupClick(Sender: TObject);
  1511. var
  1512.   TempReg: TRegistry;
  1513. begin
  1514.   TempReg := TRegistry.Create;
  1515.   try
  1516.     TempReg.RootKey := HKEY_LOCAL_MACHINE;
  1517.     if TempReg.OpenKey(AppKey + '' + LoginName + 'Init', True) then TempReg.WriteString('ViewStyle', 'Group');
  1518.   finally
  1519.     TempReg.Free;
  1520.   end;
  1521.   GetListViewData(TrevUserList, vsGroup);
  1522. end;
  1524. {------------------------------------------------------------------------------}
  1525. procedure TRealMessengerX.ChangeMyState(State: string; IsAutoState: Boolean = False);
  1526. var
  1527.   CBStateChanged: TCBStateChanged;
  1528.   Buffer: array[1..2048] of char;
  1529. begin
  1530.   CBStateChanged.ID := Me.ID;
  1531.   CBStateChanged.State := State;
  1532.   CBStateChanged.HaveAudioDevice := HaveAudioDevice;
  1533.   CBStateChanged.HaveVideoDevice := HaveVideoDevice;
  1534.   CBStateChanged.IsAutoState := IsAutoState;
  1536.   Buffer[1] := skStateChanged;
  1537.   CopyMemory(@Buffer[2], @CBStateChanged, SizeOf(CBStateChanged));
  1538.   try
  1539.     ClientTCP.WriteBuffer(Buffer, SizeOf(CBStateChanged) + 1, True);
  1540.   except
  1541.     MessageBox(Handle, '更改状态失败！', '错误', MB_ICONERROR);
  1542.     ClientLogout;
  1543.   end;
  1544. end;
  1546. {------------------------------------------------------------------------------}
  1547. procedure TRealMessengerX.MOfflineClick(Sender: TObject);
  1548. begin
  1549.   ChangeMyState(Copy(trim((Sender as TMenuItem).Caption), 1, Length(trim((Sender as TMenuItem).Caption)) - 4));
  1550. end;
  1552. {------------------------------------------------------------------------------}
  1553. {用户要自己输入状态值}
  1554. procedure TRealMessengerX.MOtherClick(Sender: TObject);
  1555. var
  1556.   InputState: string;
  1557. begin
  1558.   InputState := trim(ShowMyInputBox('输入', '您要将当前的状态更改为：', '', 20));
  1559.   if Length(InputState) > 0 then
  1560.   begin
  1561.     ChangeMyState(InputState);
  1562.   end;
  1563. end;
  1565. {------------------------------------------------------------------------------}
  1566. procedure TRealMessengerX.FlashTray(ChatingForm: TChatingForm);
  1567. begin
  1568.   if ChatingForm.Visible then exit;
  1569.   if ChatingForm.Pushed then exit;
  1570.   ChatingForm.Pushed := True;
  1571.   MsgAlertQueue.Add(ChatingForm);
  1572.   CoolTrayIcon.IconList := ImgLstMsgAlert;
  1573.   CoolTrayIcon.CycleIcons := True;
  1574. end;
  1576. {------------------------------------------------------------------------------}
  1577. procedure TRealMessengerX.ShowImage(PHandle: HWND; BitMap: HBitMap; Buf: PByte);
  1578.   procedure SetImage(HBitMap: THandle);
  1579.   begin
  1580.     SendMessage(BitMap, STM_SETIMAGE, IMAGE_BITMAP, Integer(HBitMap));
  1581.   end;
  1582. var
  1583.   pData: Pointer;
  1584.   pDC, MemDC: THandle;
  1585.   HBitMap: THandle;
  1586. begin
  1587.   pDC := GetDC(PHandle);
  1588.   pData := nil;
  1589.   HBitMap := CreateDIBSection(0, A_FOutInfo, DIB_RGB_COLORS, pData, 0, 0);
  1590.   if not Assigned(pData) and (HBitMap = 0) then
  1591.   begin
  1592.     Abort;
  1593.   end;
  1594.   pData := Buf;
  1595.   SetImage(HBitMap);
  1596.   GdiFlush;
  1597.   MemDC := CreateCompatibleDC(pDC);
  1598.   SelectObject(MemDC, HBitMap);
  1599.   BitBlt(pDC, 0, 0, A_FOutInfo.bmiHeader.biWidth, A_FOutInfo.bmiHeader.biHeight,
  1600.     MemDC, 0, 0, SRCCOPY);
  1601.   DeleteDC(MemDC);
  1602. end;
  1604. {------------------------------------------------------------------------------}
  1605. {注销}
  1606. procedure TRealMessengerX.MDisconnectClick(Sender: TObject);
  1607. begin
  1608.   ClientLogout();
  1609. end;
  1611. {------------------------------------------------------------------------------}
  1612. procedure TRealMessengerX.ApplicationEvents1Exception(Sender: TObject;
  1613.   E: Exception);
  1614. begin
  1615.   //ShowMessage(E.Message);
  1616. end;
  1618. {------------------------------------------------------------------------------}
  1619. procedure TRealMessengerX.LblMyStateClick(Sender: TObject);
  1620. var
  1621.   Point: TPoint;
  1622. begin
  1623.   if Me = nil then exit;
  1624.   if AnsiSameText(Me.State, '断开') then exit;
  1625.   Point.X := 0;
  1626.   Point.Y := LblMyState.Height;
  1627.   PpMenuStates.Popup(LblMyState.ClientToScreen(Point).X - 18, LblMyState.ClientToScreen(Point).Y + 2);
  1628. end;
  1630. {------------------------------------------------------------------------------}
  1631. procedure TRealMessengerX.HartTimerTimer(Sender: TObject);
  1632. begin
  1633.   if ClientTCP.Connected = False then exit;
  1634.   try
  1635.     ClientTCP.WriteBuffer(skOnlineCheck, 1, True);
  1636.   except
  1637.     ClientLogout();
  1638.   end;
  1640.   if GetTickCount - LastReturnHartTick > HartTimer.Interval * 5 then
  1641.   begin
  1642.     ClientLogout();
  1643.   end;
  1644. end;
  1646. {------------------------------------------------------------------------------}
  1647. procedure TRealMessengerX.TrevUserListMouseDown(Sender: TObject;
  1648.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1649. var
  1650.   TreeNode: TTreeNode;
  1651.   Point: TPoint;
  1652. begin
  1653.   TreeNode := TrevUserList.GetNodeAt(X, Y);
  1654.   if TreeNode = nil then
  1655.   begin
  1656.     exit;
  1657.   end
  1658.   else
  1659.   begin
  1660.     TreeNode.Selected := False;
  1661.     TreeNode.Selected := True;
  1662.   end;
  1663.   if (Button = mbRight) then
  1664.   begin
  1665.     Point.X := X;
  1666.     Point.Y := Y;
  1668.     if (TreeNode.StateIndex = 2) then PpMenuRight.Popup(TrevUserList.ClientToScreen(Point).X, TrevUserList.ClientToScreen(Point).Y);
  1670.   end;
  1671. end;
  1673. {------------------------------------------------------------------------------}
  1674. procedure TRealMessengerX.TrevUserListChange(Sender: TObject;
  1675.   Node: TTreeNode);
  1676. begin
  1677.   MSendMsg.Enabled := False;
  1678.   MSendFile.Enabled := False;
  1679.   MSendVoice.Enabled := False;
  1680.   MSendVideo.Enabled := False;
  1681.   MShowHistory.Enabled := False;
  1682.   NR1.Enabled := False;
  1683.   NR2.Enabled := False;
  1684.   NR3.Enabled := False;
  1685.   NR4.Enabled := False;
  1686.   NR5.Enabled := False;
  1689.   NSplitOfGroup.Visible := True;
  1690.   NNewGroup.Visible := True;
  1691.   NDelGroup.Visible := True;
  1692.   NAddGroupMember.Visible := True;
  1693.   NRemoveFromGroup.Visible := True;
  1695.   if Node = nil then
  1696.   begin
  1697.     exit;
  1698.   end;
  1700.   if (Node.StateIndex = 2) then
  1701.   begin
  1702.     MSendMsg.Enabled := True;
  1703.     MSendFile.Enabled := True;
  1704.     MSendVoice.Enabled := True;
  1705.     MSendVideo.Enabled := True;
  1706.     MShowHistory.Enabled := True;
  1707.     NR1.Enabled := True;
  1708.     NR2.Enabled := True;
  1709.     NR3.Enabled := True;
  1710.     NR4.Enabled := True;
  1711.     NR5.Enabled := True;
  1712.   end;
  1713. end;
  1715. {------------------------------------------------------------------------------}
  1716. procedure TRealMessengerX.MAutoLeaveClick(Sender: TObject);
  1717. var
  1718.   TempReg: TRegistry;
  1719. begin
  1720.   TempReg := TRegistry.Create;
  1721.   try
  1722.     TempReg.RootKey := HKEY_LOCAL_MACHINE;
  1723.     if TempReg.OpenKey(AppKey + '' + LoginName + 'Init', True) then
  1724.       if MAutoLeave.Checked then
  1725.       begin
  1726.         TempReg.WriteString('AutoLeave', '1');
  1727.         if STimer.Enabled = False then
  1728.         begin
  1729.           STimer.Enabled := True;
  1730.           Snoop := 0;
  1731.         end;
  1732.       end
  1733.       else
  1734.         TempReg.WriteString('AutoLeave', '0')
  1735.   finally
  1736.     TempReg.Free;
  1737.   end;
  1738. end;
  1740. {------------------------------------------------------------------------------}
  1741. procedure TRealMessengerX.MAutoBusyClick(Sender: TObject);
  1742. var
  1743.   TempReg: TRegistry;
  1744. begin
  1745.   TempReg := TRegistry.Create;
  1746.   try
  1747.     TempReg.RootKey := HKEY_LOCAL_MACHINE;
  1748.     if TempReg.OpenKey(AppKey + '' + LoginName + 'Init', True) then
  1749.       if MAutoLeave.Checked then
  1750.       begin
  1751.         TempReg.WriteString('AutoBusy', '1');
  1752.         if STimer.Enabled = False then
  1753.         begin
  1754.           STimer.Enabled := True;
  1755.           Snoop := 0;
  1756.         end;
  1757.       end
  1758.       else
  1759.         TempReg.WriteString('AutoBusy', '0')
  1760.   finally
  1761.     TempReg.Free;
  1762.   end;
  1763. end;
  1765. {------------------------------------------------------------------------------}
  1766. procedure TRealMessengerX.TrevUserListDblClick(Sender: TObject);
  1767. var
  1768.   ChatingForm: TChatingForm;
  1769.   Room: ChatRoom;
  1770. begin
  1771.   if TrevUserList.Selected.StateIndex <> 2 then exit;
  1772.   if PEmployee(TrevUserList.Selected.Data).ID = Me.ID then
  1773.   begin
  1774.     MessageBox(Handle, '不能与您自己对话！', '提示', MB_ICONINFORMATION);
  1775.     exit;
  1776.   end;
  1777.   Room.UserCount := 2;
  1778.   Room.Users[1] := Me.ID;
  1779.   Room.Users[2] := PEmployee(TrevUserList.Selected.Data).ID;
  1780.   ChatingForm := OpenChatingForm(Room);
  1781.   MsgAlertQueue.Remove(ChatingForm);
  1782.   if MsgAlertQueue.Count = 0 then
  1783.   begin
  1784.     CoolTrayIcon.CycleIcons := False;
  1785.     CoolTrayIcon.IconList := nil;
  1786.     ChangeLblMyStateCaption();
  1787.   end;
  1789.   ChatingForm.Pushed := True;
  1790.   ChatingForm.Show;
  1791.   ShowWindow(ChatingForm.Handle, SW_SHOW);
  1792.   if ChatingForm.WindowState = wsMinimized then ShowWindow(ChatingForm.Handle, SW_RESTORE);
  1793.   if ChatingForm.CanFocus then ChatingForm.SetFocus;
  1794. end;
  1796. {------------------------------------------------------------------------------}
  1797. procedure TRealMessengerX.NR2Click(Sender: TObject);
  1798. var
  1799.   ChatingForm: TChatingForm;
  1800.   Room: ChatRoom;
  1801. begin
  1802.   if TrevUserList.Selected.StateIndex <> 2 then exit;
  1803.   if PEmployee(TrevUserList.Selected.Data).ID = Me.ID then
  1804.   begin
  1805.     MessageBox(Handle, '不能给您自己发送文件！', '提示', MB_ICONINFORMATION);
  1806.     exit;
  1807.   end;
  1808.   Room.UserCount := 2;
  1809.   Room.Users[1] := Me.ID;
  1810.   Room.Users[2] := PEmployee(TrevUserList.Selected.Data).ID;
  1811.   ChatingForm := OpenChatingForm(Room);
  1812.   ChatingForm.Show;
  1813.   if ChatingForm.WindowState = wsMinimized then ShowWindow(ChatingForm.Handle, SW_RESTORE);
  1814.   if ChatingForm.CanFocus then ChatingForm.SetFocus;
  1815.   ChatingForm.ImgSendFileClick(nil);
  1816. end;
  1819. {------------------------------------------------------------------------------}
  1820. procedure TRealMessengerX.NR3Click(Sender: TObject);
  1821. var
  1822.   ChatingForm: TChatingForm;
  1823.   Room: ChatRoom;
  1824. begin
  1825.   if TrevUserList.Selected.StateIndex <> 2 then exit;
  1826.   if PEmployee(TrevUserList.Selected.Data).ID = Me.ID then
  1827.   begin
  1828.     MessageBox(Handle, '不能与您自己进行音频对话！', '提示', MB_ICONINFORMATION);
  1829.     exit;
  1830.   end;
  1831.   Room.UserCount := 2;
  1832.   Room.Users[1] := Me.ID;
  1833.   Room.Users[2] := PEmployee(TrevUserList.Selected.Data).ID;
  1834.   ChatingForm := OpenChatingForm(Room);
  1835.   ChatingForm.Show;
  1836.   if ChatingForm.WindowState = wsMinimized then ShowWindow(ChatingForm.Handle, SW_RESTORE);
  1837.   if ChatingForm.CanFocus then ChatingForm.SetFocus;
  1838.   ChatingForm.ImgVoiceClick(nil);
  1839. end;
  1842. {------------------------------------------------------------------------------}
  1843. procedure TRealMessengerX.NR4Click(Sender: TObject);
  1844. var
  1845.   ChatingForm: TChatingForm;
  1846.   Room: ChatRoom;
  1847. begin
  1848.   if TrevUserList.Selected.StateIndex <> 2 then exit;
  1849.   if PEmployee(TrevUserList.Selected.Data).ID = Me.ID then
  1850.   begin
  1851.     MessageBox(Handle, '不能与您自己进行视频对话！', '提示', MB_ICONINFORMATION);
  1852.     exit;
  1853.   end;
  1854.   Room.UserCount := 2;
  1855.   Room.Users[1] := Me.ID;
  1856.   Room.Users[2] := PEmployee(TrevUserList.Selected.Data).ID;
  1857.   ChatingForm := OpenChatingForm(Room);
  1858.   ChatingForm.Show;
  1859.   if ChatingForm.WindowState = wsMinimized then ShowWindow(ChatingForm.Handle, SW_RESTORE);
  1860.   if ChatingForm.CanFocus then ChatingForm.SetFocus;
  1861.   ChatingForm.ImgVideoClick(nil);
  1862. end;
  1864. {------------------------------------------------------------------------------}
  1865. procedure TRealMessengerX.CoolTrayIconDblClick(Sender: TObject);
  1866. var
  1867.   ChatingForm: TChatingForm;
  1868. begin
  1869.   try
  1870.     if MsgAlertQueue.Count > 0 then
  1871.     begin
  1872.       ChatingForm := MsgAlertQueue.Items[0];
  1873.       MsgAlertQueue.Remove(ChatingForm);
  1874.       if ChatingForm <> nil then
  1875.       begin
  1876.         ChatingForm.Show;
  1877.         ShowWindow(ChatingForm.Handle, SW_SHOW);
  1878.         if ChatingForm.WindowState = wsMinimized then ChatingForm.WindowState := wsNormal;
  1879.         SetForegroundWindow(ChatingForm.Handle);
  1880.       end;
  1881.       if MsgAlertQueue.Count = 0 then
  1882.       begin
  1883.         CoolTrayIcon.CycleIcons := False;
  1884.         CoolTrayIcon.IconList := nil;
  1885.         ChangeLblMyStateCaption();
  1886.       end;
  1887.     end
  1888.     else
  1889.     begin
  1890.       try
  1891.         ShowWindow(Handle, SW_SHOW);
  1892.         RealMessengerX.CoolTrayIcon.ShowTaskbarIcon;
  1893.         jfForceForeGroundWindow(Handle);
  1894.       finally
  1895.         MOpen.Visible := False;
  1896.       end;
  1897.     end;
  1898.   except
  1899.   end;
  1900. end;
  1902. {------------------------------------------------------------------------------}
  1903. procedure TRealMessengerX.NR5Click(Sender: TObject);
  1904. begin
  1905.   if TrevUserList.Selected.StateIndex <> 2 then exit;
  1906.   if PEmployee(TrevUserList.Selected.Data).ID = Me.ID then
  1907.   begin
  1908.     MessageBox(Handle, '不存在与您自己的对话记录！', '提示', MB_ICONINFORMATION);
  1909.     exit;
  1910.   end;
  1911.   if HistoryForm <> nil then HistoryForm.Close;
  1912.   HistoryForm := THistoryForm.Create(Application);
  1913.   HistoryForm.ID := PEmployee(TrevUserList.Selected.Data).ID;
  1914.   HistoryForm.Name := PEmployee(TrevUserList.Selected.Data).Name;
  1915.   HistoryForm.Show;
  1916. end;
  1918. {------------------------------------------------------------------------------}
  1919. procedure TRealMessengerX.TrevUserListMouseMove(Sender: TObject;
  1920.   Shift: TShiftState; X, Y: Integer);
  1921. var
  1922.   Node: TTreeNode;
  1923.   P: TPoint;
  1924. begin
  1925.   Node := TrevUserList.GetNodeAt(X, Y);
  1927.   if Node = nil then
  1928.   begin
  1929.     Application.CancelHint;
  1930.     exit;
  1931.   end;
  1933.   if (Node.StateIndex <> 1) and (Node.StateIndex <> 2) then
  1934.   begin
  1935.     Application.CancelHint;
  1936.     exit;
  1937.   end;
  1939.   if Node = CurNode then
  1940.   begin
  1941.     exit;
  1942.   end;
  1944.   P.X := Node.DisplayRect(True).Left + TrevUserList.Canvas.TextWidth(Node.Text) + 5;
  1945.   P.Y := Node.DisplayRect(True).top + PnlRoot.top;
  1946.   if Node.StateIndex = 2 then
  1947.   begin
  1948.     TrevUserList.Hint := Node.Text + #13 + PEmployee(Node.Data)^.ToolTips
  1949.   end
  1950.   else
  1951.   begin
  1952.     Application.CancelHint;
  1953.   end;
  1955.   Application.ActivateHint(Point(ClientToScreen(P).X, ClientToScreen(P).Y));
  1956.   CurNode := Node;
  1957. end;
  1959. {------------------------------------------------------------------------------}
  1960. procedure TRealMessengerX.STimerTimer(Sender: TObject);
  1961. var
  1962.   Rct: TRect;
  1963.   Point: TPoint;
  1964.   Text: array[0..255] of char;
  1965. begin
  1966.   if TrevUserList.Visible = False then exit;
  1967.   try
  1968.     Snoop := Snoop + STimer.Interval;
  1969.     GetCursorPos(Point);
  1970.     if (OldMousePoint.X <> Point.X) or (OldMousePoint.Y <> Point.Y) then
  1971.     begin
  1972.       Snoop := 0;
  1973.       OldMousePoint.X := Point.X;
  1974.       OldMousePoint.Y := Point.Y;
  1975.     end;
  1977.     if (Snoop > 300000) and MAutoLeave.Checked then //5 分钟之内没有动作
  1978.     begin
  1979.       if AnsiSameText(Me.State, '联机') then
  1980.       begin
  1981.         ChangeMyState('离开', True);
  1982.       end;
  1983.     end
  1984.     else if IsAutoState and AnsiSameText(Me.State, '离开') then
  1985.     begin
  1986.       ChangeMyState('联机');
  1987.     end;
  1989.     GetClassName(GetForegroundWindow, @Text, 256);
  1990.     if (not AnsiSameText(StrPas(Text), 'WorkerW')) and (not AnsiSameText(StrPas(Text), 'Progman')) then
  1991.     begin
  1992.       GetWindowRect(GetForegroundWindow, Rct);
  1993.       IntersectRect(Rct, Rct, Screen.DesktopRect);
  1994.       if EqualRect(Rct, Screen.DesktopRect) then //正在运行全屏程序
  1995.       begin
  1996.         if AnsiSameText(Me.State, '联机') and (MAutoBusy.Checked) and (CopyScreenForm = nil) then
  1997.         begin
  1998.           ChangeMyState('忙碌', True);
  1999.           exit;
  2000.         end;
  2001.       end
  2002.       else if IsAutoState and AnsiSameText(Me.State, '忙碌') then
  2003.       begin
  2004.         ChangeMyState('联机');
  2005.         exit;
  2006.       end;
  2007.     end;
  2009.   except
  2010.   end;
  2012.   {检测是否有新邮件}
  2013.   try
  2014.     if (LastMailCount <> -1) and (CurrentMailCount > LastMailCount) then
  2015.     begin
  2016.       ShowAlert('系统信息', '您收到 ' + IntToStr((CurrentMailCount - LastMailCount)) + ' 封新邮件', True);
  2017.       LastMailCount := CurrentMailCount;
  2018.     end;
  2019.   except
  2020.   end;
  2021. end;
  2023. {------------------------------------------------------------------------------}
  2024. procedure TRealMessengerX.ActiveFormDestroy(Sender: TObject);
  2025. var
  2026.   TempReg: TRegistry;
  2027. begin
  2028.   TempReg := TRegistry.Create;
  2029.   try
  2030.     STimer.Enabled := False;
  2031.     HartTimer.Enabled := False;
  2032.     TimerAutoConnect.Enabled := False;
  2033.     HartTimer.Enabled := False;
  2035.     MySockets.Free;
  2036.     ReceivedMessages.Free;
  2037.     MsgReturnCheck.Free;
  2038.     Branchs.Free;
  2039.     Employees.Free;
  2040.     TransmitFiles.Free;
  2041.     AudioHandShakes.Free;
  2042.     VideoHandShakes.Free;
  2044.     MsgAlertQueue.Free;
  2045.     MsgFormList.Free;
  2047.     TempReg.RootKey := HKEY_LOCAL_MACHINE;
  2048.     if TempReg.OpenKey(AppKey + 'FormStore', True) then
  2049.     begin
  2050.       TempReg.WriteString('Left', IntToStr(Left));
  2051.       TempReg.WriteString('Top', IntToStr(top));
  2052.       TempReg.WriteString('Width', IntToStr(Width));
  2053.       TempReg.WriteString('Height', IntToStr(Height));
  2054.     end;
  2055.   finally
  2056.     TempReg.Free;
  2057.   end;
  2058. end;
  2060. {------------------------------------------------------------------------------}
  2061. procedure TRealMessengerX.FormClose(Sender: TObject;
  2062.   var Action: TCloseAction);
  2063. begin
  2064.   Action := caNone;
  2065.   ZoomEffect(Self, zaMinimize);
  2066.   ShowWindow(RealMessengerX.Handle, SW_HIDE);
  2067.   RealMessengerX.CoolTrayIcon.HideTaskbarIcon;
  2068.   MOpen.Visible := True;
  2069. end;
  2071. {------------------------------------------------------------------------------}
  2072. procedure TRealMessengerX.MExitClick(Sender: TObject);
  2073. begin
  2074.   try
  2075.     if MDisconnect.Enabled then MDisconnectClick(nil);
  2076.     Refresh;
  2077.     Sleep(500);
  2078.     Close;
  2079.     Release;
  2080.   finally
  2081.     Application.Terminate;
  2082.   end;
  2083. end;
  2085. {------------------------------------------------------------------------------}
  2086. procedure TRealMessengerX.FormShow(Sender: TObject);
  2087. begin
  2088.   ChangeAllColor(EndColor);
  2089.   OnShow := nil;
  2090. end;
  2092. {------------------------------------------------------------------------------}
  2093. procedure TRealMessengerX.TimerAutoConnectTimer(Sender: TObject);
  2094. begin
  2095. showmessage('1');
  2096.   if (not TrevUserList.Visible) and (not DontAutoConnect) and (HostName <> '') and (ServerPort > 0) and (LoginName <> '') and (Password <> '') then
  2097.   begin
  2098.     SendIdentity();
  2099.   end;
  2100. end;
  2102. {------------------------------------------------------------------------------}
  2103. procedure TRealMessengerX.NNewGroupClick(Sender: TObject);
  2104. var
  2105.   TempReg: TRegistry;
  2106.   GroupName: string;
  2107. begin
  2108.   GroupName := trim(ShowMyInputBox('输入', '请输入您要新建的组名称：', '', 30));
  2109.   if trim(GroupName) = '' then exit;
  2111.   TempReg := TRegistry.Create;
  2112.   try
  2113.     TempReg.RootKey := HKEY_LOCAL_MACHINE;
  2114.     if TempReg.KeyExists(AppKey + '' + LoginName + 'Group' + trim(GroupName)) then
  2115.     begin
  2116.       MessageBox(Handle, '指定的组已存在！', '提示', MB_ICONINFORMATION);
  2117.       exit;
  2118.     end
  2119.     else
  2120.     begin
  2121.       TempReg.CreateKey(AppKey + '' + LoginName + 'Group' + trim(GroupName));
  2122.       TrevUserList.Items.AddChild(nil, trim(GroupName)).SelectedIndex := -1; {-1表示自定义组方式}
  2123.     end;
  2124.   finally
  2125.     TempReg.Free;
  2126.   end;
  2127. end;
  2129. {------------------------------------------------------------------------------}
  2130. procedure TRealMessengerX.NDelGroupClick(Sender: TObject);
  2131. var
  2132.   TempReg: TRegistry;
  2133.   GroupName: string;
  2134.   Node: TTreeNode;
  2135. begin
  2136.   Node := TrevUserList.Selected;
  2137.   if Node.StateIndex = 2 then Node := Node.Parent;
  2138.   GroupName := Node.Text;
  2140.   TempReg := TRegistry.Create;
  2141.   try
  2142.     TempReg.RootKey := HKEY_LOCAL_MACHINE;
  2143.     TempReg.DeleteKey(AppKey + '' + LoginName + 'Group' + trim(GroupName));
  2144.     Node.Delete;
  2145.   finally
  2146.     TempReg.Free;
  2147.   end;
  2148. end;
  2150. {------------------------------------------------------------------------------}
  2151. procedure TRealMessengerX.NRemoveFromGroupClick(Sender: TObject);
  2152. var
  2153.   TempReg: TRegistry;
  2154.   GroupName: string;
  2155.   Employee: PEmployee;
  2156.   Node: TTreeNode;
  2157. begin
  2158.   Node := TrevUserList.Selected.Parent;
  2159.   GroupName := Node.Text;
  2160.   Employee := PEmployee(TrevUserList.Selected.Data);
  2162.   TempReg := TRegistry.Create;
  2163.   try
  2164.     TempReg.RootKey := HKEY_LOCAL_MACHINE;
  2165.     if TempReg.OpenKey(AppKey + '' + LoginName + 'Group' + trim(GroupName), False) then
  2166.     begin
  2167.       TempReg.DeleteValue(IntToStr(Employee.ID));
  2168.       TrevUserList.Selected.Delete;
  2169.       Employee.Node := nil;
  2170.     end;
  2171.   finally
  2172.     TempReg.Free;
  2173.   end;
  2174. end;
  2176. {------------------------------------------------------------------------------}
  2177. procedure TRealMessengerX.NAddGroupMemberClick(Sender: TObject);
  2178. var
  2179.   TempReg: TRegistry;
  2180.   iLoop, jLoop: Integer;
  2181.   Employee1, Employee2: PEmployee;
  2182.   GroupName: string;
  2183.   GroupNode: TTreeNode;
  2184. begin
  2185.   GroupNode := TrevUserList.Selected;
  2186.   if GroupNode.StateIndex = 2 then GroupNode := GroupNode.Parent;
  2187.   GroupName := GroupNode.Text;
  2189.   SelUserForm := TSelUserForm.Create(Self);
  2190.   try
  2191.     if SelUserForm.ShowModal = mrOK then
  2192.     begin
  2193.       for iLoop := 0 to SelUserForm.TrevUserList.Items.Count - 1 do
  2194.       begin
  2195.         if (SelUserForm.TrevUserList.Items[iLoop].ImageIndex < 6) or (SelUserForm.TrevUserList.Items[iLoop].ImageIndex > 13) then continue;
  2196.         if IsNodeChecked(SelUserForm.TrevUserList.Items[iLoop]) = False then continue;
  2197.         Employee1 := PEmployee(SelUserForm.TrevUserList.Items[iLoop].Data);
  2198.         for jLoop := TrevUserList.Items.Count - 1 downto 0 do
  2199.         begin
  2200.           if TrevUserList.Items[jLoop].StateIndex <> 2 then continue;
  2201.           Employee2 := PEmployee(TrevUserList.Items[jLoop].Data);
  2202.           if Employee1.ID = Employee2.ID then
  2203.           begin
  2204.             Employee2.Node.Selected := True;
  2205.             NRemoveFromGroupClick(nil);
  2206.           end;
  2207.         end;
  2209.         TempReg := TRegistry.Create;
  2210.         try
  2211.           TempReg.RootKey := HKEY_LOCAL_MACHINE;
  2212.           if TempReg.OpenKey(AppKey + '' + LoginName + 'Group' + trim(GroupName), False) then
  2213.           begin
  2214.             with Employees.LockList do
  2215.             try
  2216.               for jLoop := 0 to Count - 1 do
  2217.               begin
  2218.                 Employee2 := Items[jLoop];
  2219.                 if Employee1.ID = Employee2.ID then
  2220.                 begin
  2221.                   TempReg.WriteString(IntToStr(Employee2.ID), Employee2.LoginName);
  2222.                   Employee2.Node := TrevUserList.Items.AddChildObject(GroupNode, Employee2.Name, Employee2);
  2223.                   Employee2.Node.StateIndex := 2 {2表示为用户};
  2224.                   UpdateListViewStates(TrevUserList, Employee2.Node); {更新用户状态}
  2225.                   break;
  2226.                 end;
  2227.               end;
  2228.             finally
  2229.               Employees.UnlockList;
  2230.             end;
  2231.           end;
  2232.         finally
  2233.           TempReg.Free;
  2234.         end;
  2236.       end;
  2237.       GroupNode.Expanded := True;
  2238.     end;
  2239.   finally
  2240.     SelUserForm.Free;
  2241.     SelUserForm := nil;
  2242.   end;
  2243. end;
  2245. {------------------------------------------------------------------------------}
  2246. procedure TRealMessengerX.MConnectSetClick(Sender: TObject);
  2247. begin
  2248.   if SystemSetForm <> nil then exit;
  2249.   SystemSetForm := TSystemSetForm.Create(Self);
  2250.   SystemSetForm.ShowModal;
  2251.   SystemSetForm.Free;
  2252.   SystemSetForm := nil;
  2253. end;
  2255. {------------------------------------------------------------------------------}
  2256. procedure TRealMessengerX.MShowSysHistoryClick(Sender: TObject);
  2257. begin
  2258.   if HistoryForm <> nil then HistoryForm.Close;
  2259.   HistoryForm := THistoryForm.Create(Application);
  2260.   HistoryForm.ID := -1;
  2261.   HistoryForm.Name := '系统消息';
  2262.   HistoryForm.Show;
  2263. end;
  2266. {------------------------------------------------------------------------------}
  2267. procedure TRealMessengerX.LblFileClick(Sender: TObject);
  2268. var
  2269.   Point: TPoint;
  2270. begin
  2271.   Point.X := 0;
  2272.   Point.Y := LblFile.Height;
  2273.   PopFile.Popup(LblFile.ClientToScreen(Point).X - 4, LblFile.ClientToScreen(Point).Y + 2);
  2274. end;
  2276. {------------------------------------------------------------------------------}
  2277. procedure TRealMessengerX.ImgClosedClick(Sender: TObject);
  2278. begin
  2279.   if MessageBox(Handle, '确定要退出程序吗？', '确认退出', MB_ICONQUESTION or MB_OKCANCEL) = ID_OK then Self.MExitClick(nil);
  2280. end;
  2282. {------------------------------------------------------------------------------}
  2283. procedure TRealMessengerX.ImgMinMouseDown(Sender: TObject;
  2284.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2285. begin
  2286.   (Sender as TImage).Left := (Sender as TImage).Left + 1;
  2287.   (Sender as TImage).top := (Sender as TImage).top + 1;
  2288. end;
  2290. {------------------------------------------------------------------------------}
  2291. procedure TRealMessengerX.ImgMinMouseUp(Sender: TObject;
  2292.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2293. begin
  2294.   (Sender as TImage).Left := (Sender as TImage).Left - 1;
  2295.   (Sender as TImage).top := (Sender as TImage).top - 1;
  2296. end;
  2298. {------------------------------------------------------------------------------}
  2299. procedure TRealMessengerX.LblFileMouseMove(Sender: TObject;
  2300.   Shift: TShiftState; X, Y: Integer);
  2301. begin
  2302.   ImgIndex := (Sender as TLabel).Tag;
  2303.   if ImgIndex = LastImgIndex then exit;
  2305.   ImgDraw.Canvas.lock;
  2306.   with ImgDraw.Canvas do
  2307.   begin
  2308.     Pen.Mode := pmCopy;
  2309.     Pen.Style := psClear;
  2310.     Rectangle(0, 0, ImgDraw.Width + 1, ImgDraw.Height + 1);
  2312.     Pen.Style := psSolid;
  2313.     Pen.Color := $00FEFEFE;
  2314.     Pen.Width := 1;
  2315.     MoveTo((Sender as TLabel).Left - ImgDraw.Left - 4, 17);
  2316.     LineTo(PenPos.X, 0);
  2317.     LineTo(PenPos.X + (Sender as TLabel).Width + 4, 0);
  2318.     Pen.Color := EndColor;
  2319.     LineTo(PenPos.X, 17);
  2320.     LineTo(PenPos.X - (Sender as TLabel).Width - 4, 17);
  2322.     Pen.Mode := pmWhite;
  2323.     Pen.Style := psSolid;
  2324.     Refresh;
  2325.   end;
  2326.   LastImgIndex := ImgIndex;
  2327.   TimerTopBar.Enabled := True;
  2328.   ImgDraw.Canvas.Unlock;
  2329. end;
  2331. {------------------------------------------------------------------------------}
  2332. procedure TRealMessengerX.TimerTopBarTimer(Sender: TObject);
  2333. var
  2334.   P: TPoint;
  2335. begin
  2336.   GetCursorPos(P);
  2337.   if (P.X < Left + ImgDraw.Left) or
  2338.     (P.X > Left + ImgDraw.Left + ImgDraw.Width) or
  2339.     (P.Y < top + ImgDraw.top) or
  2340.     (P.Y > top + ImgDraw.top + ImgDraw.Height) then
  2341.   begin
  2342.     with ImgDraw.Canvas do
  2343.     begin
  2344.       Pen.Mode := pmCopy;
  2345.       Pen.Style := psClear;
  2346.       Rectangle(0, 0, ImgDraw.Width + 1, ImgDraw.Height + 1);
  2347.     end;
  2348.     ImgIndex := -1;
  2349.     LastImgIndex := -1;
  2350.     TimerTopBar.Enabled := False;
  2351.   end;
  2352. end;
  2354. {------------------------------------------------------------------------------}
  2355. procedure TRealMessengerX.LblFileMouseDown(Sender: TObject;
  2356.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2357. begin
  2358.   ImgDraw.Canvas.lock;
  2359.   with ImgDraw.Canvas do
  2360.   begin
  2361.     Pen.Mode := pmCopy;
  2362.     Pen.Style := psClear;
  2363.     Rectangle(0, 0, ImgDraw.Width + 1, ImgDraw.Height + 1);
  2365.     Pen.Style := psSolid;
  2366.     Pen.Color := EndColor;
  2367.     Pen.Width := 1;
  2368.     MoveTo((Sender as TLabel).Left - ImgDraw.Left - 4, 17);
  2369.     LineTo(PenPos.X, 0);
  2370.     LineTo(PenPos.X + (Sender as TLabel).Width + 4, 0);
  2371.     Pen.Color := $00FEFEFE;
  2372.     LineTo(PenPos.X, 17);
  2373.     LineTo(PenPos.X - (Sender as TLabel).Width - 4, 17);
  2375.     Pen.Mode := pmWhite;
  2376.     Pen.Style := psSolid;
  2377.     Refresh;
  2378.   end;
  2379.   TimerTopBar.Enabled := True;
  2380.   ImgDraw.Canvas.Unlock;
  2381. end;
  2383. {------------------------------------------------------------------------------}
  2384. procedure TRealMessengerX.ImgMinClick(Sender: TObject);
  2385. begin
  2386.   Close;
  2387. end;
  2389. {------------------------------------------------------------------------------}
  2390. procedure TRealMessengerX.ImgTitleMouseDown(Sender: TObject;
  2391.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2392. begin
  2393.   if (Button = mbLeft) then
  2394.   begin
  2395.     ReleaseCapture;
  2396.     Self.Perform(WM_SYSCOMMAND, $F012, 0);
  2397.   end;
  2398. end;
  2400. {------------------------------------------------------------------------------}
  2401. procedure TRealMessengerX.LblMailCountClick(Sender: TObject);
  2402. var
  2403.   ThreadId: DWORD;
  2404. begin
  2405.   Pop3ServerForm := TPop3ServerForm.Create(Self);
  2406.   try
  2407.     if Pop3ServerForm.ShowModal = mrOK then
  2408.     begin
  2409.       if CheckPOP3ThreadHandle <> 0 then TerminateThread(CheckPOP3ThreadHandle, 4);
  2410.       CheckPOP3ThreadHandle := CreateThread(nil, 0, @CheckPOP3Thread, nil, 0, ThreadId);
  2411.     end;
  2412.   finally
  2413.     Pop3ServerForm.Free;
  2414.   end;
  2415. end;
  2417. {------------------------------------------------------------------------------}
  2418. constructor TClientHandleThread.Create;
  2419. begin
  2420.   inherited Create(True);
  2421.   FLock := TCriticalSection.Create;
  2422.   Resume;
  2423. end;
  2425. {------------------------------------------------------------------------------}
  2426. destructor TClientHandleThread.Destroy;
  2427. begin
  2428.   inherited Destroy;
  2429.   FLock.Free;
  2430. end;
  2432. {------------------------------------------------------------------------------}
  2433. procedure TClientHandleThread.ProcessCBLoginResult;
  2434. begin
  2435.   if not CBLoginResult.IsLogin then
  2436.   begin
  2437.     RealMessengerX.ClientLogout;
  2438.     RealMessengerX.CoolTrayIcon.ShowBalloonHint('登录失败', CBLoginResult.Result, bitError, 15);
  2439.     if (not DontAutoConnect) and (string(CBLoginResult.Result) = ServerStopped) then
  2440.       RealMessengerX.TimerAutoConnect.Enabled := True
  2441.     else
  2442.       RealMessengerX.TimerAutoConnect.Enabled := False;
  2443.   end;
  2444. end;
  2446. {------------------------------------------------------------------------------}
  2447. procedure TClientHandleThread.ProcessCBSendBranch;
  2448. var
  2449.   PBranchData: PBranch;
  2450. begin
  2451.   if CBSendBranch.Current = 0 then Branchs.Clear;
  2452.   GetMem(PBranchData, SizeOf(Branch));
  2453.   CopyMemory(PBranchData, @(CBSendBranch.BranchData), SizeOf(Branch));
  2454.   PBranchData.Node := nil;
  2455.   Branchs.Add(PBranchData);
  2456.   RealMessengerX.TimerLoging.Enabled := False;
  2457.   RealMessengerX.TimerLoging.Enabled := True;
  2458.   RealMessengerX.LblLoging.Caption := '正在下载部门列表...';
  2459.   RealMessengerX.Gauge.MaxValue := CBSendBranch.Count;
  2460.   RealMessengerX.Gauge.Progress := CBSendBranch.Current;
  2461. end;
  2463. {------------------------------------------------------------------------------}
  2464. procedure TClientHandleThread.ProcessCBSendEmployee;
  2465. var
  2466.   PEmployeeData: PEmployee;
  2467. begin
  2468.   if CBSendEmployee.Current = 0 then Employees.Clear;
  2469.   GetMem(PEmployeeData, SizeOf(Employee));
  2470.   CopyMemory(PEmployeeData, @(CBSendEmployee.EmployeeData), SizeOf(Employee));
  2471.   PEmployeeData.Node := nil;
  2472.   PEmployeeData.MySocket := nil;
  2473.   Employees.Add(PEmployeeData);
  2474.   if PEmployeeData.LoginName = LoginName then Me := PEmployeeData;
  2476.   if CBSendEmployee.Current = CBSendEmployee.Count then
  2477.   begin
  2478.     RealMessengerX.ClientLogin;
  2479.   end
  2480.   else
  2481.   begin
  2482.     RealMessengerX.TimerLoging.Enabled := False;
  2483.     RealMessengerX.TimerLoging.Enabled := True;
  2484.     RealMessengerX.LblLoging.Caption := '正在下载帐号列表...';
  2485.     RealMessengerX.Gauge.MaxValue := CBSendEmployee.Count;
  2486.     RealMessengerX.Gauge.Progress := CBSendEmployee.Current;
  2487.   end;
  2488. end;
  2490. {------------------------------------------------------------------------------}
  2491. procedure TClientHandleThread.ProcessCBNameAndPasswordChanged;
  2492. var
  2493.   jLoop: Integer;
  2494.   PEmployeeData, Employee1: PEmployee;
  2495. begin
  2496.   PEmployeeData := FindEmployeeByID(CBNameAndPasswordChanged.ID);
  2497.   if PEmployeeData = nil then exit;
  2498.   PEmployeeData.Name := CBNameAndPasswordChanged.Name;
  2500.   RealMessengerX.UpdateListViewStates(RealMessengerX.TrevUserList, PEmployeeData.Node);
  2501.   if SelUserForm <> nil then
  2502.   begin
  2503.     for jLoop := 0 to SelUserForm.TrevUserList.Items.Count - 1 do
  2504.     begin
  2505.       if (SelUserForm.TrevUserList.Items[jLoop].ImageIndex < 6) or (SelUserForm.TrevUserList.Items[jLoop].ImageIndex > 13) then continue;
  2506.       Employee1 := PEmployee(SelUserForm.TrevUserList.Items[jLoop].Data);
  2507.       if Employee1.ID = PEmployeeData.ID then
  2508.       begin
  2509.         Employee1.State := PEmployeeData.State;
  2510.         RealMessengerX.UpdateListViewStates(SelUserForm.TrevUserList, Employee1.Node);
  2511.         break;
  2512.       end;
  2513.     end;
  2514.   end;
  2516.   if PEmployeeData.ID = Me.ID then
  2517.   begin
  2518.     IsAutoState := CBStateChanged.IsAutoState;
  2519.     RealMessengerX.UpdateMyState;
  2520.   end;
  2521.   for jLoop := 0 to ChatingFormList.Count - 1 do TChatingForm(ChatingFormList.Items[jLoop]).ShowTitle;
  2522. end;
  2523. {------------------------------------------------------------------------------}
  2524. procedure TClientHandleThread.ProcessCBStateChanged;
  2525. var
  2526.   iLoop, jLoop: Integer;
  2527.   PEmployeeData, Employee1: PEmployee;
  2528.   TransmitFile: TTransmitFile;
  2529.   AudioHandShake: TAudioHandShake;
  2530.   VideoHandShake: TVideoHandShake;
  2531. begin
  2532.   PEmployeeData := FindEmployeeByID(CBStateChanged.ID);
  2533.   if PEmployeeData = nil then exit;
  2535.   if AnsiSameText(CBStateChanged.State, '断开') then
  2536.   begin
  2537.     with TransmitFiles.LockList do
  2538.     try
  2539.       for jLoop := Count - 1 downto 0 do
  2540.       begin
  2541.         TransmitFile := Items[jLoop];
  2542.         if ((TransmitFile.SenderID = CBStateChanged.ID) or (TransmitFile.ReceiverID = CBStateChanged.ID)) and (TransmitFile.IsComleted = False) then TransmitFile.Logout;
  2543.       end;
  2544.     finally
  2545.       TransmitFiles.UnlockList;
  2546.     end;
  2548.     with AudioHandShakes.LockList do
  2549.     try
  2550.       for jLoop := Count - 1 downto 0 do
  2551.       begin
  2552.         AudioHandShake := Items[jLoop];
  2553.         if AudioHandShake.ID = CBStateChanged.ID then AudioHandShake.Logout;
  2554.       end;
  2555.     finally
  2556.       AudioHandShakes.UnlockList;
  2557.     end;
  2559.     with VideoHandShakes.LockList do
  2560.     try
  2561.       for jLoop := Count - 1 downto 0 do
  2562.       begin
  2563.         VideoHandShake := Items[jLoop];
  2564.         if VideoHandShake.ID = CBStateChanged.ID then VideoHandShake.Logout;
  2565.       end;
  2566.     finally
  2567.       VideoHandShakes.UnlockList;
  2568.     end;
  2570.     PEmployeeData.MySocket.Free;
  2571.     PEmployeeData.MySocket := nil;
  2572.   end;
  2574.   if (PEmployeeData.ID <> Me.ID) and (GetTickCount - ConnectedTicket > 10000) then
  2575.   begin
  2576.     if (AnsiSameText(CBStateChanged.State, '显示为脱机') or AnsiSameText(CBStateChanged.State, '断开')) and (not AnsiSameText(PEmployeeData.State, '显示为脱机') and not AnsiSameText(PEmployeeData.State, '断开')) then
  2577.     begin
  2578.       PlayEventSound(SoundPath + 'out.wav');
  2579.       ShowAlert('系统信息', PEmployeeData.Name + ' 刚刚离线', True); ;
  2580.     end;
  2582.     if (AnsiSameText(PEmployeeData.State, '显示为脱机') or AnsiSameText(PEmployeeData.State, '断开')) and (not AnsiSameText(CBStateChanged.State, '显示为脱机') and not AnsiSameText(CBStateChanged.State, '断开')) then
  2583.     begin
  2584.       PlayEventSound(SoundPath + 'in.wav');
  2585.       ShowAlert('系统信息', PEmployeeData.Name + ' 刚刚上线', True); ;
  2586.     end;
  2587.   end;
  2589.   PEmployeeData.State := CBStateChanged.State;
  2590.   PEmployeeData.HaveAudioDevice := CBStateChanged.HaveAudioDevice;
  2591.   PEmployeeData.HaveVideoDevice := CBStateChanged.HaveVideoDevice;
  2593.   RealMessengerX.UpdateListViewStates(RealMessengerX.TrevUserList, PEmployeeData.Node); //更新用户状态
  2594.   if SelUserForm <> nil then
  2595.   begin
  2596.     for jLoop := 0 to SelUserForm.TrevUserList.Items.Count - 1 do
  2597.     begin
  2598.       if (SelUserForm.TrevUserList.Items[jLoop].ImageIndex < 6) or (SelUserForm.TrevUserList.Items[jLoop].ImageIndex > 13) then continue;
  2599.       Employee1 := PEmployee(SelUserForm.TrevUserList.Items[jLoop].Data);
  2600.       if Employee1.ID = PEmployeeData.ID then
  2601.       begin
  2602.         Employee1.State := PEmployeeData.State;
  2603.         RealMessengerX.UpdateListViewStates(SelUserForm.TrevUserList, Employee1.Node); //更新用户状态
  2604.         break;
  2605.       end;
  2606.     end;
  2607.   end;
  2609.   if PEmployeeData.ID = Me.ID then
  2610.   begin
  2611.     IsAutoState := CBStateChanged.IsAutoState;
  2612.     RealMessengerX.UpdateMyState;
  2613.   end;
  2614.   for jLoop := 0 to ChatingFormList.Count - 1 do TChatingForm(ChatingFormList.Items[jLoop]).ShowTitle;
  2615. end;
  2617. {------------------------------------------------------------------------------}
  2618. procedure TClientHandleThread.ProcessCBBeginTalk;
  2619. var
  2620.   PEmployeeData: PEmployee;
  2621. begin
  2622.   PEmployeeData := FindEmployeeByID(CBBeginTalk.Sender);
  2623.   if PEmployeeData = nil then exit;
  2624.   if PEmployeeData.MySocket = nil then
  2625.   begin
  2626.     PEmployeeData.MySocket := TMySocket.Create(PEmployeeData.ID, RealMessengerX.ClientTCP, True);
  2627.   end;
  2628.   PEmployeeData.MySocket.ReceiverLocalIP := CBBeginTalk.LocalIP;
  2629.   PEmployeeData.MySocket.ReceiverLocalPort := CBBeginTalk.LocalPort;
  2630.   PEmployeeData.MySocket.ReceiverIP := CBBeginTalk.IP;
  2631.   PEmployeeData.MySocket.ReceiverPort := CBBeginTalk.Port;
  2632.   PEmployeeData.MySocket.BeginGetHole;
  2633. end;
  2635. {------------------------------------------------------------------------------}
  2636. procedure TClientHandleThread.ProcessCBPleaseUseTCP;
  2637. var
  2638.   AudioHandShake: TAudioHandShake;
  2639.   VideoHandShake: TVideoHandShake;
  2640.   iLoop: Integer;
  2641.   ChatingForm: TChatingForm;
  2642. begin
  2643.   if CBPleaseUseTCP.ForAudioAudio then
  2644.   begin
  2645.     with AudioHandShakes.LockList do
  2646.     try
  2647.       for iLoop := Count - 1 downto 0 do
  2648.       begin
  2649.         AudioHandShake := Items[iLoop];
  2650.         if AudioHandShake.IsAccepted and (AudioHandShake.ID = CBPleaseUseTCP.Sender) then
  2651.         begin
  2652.           ChatingForm := AudioHandShake.ChatingForm;
  2653.           if not ChatingForm.ImgMicDisabled.Visible then AudioHandShake.MySocket.MySocketCategory := scTCP;
  2654.         end;
  2655.       end;
  2656.     finally
  2657.       AudioHandShakes.UnlockList
  2658.     end;
  2659.   end
  2660.   else
  2661.   begin
  2662.     with VideoHandShakes.LockList do
  2663.     try
  2664.       for iLoop := Count - 1 downto 0 do
  2665.       begin
  2666.         VideoHandShake := Items[iLoop];
  2667.         if VideoHandShake.IsAccepted and (VideoHandShake.ID = CBPleaseUseTCP.Sender) then
  2668.         begin
  2669.           if CBPleaseUseTCP.ForVideoAudio then
  2670.           begin
  2671.             ChatingForm := VideoHandShake.ChatingForm;
  2672.             if not ChatingForm.ImgMicDisabled.Visible then VideoHandShake.AMySocket.MySocketCategory := scTCP;
  2673.           end
  2674.           else
  2675.           begin
  2676.             VideoHandShake.VMySocket.MySocketCategory := scTCP;
  2677.           end;
  2678.         end;
  2679.       end;
  2680.     finally
  2681.       VideoHandShakes.UnlockList
  2682.     end;
  2683.   end;
  2684. end;
  2686. {------------------------------------------------------------------------------}
  2687. procedure TClientHandleThread.ProcessCBInputing;
  2688. begin
  2689.   RealMessengerX.ProcessCBInputing(CBInputing);
  2690. end;
  2692. {------------------------------------------------------------------------------}
  2693. procedure TClientHandleThread.ProcessCBAddUser;
  2694. var
  2695.   iLoop: Integer;
  2696.   ChatingForm: TChatingForm;
  2697. begin
  2698.   ChatingForm := OpenChatingForm(CBAddUser.Room, False);
  2699.   if ChatingForm = nil then exit;
  2700.   for iLoop := 1 to CBAddUser.AddRoom.UserCount do
  2701.   begin
  2702.     ChatingForm.RoomInfo.UserCount := ChatingForm.RoomInfo.UserCount + 1;
  2703.     ChatingForm.RoomInfo.Users[ChatingForm.RoomInfo.UserCount] := CBAddUser.AddRoom.Users[iLoop];
  2704.   end;
  2705.   ChatingForm.ShowTitle;
  2706. end;
  2708. {------------------------------------------------------------------------------}
  2709. procedure TClientHandleThread.ProcessCBSendFileRequest;
  2710. var
  2711.   iLoop: Integer;
  2712.   ChatingForm: TChatingForm;
  2713.   PEmployeeData: PEmployee;
  2714. begin
  2715.   ChatingForm := OpenChatingForm(CBSendFileRequest.Room, True);
  2716.   if ChatingForm = nil then exit;
  2718.   PEmployeeData := FindEmployeeByID(CBSendFileRequest.Sender);
  2719.   if PEmployeeData = nil then exit;
  2721.   TTransmitFile.Create(tfGet, CBSendFileRequest.Sender, PEmployeeData.Name, Me.ID, Me.Name, CBSendFileRequest.FileName, ChatingForm, CBSendFileRequest.LocalIP, CBSendFileRequest.LocalPort, CBSendFileRequest.IP, CBSendFileRequest.Port, CBSendFileRequest.FileSize, CBSendFileRequest.FileID, CBSendFileRequest.BaseID, CBSendFileRequest.IsScreen);
  2722.   if not ChatingForm.Pushed then RealMessengerX.FlashTray(ChatingForm);
  2723. end;
  2725. {------------------------------------------------------------------------------}
  2726. procedure TClientHandleThread.ProcessCBSendFileResponse;
  2727. var
  2728.   TransmitFile: TTransmitFile;
  2729.   ChatingForm: TChatingForm;
  2730. begin
  2731.   TransmitFile := FindTransmitFileByBaseID(trim(CBSendFileResponse.BaseID));
  2732.   if TransmitFile = nil then exit;
  2734.   TransmitFile.MySocket.ReceiverLocalIP := CBSendFileResponse.LocalIP;
  2735.   TransmitFile.MySocket.ReceiverLocalPort := CBSendFileResponse.LocalPort;
  2736.   TransmitFile.MySocket.ReceiverIP := CBSendFileResponse.IP;
  2737.   TransmitFile.MySocket.ReceiverPort := CBSendFileResponse.Port;
  2738.   TransmitFile.MySocket.BeginGetHole;
  2740.   ChatingForm := TransmitFile.ChatingForm;
  2741.   if ChatingForm = nil then exit;
  2742.   if CBSendFileResponse.IsAccept then
  2743.     TransmitFile.Accept
  2744.   else
  2745.   begin
  2746.     TransmitFile.Decline;
  2747.   end;
  2748. end;
  2750. {------------------------------------------------------------------------------}
  2751. procedure TClientHandleThread.ProcessCBSendFileResult;
  2752. begin
  2753.   RealMessengerX.ProcessCBSendFileResult(CBSendFileResult);
  2754. end;
  2756. {------------------------------------------------------------------------------}
  2757. procedure TClientHandleThread.ProcessCBSendFilePackage;
  2758. begin
  2759.   RealMessengerX.ProcessCBSendFilePackage(CBSendFilePackage);
  2760. end;
  2762. {------------------------------------------------------------------------------}
  2763. procedure TClientHandleThread.ProcessCBSendFileResume;
  2764. var
  2765.   iLoop: Integer;
  2766.   TransmitFile: TTransmitFile;
  2767.   E: IHTMLElement;
  2768. begin
  2769.   TransmitFile := FindTransmitFileByBaseID(trim(CBSendFileResume.BaseID));
  2770.   if TransmitFile = nil then exit;
  2771.   E := (TransmitFile.ChatingForm.MsgContent.Document as IHTMLDocument2).all.item(TransmitFile.PercentID, 0) as IHTMLElement;
  2772.   E.innerHTML := '准备发送文件（正在接收断点续传信息）...';
  2773.   for iLoop := 0 to CBSendFileResume.BufferLength - 1 do
  2774.   begin
  2775.     PFileTableUnit(TransmitFile.FileTable.Items[CBSendFileResume.Start + iLoop]).IsAccepted := CBSendFileResume.ResumBuffer[iLoop + 1];
  2776.     if PFileTableUnit(TransmitFile.FileTable.Items[CBSendFileResume.Start + iLoop]).IsAccepted = '1' then TransmitFile.ResumedSize := TransmitFile.ResumedSize + FilePackSize;
  2777.   end;
  2778. end;
  2780. {------------------------------------------------------------------------------}
  2781. procedure TClientHandleThread.ProcessCBSendFileCompleted;
  2782. var
  2783.   TransmitFile: TTransmitFile;
  2784. begin
  2785.   TransmitFile := FindTransmitFileByBaseID(trim(CBSendFileCompleted.BaseID));
  2786.   if TransmitFile = nil then exit;
  2787.   TransmitFile.IsComleted := True;
  2788.   TMoveFile.Create(TransmitFile);
  2789. end;
  2791. {------------------------------------------------------------------------------}
  2792. procedure TClientHandleThread.ProcessCBSendFileCancle;
  2793. var
  2794.   TransmitFile: TTransmitFile;
  2795.   ChatingForm: TChatingForm;
  2796. begin
  2797.   TransmitFile := FindTransmitFileByBaseID(trim(CBSendFileCancle.BaseID));
  2798.   if TransmitFile = nil then exit;
  2799.   ChatingForm := TransmitFile.ChatingForm;
  2800.   if ChatingForm = nil then exit;
  2801.   TransmitFile.Cancel;
  2802. end;
  2804. {------------------------------------------------------------------------------}
  2805. procedure TClientHandleThread.ProcessCBSendFileStop;
  2806. var
  2807.   TransmitFile: TTransmitFile;
  2808.   ChatingForm: TChatingForm;
  2809. begin
  2810.   TransmitFile := FindTransmitFileByBaseID(trim(CBSendFileStop.BaseID));
  2811.   if TransmitFile = nil then exit;
  2812.   ChatingForm := TransmitFile.ChatingForm;
  2813.   if ChatingForm = nil then exit;
  2814.   TransmitFile.Stop(CBSendFileStop.Sender);
  2815. end;
  2817. {------------------------------------------------------------------------------}
  2818. procedure TClientHandleThread.ProcessCBSetBitmapInfo;
  2819. begin
  2820.   FillChar(A_FInInfo, SizeOf(A_FInInfo), 0);
  2821.   Move(CBSetBitmapInfo.Buf, A_FInInfo, SizeOf(A_FInInfo));
  2822. end;
  2824. {------------------------------------------------------------------------------}
  2825. procedure TClientHandleThread.ProcessCBSetCompvars;
  2826. begin
  2827.   FillChar(A_FCV, SizeOf(A_FCV), 0);
  2828.   Move(CBSetCompvars.Buf, A_FCV, SizeOf(A_FCV));
  2829.   A_FCV.hic := ICOpen(A_FCV.fccType, A_FCV.fccHandler, ICMODE_DECOMPRESS);
  2830.   if A_FCV.hic = 0 then
  2831.   begin
  2832.     MessageBox(RealMessengerX.Handle, '您的机器未安装系统所需的MPEG4解码器!', '提示', MB_ICONINFORMATION);
  2833.   end else
  2834.   begin
  2835.     A_FOutFormatSize := ICDecompressGetFormatSize(A_FCV.hic, @A_FInInfo.bmiHeader);
  2836.     FillChar(A_FOutInfo, SizeOf(A_FOutInfo), 0);
  2837.     ICDecompressGetFormat(A_FCV.hic, @A_FInInfo, @A_FOutInfo);
  2838.     FOutBufSize := A_FOutInfo.bmiHeader.biSizeImage;
  2839.     if Assigned(FOutBuf) then FreeMem(FOutBuf);
  2840.     GetMem(FOutBuf, FOutBufSize);
  2841.     FillChar(FOutBuf^, FOutBufSize, 0);
  2842.     ICDecompressBegin(A_FCV.hic, @A_FInInfo, @A_FOutInfo);
  2843.   end;
  2844. end;
  2846. {------------------------------------------------------------------------------}
  2847. procedure TClientHandleThread.ProcessCBVideo;
  2848. begin
  2849.   RealMessengerX.ProcessCBVideo(CBVideo);
  2850. end;
  2852. {------------------------------------------------------------------------------}
  2853. procedure TClientHandleThread.ProcessCBMessage;
  2854. begin
  2855.   RealMessengerX.ProcessCBMessage(CBMessage);
  2856. end;
  2858. {------------------------------------------------------------------------------}
  2859. procedure TClientHandleThread.ProcessCBReturnMessage;
  2860. begin
  2861.   RealMessengerX.ProcessCBReturnMessage(CBReturnMessage);
  2862. end;
  2864. {------------------------------------------------------------------------------}
  2865. procedure TClientHandleThread.ProcessCBAudioRequest;
  2866. var
  2867.   ChatingForm: TChatingForm;
  2868.   PEmployeeData: PEmployee;
  2869. begin
  2870.   PEmployeeData := FindEmployeeByID(CBAudioRequest.Sender);
  2871.   if PEmployeeData = nil then exit;
  2873.   ChatingForm := OpenChatingForm(CBAudioRequest.Room, True);
  2874.   if ChatingForm = nil then exit;
  2875.   TAudioHandShake.Create(ahResponse, PEmployeeData.ID, PEmployeeData.Name, ChatingForm, CBAudioRequest.LocalIP, CBAudioRequest.LocalPort, CBAudioRequest.IP, CBAudioRequest.Port);
  2876.   if not ChatingForm.Pushed then RealMessengerX.FlashTray(ChatingForm);
  2877. end;
  2879. {------------------------------------------------------------------------------}
  2880. procedure TClientHandleThread.ProcessCBAudioResponse;
  2881. var
  2882.   ChatingForm: TChatingForm;
  2883.   AudioHandShake: TAudioHandShake;
  2884. begin
  2885.   AudioHandShake := FindAudioHandShakeByID(CBAudioResponse.Sender);
  2886.   if AudioHandShake = nil then exit;
  2888.   AudioHandShake.MySocket.ReceiverLocalIP := CBAudioResponse.LocalIP;
  2889.   AudioHandShake.MySocket.ReceiverLocalPort := CBAudioResponse.LocalPort;
  2890.   AudioHandShake.MySocket.ReceiverIP := CBAudioResponse.IP;
  2891.   AudioHandShake.MySocket.ReceiverPort := CBAudioResponse.Port;
  2892.   AudioHandShake.MySocket.BeginGetHole;
  2894.   ChatingForm := AudioHandShake.ChatingForm;
  2895.   if ChatingForm = nil then exit;
  2896.   if CBAudioResponse.isAcepted then
  2897.     AudioHandShake.Accept
  2898.   else
  2899.     AudioHandShake.Decline;
  2900. end;
  2902. {------------------------------------------------------------------------------}
  2903. procedure TClientHandleThread.ProcessCBAudioCancel;
  2904. var
  2905.   ChatingForm: TChatingForm;
  2906.   AudioHandShake: TAudioHandShake;
  2907. begin
  2908.   AudioHandShake := FindAudioHandShakeByID(CBAudioCancel.Sender);
  2909.   if AudioHandShake = nil then exit;
  2910.   ChatingForm := AudioHandShake.ChatingForm;
  2911.   if ChatingForm = nil then exit;
  2912.   AudioHandShake.Cancel;
  2913. end;
  2915. {------------------------------------------------------------------------------}
  2916. procedure TClientHandleThread.ProcessCBAudio;
  2917. begin
  2918.   RealMessengerX.ProcessCBAudio(CBAudio);
  2919. end;
  2921. {------------------------------------------------------------------------------}
  2922. procedure TClientHandleThread.ProcessCBAudioStop;
  2923. var
  2924.   ChatingForm: TChatingForm;
  2925.   AudioHandShake: TAudioHandShake;
  2926. begin
  2927.   AudioHandShake := FindAudioHandShakeByID(CBAudioStop.Sender);
  2928.   if AudioHandShake = nil then exit;
  2929.   ChatingForm := AudioHandShake.ChatingForm;
  2930.   if ChatingForm = nil then exit;
  2931.   AudioHandShake.Stop(CBAudioStop.Sender);
  2932. end;
  2934. {------------------------------------------------------------------------------}
  2935. procedure TClientHandleThread.ProcessCBVideoRequest;
  2936. var
  2937.   ChatingForm: TChatingForm;
  2938.   PEmployeeData: PEmployee;
  2939. begin
  2940.   PEmployeeData := FindEmployeeByID(CBVideoRequest.Sender);
  2941.   if PEmployeeData = nil then exit;
  2943.   ChatingForm := OpenChatingForm(CBVideoRequest.Room, True);
  2944.   if ChatingForm = nil then exit;
  2945.   TVideoHandShake.Create(vhResponse, PEmployeeData.ID, PEmployeeData.Name, ChatingForm,
  2946.     CBVideoRequest.ALocalIP, CBVideoRequest.ALocalPort, CBVideoRequest.AIP, CBVideoRequest.APort,
  2947.     CBVideoRequest.VLocalIP, CBVideoRequest.VLocalPort, CBVideoRequest.VIP, CBVideoRequest.VPort);
  2948.   if not ChatingForm.Pushed then RealMessengerX.FlashTray(ChatingForm);
  2949. end;
  2951. {------------------------------------------------------------------------------}
  2952. procedure TClientHandleThread.ProcessCBVideoResponse;
  2953. var
  2954.   ChatingForm: TChatingForm;
  2955.   VideoHandShake: TVideoHandShake;
  2956. begin
  2957.   VideoHandShake := FindVideoHandShakeByID(CBVideoResponse.Sender);
  2958.   if VideoHandShake = nil then exit;
  2960.   VideoHandShake.AMySocket.ReceiverLocalIP := CBVideoResponse.ALocalIP;
  2961.   VideoHandShake.AMySocket.ReceiverLocalPort := CBVideoResponse.ALocalPort;
  2962.   VideoHandShake.AMySocket.ReceiverIP := CBVideoResponse.AIP;
  2963.   VideoHandShake.AMySocket.ReceiverPort := CBVideoResponse.APort;
  2964.   VideoHandShake.AMySocket.BeginGetHole;
  2966.   VideoHandShake.VMySocket.ReceiverLocalIP := CBVideoResponse.VLocalIP;
  2967.   VideoHandShake.VMySocket.ReceiverLocalPort := CBVideoResponse.VLocalPort;
  2968.   VideoHandShake.VMySocket.ReceiverIP := CBVideoResponse.VIP;
  2969.   VideoHandShake.VMySocket.ReceiverPort := CBVideoResponse.VPort;
  2970.   VideoHandShake.VMySocket.BeginGetHole;
  2972.   ChatingForm := VideoHandShake.ChatingForm;
  2973.   if ChatingForm = nil then exit;
  2974.   if CBVideoResponse.isAcepted then
  2975.     VideoHandShake.Accept
  2976.   else
  2977.     VideoHandShake.Decline;
  2978. end;
  2980. {------------------------------------------------------------------------------}
  2981. procedure TClientHandleThread.ProcessCBVideoCancel;
  2982. var
  2983.   ChatingForm: TChatingForm;
  2984.   VideoHandShake: TVideoHandShake;
  2985. begin
  2986.   VideoHandShake := FindVideoHandShakeByID(CBVideoCancel.Sender);
  2987.   if VideoHandShake = nil then exit;
  2988.   ChatingForm := VideoHandShake.ChatingForm;
  2989.   if ChatingForm = nil then exit;
  2990.   VideoHandShake.Cancel;
  2991. end;
  2993. {------------------------------------------------------------------------------}
  2994. procedure TClientHandleThread.ProcessCBVideoStop;
  2995. var
  2996.   ChatingForm: TChatingForm;
  2997.   VideoHandShake: TVideoHandShake;
  2998. begin
  2999.   VideoHandShake := FindVideoHandShakeByID(CBVideoStop.Sender);
  3000.   if VideoHandShake = nil then exit;
  3001.   ChatingForm := VideoHandShake.ChatingForm;
  3002.   if ChatingForm = nil then exit;
  3003.   VideoHandShake.Stop(CBVideoStop.Sender);
  3004. end;
  3006. {------------------------------------------------------------------------------}
  3007. procedure TClientHandleThread.Execute;
  3008. var
  3009.   skType: char;
  3010. begin
  3011.   while not Terminated do
  3012.   begin
  3013.     if not RealMessengerX.ClientTCP.Connected then
  3014.       Terminate
  3015.     else
  3016.     try
  3017.       RealMessengerX.ClientTCP.ReadBuffer(skType, 1);
  3019.       {************************************************************************}
  3020.       if skType = skLoginResult then
  3021.       begin
  3022.         RealMessengerX.ClientTCP.ReadBuffer(CBLoginResult, SizeOf(CBLoginResult));
  3023.         Synchronize(ProcessCBLoginResult);
  3024.         continue;
  3025.       end;
  3027.       {************************************************************************}
  3028.       if skType = skSendBranch then
  3029.       begin
  3030.         RealMessengerX.ClientTCP.ReadBuffer(CBSendBranch, SizeOf(CBSendBranch));
  3031.         Synchronize(ProcessCBSendBranch);
  3032.         continue;
  3033.       end;
  3035.       {************************************************************************}
  3036.       if skType = skSendEmployee then
  3037.       begin
  3038.         RealMessengerX.ClientTCP.ReadBuffer(CBSendEmployee, SizeOf(CBSendEmployee));
  3039.         Synchronize(ProcessCBSendEmployee);
  3040.         continue;
  3041.       end;
  3043.       {************************************************************************}
  3044.       if skType = skStateChanged then
  3045.       begin
  3046.         RealMessengerX.ClientTCP.ReadBuffer(CBStateChanged, SizeOf(CBStateChanged));
  3047.         Synchronize(ProcessCBStateChanged);
  3048.         continue;
  3049.       end;
  3051.       {************************************************************************}
  3052.       if skType = skOnlineCheck then
  3053.       begin
  3054.         LastReturnHartTick := GetTickCount;
  3055.         continue;
  3056.       end;
  3058.       {************************************************************************}
  3059.       if skType = skBeginTalk then
  3060.       begin
  3061.         RealMessengerX.ClientTCP.ReadBuffer(CBBeginTalk, SizeOf(CBBeginTalk));
  3062.         Synchronize(ProcessCBBeginTalk);
  3063.         continue;
  3064.       end;
  3066.       {************************************************************************}
  3067.       if skType = skInputing then
  3068.       begin
  3069.         RealMessengerX.ClientTCP.ReadBuffer(CBInputing, SizeOf(CBInputing));
  3070.         Synchronize(ProcessCBInputing);
  3071.         continue;
  3072.       end;
  3074.       {************************************************************************}
  3075.       if skType = skMessage then
  3076.       begin
  3077.         RealMessengerX.ClientTCP.ReadBuffer(CBMessage, SizeOf(CBMessage));
  3078.         Synchronize(ProcessCBMessage);
  3079.         continue;
  3080.       end;
  3082.       {************************************************************************}
  3083.       if skType = skReturnMessage then
  3084.       begin
  3085.         RealMessengerX.ClientTCP.ReadBuffer(CBReturnMessage, SizeOf(CBReturnMessage));
  3086.         Synchronize(ProcessCBReturnMessage);
  3087.         continue;
  3088.       end;
  3090.       {************************************************************************}
  3091.       if skType = skAddUser then
  3092.       begin
  3093.         RealMessengerX.ClientTCP.ReadBuffer(CBAddUser, SizeOf(CBAddUser));
  3094.         Synchronize(ProcessCBAddUser);
  3095.         continue;
  3096.       end;
  3098.       {************************************************************************}
  3099.       if skType = skSendFileRequest then
  3100.       begin
  3101.         RealMessengerX.ClientTCP.ReadBuffer(CBSendFileRequest, SizeOf(CBSendFileRequest));
  3102.         Synchronize(ProcessCBSendFileRequest);
  3103.         continue;
  3104.       end;
  3106.       {************************************************************************}
  3107.       if skType = skSendFileCancle then
  3108.       begin
  3109.         RealMessengerX.ClientTCP.ReadBuffer(CBSendFileCancle, SizeOf(CBSendFileCancle));
  3110.         Synchronize(ProcessCBSendFileCancle);
  3111.         continue;
  3112.       end;
  3114.       {************************************************************************}
  3115.       if skType = skSendFileStop then
  3116.       begin
  3117.         RealMessengerX.ClientTCP.ReadBuffer(CBSendFileStop, SizeOf(CBSendFileStop));
  3118.         Synchronize(ProcessCBSendFileStop);
  3119.         continue;
  3120.       end;
  3122.       {************************************************************************}
  3123.       if skType = skSendFileResponse then
  3124.       begin
  3125.         RealMessengerX.ClientTCP.ReadBuffer(CBSendFileResponse, SizeOf(CBSendFileResponse));
  3126.         Synchronize(ProcessCBSendFileResponse);
  3127.         continue;
  3128.       end;
  3130.       {************************************************************************}
  3131.       if skType = skSendFilePackage then
  3132.       begin
  3133.         RealMessengerX.ClientTCP.ReadBuffer(CBSendFilePackage, SizeOf(CBSendFilePackage));
  3134.         Synchronize(ProcessCBSendFilePackage);
  3135.         continue;
  3136.       end;
  3138.       {************************************************************************}
  3139.       if skType = skSendFileResult then
  3140.       begin
  3141.         RealMessengerX.ClientTCP.ReadBuffer(CBSendFileResult, SizeOf(CBSendFileResult));
  3142.         Synchronize(ProcessCBSendFileResult);
  3143.         continue;
  3144.       end;
  3146.       {************************************************************************}
  3147.       if skType = skSendFileResume then
  3148.       begin
  3149.         RealMessengerX.ClientTCP.ReadBuffer(CBSendFileResume, SizeOf(CBSendFileResume));
  3150.         Synchronize(ProcessCBSendFileResume);
  3151.         continue;
  3152.       end;
  3154.       {************************************************************************}
  3155.       if skType = skSendFileCompleted then
  3156.       begin
  3157.         RealMessengerX.ClientTCP.ReadBuffer(CBSendFileCompleted, SizeOf(CBSendFileCompleted));
  3158.         Synchronize(ProcessCBSendFileCompleted);
  3159.         continue;
  3160.       end;
  3162.       {************************************************************************}
  3163.       if skType = skAudioRequest then
  3164.       begin
  3165.         RealMessengerX.ClientTCP.ReadBuffer(CBAudioRequest, SizeOf(CBAudioRequest));
  3166.         Synchronize(ProcessCBAudioRequest);
  3167.         continue;
  3168.       end;
  3170.       {************************************************************************}
  3171.       if skType = skAudioResponse then
  3172.       begin
  3173.         RealMessengerX.ClientTCP.ReadBuffer(CBAudioResponse, SizeOf(CBAudioResponse));
  3174.         Synchronize(ProcessCBAudioResponse);
  3175.         continue;
  3176.       end;
  3178.       {************************************************************************}
  3179.       if skType = skAudioCancel then
  3180.       begin
  3181.         RealMessengerX.ClientTCP.ReadBuffer(CBAudioCancel, SizeOf(CBAudioCancel));
  3182.         Synchronize(ProcessCBAudioCancel);
  3183.         continue;
  3184.       end;
  3186.       {************************************************************************}
  3187.       if skType = skAudio then
  3188.       begin
  3189.         RealMessengerX.ClientTCP.ReadBuffer(CBAudio, SizeOf(CBAudio));
  3190.         Synchronize(ProcessCBAudio);
  3191.         continue;
  3192.       end;
  3194.       {************************************************************************}
  3195.       if skType = skAudioStop then
  3196.       begin
  3197.         RealMessengerX.ClientTCP.ReadBuffer(CBAudioStop, SizeOf(CBAudioStop));
  3198.         Synchronize(ProcessCBAudioStop);
  3199.         continue;
  3200.       end;
  3202.       {************************************************************************}
  3203.       if skType = skVideoRequest then
  3204.       begin
  3205.         RealMessengerX.ClientTCP.ReadBuffer(CBVideoRequest, SizeOf(CBVideoRequest));
  3206.         Synchronize(ProcessCBVideoRequest);
  3207.         continue;
  3208.       end;
  3210.       {************************************************************************}
  3211.       if skType = skVideoResponse then
  3212.       begin
  3213.         RealMessengerX.ClientTCP.ReadBuffer(CBVideoResponse, SizeOf(CBVideoResponse));
  3214.         Synchronize(ProcessCBVideoResponse);
  3215.         continue;
  3216.       end;
  3218.       {************************************************************************}
  3219.       if skType = skVideoCancel then
  3220.       begin
  3221.         RealMessengerX.ClientTCP.ReadBuffer(CBVideoCancel, SizeOf(CBVideoCancel));
  3222.         Synchronize(ProcessCBVideoCancel);
  3223.         continue;
  3224.       end;
  3226.       {************************************************************************}
  3227.       if skType = skVideoStop then
  3228.       begin
  3229.         RealMessengerX.ClientTCP.ReadBuffer(CBVideoStop, SizeOf(CBVideoStop));
  3230.         Synchronize(ProcessCBVideoStop);
  3231.         continue;
  3232.       end;
  3234.       {************************************************************************}
  3235.       if skType = skSetBitmapInfo then
  3236.       begin
  3237.         RealMessengerX.ClientTCP.ReadBuffer(CBSetBitmapInfo, SizeOf(CBSetBitmapInfo));
  3238.         Synchronize(ProcessCBSetBitmapInfo);
  3239.         continue;
  3240.       end;
  3242.       {************************************************************************}
  3243.       if skType = skSetCompvars then
  3244.       begin
  3245.         RealMessengerX.ClientTCP.ReadBuffer(CBSetCompvars, SizeOf(CBSetCompvars));
  3246.         Synchronize(ProcessCBSetCompvars);
  3247.         continue;
  3248.       end;
  3250.       {************************************************************************}
  3251.       if skType = skVideo then
  3252.       begin
  3253.         RealMessengerX.ClientTCP.ReadBuffer(CBVideo, SizeOf(CBVideo));
  3254.         Synchronize(ProcessCBVideo);
  3255.         continue;
  3256.       end;
  3258.       {************************************************************************}
  3259.       if skType = skPleaseUseTCP then
  3260.       begin
  3261.         RealMessengerX.ClientTCP.ReadBuffer(CBPleaseUseTCP, SizeOf(CBPleaseUseTCP));
  3262.         Synchronize(ProcessCBPleaseUseTCP);
  3263.         continue;
  3264.       end;
  3266.       {************************************************************************}
  3267.       if skType = skNameAndPasswordChanged then
  3268.       begin
  3269.         RealMessengerX.ClientTCP.ReadBuffer(CBNameAndPasswordChanged, SizeOf(CBNameAndPasswordChanged));
  3270.         Synchronize(ProcessCBNameAndPasswordChanged);
  3271.         continue;
  3272.       end;
  3274.     except
  3275.     end;
  3276.   end;
  3277. end;
  3279. {------------------------------------------------------------------------------}
  3280. procedure TRealMessengerX.ProcessCBVideo(CBVideo: TCBVideo);
  3281. var
  3282.   VideoHandShake: TVideoHandShake;
  3283.   ChatingForm: TChatingForm;
  3284.   RetVal, FPS, SPEED: Integer;
  3285.   SPEEDSTR: string;
  3286. begin
  3287.   VideoHandShake := FindVideoHandShakeByID(CBVideo.Sender);
  3288.   if VideoHandShake = nil then exit;
  3289.   VideoHandShake.VLastGetTicket := GetTickCount;
  3291.   ChatingForm := VideoHandShake.ChatingForm;
  3292.   if ChatingForm = nil then exit;
  3294.   if CBVideo.nSampleNum = 0 then
  3295.   begin
  3296.     VideoHandShake.StartTicket := GetTickCount;
  3297.     VideoHandShake.GetedData := 0;
  3298.     VideoHandShake.GetedFrame := 0;
  3299.   end;
  3301.   if (CBVideo.PackNO = 1) then
  3302.   begin
  3303.     FillChar(VideoHandShake.VideoData, SizeOf(TVideoDataInfo), 0);
  3304.     VideoHandShake.VideoData.bKeyFrame := CBVideo.bKeyFrame;
  3305.     VideoHandShake.VideoData.nSampleNum := CBVideo.nSampleNum;
  3306.     VideoHandShake.VideoData.nUsedSize := CBVideo.nAllSize;
  3307.     VideoHandShake.VideoData.nGetedSize := 0;
  3308.   end;
  3310.   if VideoHandShake.VideoData.nSampleNum <> CBVideo.nSampleNum then exit;
  3311.   if (VideoHandShake.VideoData.nGetedSize <> (CBVideo.PackNO - 1) * SizeOf(CBVideo.Buf)) then exit;
  3313.   CopyMemory(@(VideoHandShake.VideoData.Buf[VideoHandShake.VideoData.nGetedSize]), @(CBVideo.Buf[1]), CBVideo.BufLength);
  3314.   VideoHandShake.VideoData.nGetedSize := VideoHandShake.VideoData.nGetedSize + CBVideo.BufLength;
  3316.   if CBVideo.PackNO = CBVideo.PackCount then
  3317.   begin
  3318.     if (VideoHandShake.VideoData.nUsedSize > 0) and (VideoHandShake.VideoData.nUsedSize < 8180) then
  3319.     begin
  3320.       RetVal := ICDeCompress(A_FCV.hic, 0, @A_FInInfo.bmiHeader, @VideoHandShake.VideoData.Buf[0],
  3321.         @A_FOutInfo.bmiHeader, FOutBuf);
  3322.       if RetVal = ICERR_OK then
  3323.       begin
  3324.         try
  3325.           if VideoForm = nil then
  3326.           begin
  3327.             StretchDIBits(VideoHandShake.pDC,
  3328.               0, 0,
  3329.               160,
  3330.               120,
  3331.               0, 0,
  3332.               A_FOutInfo.bmiHeader.biWidth,
  3333.               A_FOutInfo.bmiHeader.biHeight,
  3334.               FOutBuf, A_FOutInfo, DIB_RGB_COLORS, SRCCOPY);
  3335.           end
  3336.           else
  3337.             StretchDIBits(VideoHandShake.pDC,
  3338.               0, 0,
  3339.               VideoForm.ClientWidth,
  3340.               VideoForm.ClientHeight,
  3341.               0, 0,
  3342.               A_FOutInfo.bmiHeader.biWidth,
  3343.               A_FOutInfo.bmiHeader.biHeight,
  3344.               FOutBuf, A_FOutInfo, DIB_RGB_COLORS, SRCCOPY)
  3345.         except
  3346.         end;
  3348.         VideoHandShake.GetedData := VideoHandShake.GetedData + SizeOf(CBVideo.Buf);
  3349.         VideoHandShake.GetedFrame := VideoHandShake.GetedFrame + 1;
  3350.         if GetTickCount - VideoHandShake.StartTicket > 1000 then
  3351.         begin
  3352.           FPS := VideoHandShake.GetedFrame * 1000 div (GetTickCount - VideoHandShake.StartTicket);
  3353.           SPEED := (VideoHandShake.GetedData * 1000 div (GetTickCount - VideoHandShake.StartTicket));
  3354.           if SPEED > 1024 then
  3355.             SPEEDSTR := IntToStr(SPEED div 1024) + 'K/S'
  3356.           else
  3357.             SPEEDSTR := '1K/S';
  3358.           if VideoForm = nil then
  3359.             ChatingForm.LblFPS.Caption := IntToStr(FPS) + 'FPS，' + SPEEDSTR
  3360.           else
  3361.             VideoForm.Caption := IntToStr(FPS) + 'FPS，' + SPEEDSTR;
  3363.           VideoHandShake.StartTicket := GetTickCount;
  3364.           VideoHandShake.GetedData := 0;
  3365.           VideoHandShake.GetedFrame := 0;
  3366.         end;
  3367.       end;
  3368.       FillChar(VideoHandShake.VideoData, SizeOf(TVideoDataInfo), 0);
  3369.     end;
  3370.   end;
  3371. end;
  3373. {------------------------------------------------------------------------------}
  3374. procedure TRealMessengerX.ProcessCBAudio(CBAudio: TCBAudio);
  3375. var
  3376.   ChatingForm: TChatingForm;
  3377.   AudioHandShake: TAudioHandShake;
  3378.   VideoHandShake: TVideoHandShake;
  3379. begin
  3380.   if not HaveAudioDevice then exit;
  3381.   AudioHandShake := FindAudioHandShakeByID(CBAudio.Sender);
  3382.   if AudioHandShake = nil then
  3383.   begin
  3384.     VideoHandShake := FindVideoHandShakeByID(CBAudio.Sender);
  3385.     VideoHandShake.ALastGetTicket := GetTickCount;
  3386.     ChatingForm := VideoHandShake.ChatingForm;
  3387.   end
  3388.   else
  3389.   begin
  3390.     ChatingForm := AudioHandShake.ChatingForm;
  3391.     AudioHandShake.LastGetTicket := GetTickCount;
  3392.   end;
  3393.   if ChatingForm = nil then exit;
  3395.   if ChatingForm.ImgSpkDisabled.Visible then exit;
  3397.   if GetTickCount - AudioLastRestartTime > 5000 then
  3398.   begin
  3399.     AudioLastRestartTime := GetTickCount;
  3400.     ChatingForm.ACMWaveOut.Reset;
  3401.   end;
  3402.   ChatingForm.ACMWaveOut.PlayBack(@(CBAudio.lpData), CBAudio.dwBufferLength);
  3403. end;
  3405. {------------------------------------------------------------------------------}
  3406. procedure TRealMessengerX.ProcessCBSendFileResult(CBSendFileResult: TCBSendFileResult);
  3407. var
  3408.   TransmitFile: TTransmitFile;
  3409.   performancecounter: Int64;
  3410. begin
  3411.   TransmitFile := FindTransmitFileByBaseID(trim(CBSendFileResult.BaseID));
  3412.   if TransmitFile = nil then exit;
  3413.   if TransmitFile.IsComleted then exit;
  3415.   queryperformancecounter(performancecounter);
  3416.   TransmitFile.SleepValue := (performancecounter - CBSendFileResult.SendTicket) / 10;
  3417.   TransmitFile.LastGetOrResultTicket := GetTickCount;
  3418.   TransmitFile.Send(CBSendFileResult.CurentSize);
  3419. end;
  3421. {------------------------------------------------------------------------------}
  3422. procedure TRealMessengerX.ProcessCBSendFilePackage(CBSendFilePackage: TCBSendFilePackage);
  3423. var
  3424.   TransmitFile: TTransmitFile;
  3425.   Context: MD5Context;
  3426.   MD5CODE: MD5Digest;
  3427. begin
  3428.   MD5Init(Context);
  3429.   MD5Update(Context, PChar(@CBSendFilePackage.Package[1]), CBSendFilePackage.Length);
  3430.   MD5Final(Context, MD5CODE);
  3431.   if not MD5Match(MD5CODE, CBSendFilePackage.MD5CODE) then exit;
  3433.   TransmitFile := FindTransmitFileByBaseID(trim(CBSendFilePackage.BaseID));
  3434.   if TransmitFile = nil then exit;
  3435.   if TransmitFile.IsComleted then exit;
  3436.   TransmitFile.LastGetOrResultTicket := GetTickCount;
  3438.   if not TransmitFile.IsScreen then
  3439.     TransmitFile.FileStream.Position := TransmitFile.FileTable.Count + CBSendFilePackage.Position
  3440.   else
  3441.     TransmitFile.FileStream.Position := CBSendFilePackage.Position;
  3443.   TransmitFile.FileStream.Write(CBSendFilePackage.Package, CBSendFilePackage.Length);
  3444.   TransmitFile.CurentSize := CBSendFilePackage.Position + CBSendFilePackage.Length;
  3445.   TransmitFile.Get(CBSendFilePackage.SendTicket);
  3446. end;
  3448. {------------------------------------------------------------------------------}
  3449. procedure TRealMessengerX.ProcessCBReturnMessage(CBReturnMessage: TCBReturnMessage);
  3450. var
  3451.   iLoop: Integer;
  3452.   CBMessage: TCBMessage;
  3453. begin
  3454.   with MsgReturnCheck.LockList do
  3455.   try
  3456.     for iLoop := Count - 1 downto 0 do
  3457.     begin
  3458.       CBMessage := TCBMessage(Items[iLoop]^);
  3459.       if (CBReturnMessage.Receiver = CBMessage.Sender) and
  3460.         (CBReturnMessage.Sender = CBMessage.Receiver) and
  3461.         (CBReturnMessage.Length = CBMessage.Length) and
  3462.         (CBReturnMessage.SendTicket = CBMessage.SendTicket) then
  3463.       begin
  3464.         MsgReturnCheck.Remove(Items[iLoop]);
  3465.         break;
  3466.       end;
  3467.     end;
  3468.   finally
  3469.     MsgReturnCheck.UnlockList;
  3470.   end;
  3471. end;
  3473. procedure TRealMessengerX.ProcessCBInputing(CBInputing: TCBInputing);
  3474. var
  3475.   ChatingForm: TChatingForm;
  3476. begin
  3477.   ChatingForm := OpenChatingForm(CBInputing.Room, False);
  3478.   if ChatingForm = nil then exit;
  3479.   ChatingForm.ShowInputing(CBInputing.Inputing);
  3480. end;
  3482. {------------------------------------------------------------------------------}
  3483. procedure TRealMessengerX.ProcessCBMessage(CBMessage: TCBMessage);
  3484. var
  3485.   ChatingForm: TChatingForm;
  3486.   iLoop: Integer;
  3487.   PEmployeeData: PEmployee;
  3488.   ReceivedMsgID: PReceivedMsgID;
  3489.   CBReturnMessage: TCBReturnMessage;
  3490.   SendBuffer: array[1..2048] of char;
  3491.   Finded: Boolean;
  3492. begin
  3493.   if (CBMessage.Sender = Me.ID) or (CBMessage.Receiver <> Me.ID) then exit;
  3495.   PEmployeeData := FindEmployeeByID(CBMessage.Sender);
  3496.   if PEmployeeData = nil then exit;
  3498.   Finded := False;
  3499.   if CBMessage.SendTicket <> 0 then
  3500.     with ReceivedMessages.LockList do
  3501.     try
  3502.       for iLoop := Count - 1 downto 0 do
  3503.       begin
  3504.         ReceivedMsgID := Items[iLoop];
  3505.         if (ReceivedMsgID.Sender = CBMessage.Sender) and (ReceivedMsgID.SendTicket = CBMessage.SendTicket) then
  3506.         begin
  3507.           Finded := True;
  3508.           break;
  3509.         end;
  3510.       end;
  3511.     finally
  3512.       ReceivedMessages.UnlockList;
  3513.     end;
  3515.   if CBMessage.SendTicket > 0 then
  3516.   begin
  3517.     CBReturnMessage.Receiver := CBMessage.Sender;
  3518.     CBReturnMessage.Sender := CBMessage.Receiver;
  3519.     CBReturnMessage.Length := CBMessage.Length;
  3520.     CBReturnMessage.SendTicket := CBMessage.SendTicket;
  3521.     SendBuffer[1] := skReturnMessage;
  3522.     CopyMemory(@SendBuffer[2], @CBReturnMessage, SizeOf(CBReturnMessage));
  3523.     if PEmployeeData.MySocket = nil then PEmployeeData.MySocket := TMySocket.Create(PEmployeeData.ID, RealMessengerX.ClientTCP, True);
  3524.     PEmployeeData.MySocket.SendBuffer(SendBuffer, SizeOf(CBReturnMessage) + 1, Finded);
  3525.   end;
  3527.   if not Finded then
  3528.   begin
  3529.     GetMem(ReceivedMsgID, SizeOf(TReceivedMsgID));
  3530.     ReceivedMsgID.Sender := CBMessage.Sender;
  3531.     ReceivedMsgID.SendTicket := CBMessage.SendTicket;
  3532.     ReceivedMessages.Add(ReceivedMsgID);
  3534.     ChatingForm := OpenChatingForm(CBMessage.Room);
  3535.     if ChatingForm = nil then exit;
  3536.     ShowMsg(ChatingForm, ChatingForm.MsgContent, PEmployeeData.Name, CBMessage);
  3537.     if not ChatingForm.Pushed then FlashTray(ChatingForm);
  3538.   end;
  3539. end;
  3541. {------------------------------------------------------------------------------}
  3542. procedure TRealMessengerX.MAVSetsClick(Sender: TObject);
  3543. begin
  3544.   if AVSetForm = nil then AVSetForm := TAVSetForm.Create(Application);
  3545.   try
  3546.     AVSetForm.ShowModal;
  3547.   finally
  3548.     AVSetForm.Free;
  3549.     AVSetForm := nil;
  3550.   end;
  3551. end;
  3553. {------------------------------------------------------------------------------}
  3554. procedure TRealMessengerX.ClientTCPDisconnected(Sender: TObject);
  3555. begin
  3556.   ClientHandleThread.Terminate;
  3557.   ClientLogout();
  3558. end;
  3560. {------------------------------------------------------------------------------}
  3561. procedure TRealMessengerX.ClientTCPConnected(Sender: TObject);
  3562. begin
  3563.   ClientTCP.OnDisconnected := ClientTCPDisconnected;
  3564.   TimerLoging.Enabled := True;
  3565. end;
  3567. procedure TRealMessengerX.TimeCheckTransmitFileErrorTimer(Sender: TObject);
  3568. var
  3569.   iLoop: Integer;
  3570.   TransmitFile: TTransmitFile;
  3571. begin
  3572.   with TransmitFiles.LockList do
  3573.   try
  3574.     if Count = 0 then TimeCheckTransmitFileError.Enabled := False;
  3575.     for iLoop := Count - 1 downto 0 do
  3576.     begin
  3577.       try
  3578.         TransmitFile := Items[iLoop];
  3579.         if (TransmitFile.OnMovingFile = False) and TransmitFile.IsAccepted then
  3580.         begin
  3581.           if ((GetTickCount - TransmitFile.LastGetOrResultTicket) > TimeCheckTransmitFileError.Interval * 3) then
  3582.             TransmitFile.Error
  3583.           else if ((GetTickCount - TransmitFile.LastGetOrResultTicket) > TimeCheckTransmitFileError.Interval) then
  3584.             TransmitFile.MySocket.MySocketCategory := scTCP;
  3585.         end;
  3586.       except
  3587.       end;
  3588.     end;
  3589.   finally
  3590.     TransmitFiles.UnlockList;
  3591.   end;
  3592. end;
  3594. procedure TRealMessengerX.FormResize(Sender: TObject);
  3595. begin
  3596.   if TrevUserList.Visible then ChangeLblMyStateCaption;
  3597. end;
  3599. procedure TRealMessengerX.MsgTimerTimer(Sender: TObject);
  3600. var
  3601.   Buffer: array[1..2048] of char;
  3602.   iLoop, jLoop: Integer;
  3603.   PCB: PCBMessage;
  3604.   EmployeeData: PEmployee;
  3605.   ChatingForm: TChatingForm;
  3606. begin
  3607.   if not ClientTCP.Connected then exit;
  3608.   with MsgReturnCheck.LockList do
  3609.   try
  3610.     if Count = 0 then MsgTimer.Enabled := False;
  3611.     for iLoop := Count - 1 downto 0 do
  3612.     begin
  3613.       PCB := Items[iLoop];
  3614.       if GetTickCount - PCB.SendTicket > MsgTimer.Interval then
  3615.       begin
  3616.         ChatingForm := OpenChatingForm(PCB.Room);
  3617.         EmployeeData := FindEmployeeByID(PCB.Receiver);
  3618.         if ChatingForm = nil then continue;
  3619.         if EmployeeData = nil then continue;
  3620.         if EmployeeData.MySocket = nil then EmployeeData.MySocket := TMySocket.Create(EmployeeData.ID, RealMessengerX.ClientTCP, True);
  3622.         if GetTickCount - PCB.SendTicket > MsgTimer.Interval * 6 then
  3623.         begin
  3624.           ShowMsg(ChatingForm, ChatingForm.MsgContent, '【以下消息没有成功发送给收件人“' + EmployeeData.Name + '”（等待反馈超时）】', PCB^);
  3625.           if not ChatingForm.Pushed then FlashTray(ChatingForm);
  3626.           MsgReturnCheck.Remove(PCB);
  3627.           FreeMem(PCB, SizeOf(TCBMessage));
  3628.         end
  3629.         else
  3630.         begin
  3631.           Buffer[1] := skMessage;
  3632.           CopyMemory(@Buffer[2], PCB, SizeOf(PCB^));
  3633.           if GetTickCount - PCB.SendTicket > MsgTimer.Interval * 3 then EmployeeData.MySocket.MySocketCategory := scTCP; {重试3次失败，启用TCP进行通讯}
  3634.           EmployeeData.MySocket.SendBuffer(Buffer, SizeOf(PCB^) + 1);
  3635.         end;
  3636.       end;
  3637.     end;
  3638.   finally
  3639.     MsgReturnCheck.UnlockList;
  3640.   end;
  3641. end;
  3643. procedure TRealMessengerX.KeepP2PSessionTimerTimer(Sender: TObject);
  3644. var
  3645.   MySocket: TMySocket;
  3646.   iLoop: Integer;
  3647. begin
  3648.   with MySockets.LockList do
  3649.   try
  3650.     for iLoop := Count - 1 downto 0 do
  3651.     begin
  3652.       try
  3653.         MySocket := Items[iLoop];
  3654.         MySocket.KeepP2PSession;
  3655.       except
  3656.       end;
  3657.     end;
  3658.   finally
  3659.     MySockets.UnlockList;
  3660.   end
  3661. end;
  3663. procedure TRealMessengerX.TimerLogingTimer(Sender: TObject);
  3664. begin
  3665.   TimerLoging.Enabled := False;
  3666.   if TrevUserList.Visible = False then
  3667.   begin
  3668.     ClientLogout;
  3669.     CoolTrayIcon.ShowBalloonHint('连接失败', '未能连接至服务器，请检查网络设置！', bitError, 10);
  3670.   end;
  3671. end;
  3673. procedure TRealMessengerX.TimeCheckAVErrorTimer(Sender: TObject);
  3674. var
  3675.   AudioHandShake: TAudioHandShake;
  3676.   VideoHandShake: TVideoHandShake;
  3677.   iLoop, ACount, VCount: Integer;
  3678.   CBPleaseUseTCP: TCBPleaseUseTCP;
  3679.   Buffer: array[1..2048] of char;
  3680. begin
  3681.   with AudioHandShakes.LockList do
  3682.   try
  3683.     ACount := Count;
  3684.     for iLoop := Count - 1 downto 0 do
  3685.     begin
  3686.       AudioHandShake := Items[iLoop];
  3687.       if AudioHandShake.IsAccepted and ((GetTickCount - AudioHandShake.LastGetTicket) > TimeCheckAVError.Interval) then
  3688.       begin
  3689.         CBPleaseUseTCP.Receiver := AudioHandShake.ID;
  3690.         CBPleaseUseTCP.Sender := Me.ID;
  3691.         CBPleaseUseTCP.ForAudioAudio := True;
  3692.         CBPleaseUseTCP.ForVideoAudio := False;
  3693.         CBPleaseUseTCP.ForVideoVideo := False;
  3694.         Buffer[1] := skPleaseUseTCP;
  3695.         CopyMemory(@Buffer[2], @CBPleaseUseTCP, SizeOf(CBPleaseUseTCP));
  3696.         ClientTCP.WriteBuffer(Buffer, SizeOf(CBPleaseUseTCP) + 1, True);
  3697.       end;
  3698.     end;
  3699.   finally
  3700.     AudioHandShakes.UnlockList
  3701.   end;
  3703.   with VideoHandShakes.LockList do
  3704.   try
  3705.     VCount := Count;
  3706.     for iLoop := Count - 1 downto 0 do
  3707.     begin
  3708.       VideoHandShake := Items[iLoop];
  3709.       if VideoHandShake.IsAccepted and FindEmployeeByID(VideoHandShake.ID).HaveAudioDevice and ((GetTickCount - VideoHandShake.ALastGetTicket) > TimeCheckAVError.Interval) then
  3710.       begin
  3711.         CBPleaseUseTCP.Receiver := VideoHandShake.ID;
  3712.         CBPleaseUseTCP.Sender := Me.ID;
  3713.         CBPleaseUseTCP.ForAudioAudio := False;
  3714.         CBPleaseUseTCP.ForVideoAudio := True;
  3715.         CBPleaseUseTCP.ForVideoVideo := False;
  3716.         Buffer[1] := skPleaseUseTCP;
  3717.         CopyMemory(@Buffer[2], @CBPleaseUseTCP, SizeOf(CBPleaseUseTCP));
  3718.         ClientTCP.WriteBuffer(Buffer, SizeOf(CBPleaseUseTCP) + 1, True);
  3719.       end;
  3721.       if VideoHandShake.IsAccepted and FindEmployeeByID(VideoHandShake.ID).HaveVideoDevice and ((GetTickCount - VideoHandShake.VLastGetTicket) > TimeCheckAVError.Interval) then
  3722.       begin
  3723.         CBPleaseUseTCP.Receiver := VideoHandShake.ID;
  3724.         CBPleaseUseTCP.Sender := Me.ID;
  3725.         CBPleaseUseTCP.ForAudioAudio := False;
  3726.         CBPleaseUseTCP.ForVideoAudio := False;
  3727.         CBPleaseUseTCP.ForVideoVideo := True;
  3728.         Buffer[1] := skPleaseUseTCP;
  3729.         CopyMemory(@Buffer[2], @CBPleaseUseTCP, SizeOf(CBPleaseUseTCP));
  3730.         ClientTCP.WriteBuffer(Buffer, SizeOf(CBPleaseUseTCP) + 1, True);
  3731.       end;
  3732.     end;
  3733.   finally
  3734.     VideoHandShakes.UnlockList
  3735.   end;
  3737.   if (ACount = 0) and (VCount = 0) then TimeCheckAVError.Enabled := False;
  3738. end;
  3740. procedure TRealMessengerX.MChangeNameAndPasswordClick(Sender: TObject);
  3741. begin
  3742.   if ChangeNameAndPasswordForm <> nil then exit;
  3743.   ChangeNameAndPasswordForm := TChangeNameAndPasswordForm.Create(Self);
  3744.   ChangeNameAndPasswordForm.Show;
  3745. end;
  3747. procedure TRealMessengerX.bsSkinMenuSpeedButton2Click(Sender: TObject);
  3748. var
  3749.   Point: TPoint;
  3750. begin
  3751.   Point.X := 0;
  3752.   Point.Y := LblFile.Height;
  3753.   PopHelp.Popup(LblFile.ClientToScreen(Point).X - 4, LblFile.ClientToScreen(Point).Y + 2);
  3754. end;
  3756. procedure TRealMessengerX.N14Click(Sender: TObject);
  3757. var
  3758.   Filepath, FileName: string;
  3759. begin
  3760.   Filepath := ExtractFilePath(Application.ExeName);
  3761.   FileName := Filepath + 'help.chm';
  3762.   if fileexists(FileName) then
  3763.     ShellExecute(Handle, 'open', PChar(FileName), nil, PChar(Filepath), sw_ShowNormal);
  3764. end;
  3766. procedure TRealMessengerX.N17Click(Sender: TObject);
  3767. var
  3768.   Filepath, FileName: string;
  3769. begin
  3770.   Filepath := ExtractFilePath(Application.ExeName);
  3771.   FileName := Filepath + 'update.exe';
  3772.   try
  3773.     if fileexists(FileName) then
  3774.       ShellExecute(Handle, 'open', PChar(FileName), nil, PChar(Filepath), SW_SHOW);
  3775.     MExit.click;
  3776.   except
  3778.   end;
  3779. end;
  3781. procedure TRealMessengerX.N16Click(Sender: TObject);
  3782. begin
  3783.   AboutForm := TAboutForm.Create(Self);
  3784.   try
  3785.     AboutForm.ShowModal;
  3786.   finally
  3787.     AboutForm.Free;
  3788.   end;
  3789. end;
  3791. end.