unit MainFrm;
interface
{$INCLUDE LXTalk.inc}
uses
SingleBorderHintWindow, HardwareID, WinSvc, HttpApp, RealICQSkinFrm, MyUtils,
GIFImage, MMSystem, RealICQUtils, RealICQDBHistory, Windows, Messages,
SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus,
ComCtrls, ExtCtrls, ImgList, Buttons, ToolWin, StdCtrls, OleCtrls, SHDocVw,
MSHTML, XMLDoc, XMLIntf, StrUtils, ActiveX, ShellAPI, ActnMan, ActnList,
XPStyleActnCtrls, ActnCtrls, ActnMenus, ActnColorMaps, RealICQNavigater,
RealICQContacterListView, RealICQContacterTreeView, RealICQUIColor,
RealICQPageControl, RealICQColors, MD5, WNDES, FileCtrl, StdActns,
RealICQClient, StdStyleActnCtrls, ExtDlgs, RealICQButton, ActnPopup,
CustomizeDlg, MyInputBoxFrm, RealICQSpeedButton, AppEvnts, xFonts, jpeg,
DateUtils, IniFiles, RealICQMultiLanguage, Math, Types,
RealICQNetWorkDiskClient, Tabs, RealICQSingleImageButton,
RealICQNoBorderPageControl, ResponsionStreamTransmitter,
NetWorkFileTransmitter, TransmitDirection, DESUnit, BitmapButton, Registry,
PsAPI, TLHelp32, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, QueryIpWry, RealICQHoverImage, XXTEA, AddUserFrm, AddGroupFrm,
AddrBookUserFrm, ImportGuideFrm, DownloadFileFromWeb, MessageBoxFrm, aeslib,
pngimage, SuperObject, EncdDecd, IdMultiPartFormData, cefvcl, RealICQModel,
IdScheduler, IdSchedulerOfThread, IdSchedulerOfThreadPool;
const
//http://10.41.220.59:8080/account/sso?LoginName=&Password=&URL=/Widgets/home/index
//老的
BaseURL = '/login.aspx?LoginName=%s&Password=%s&URL=%s';
//新的
NewBaseURL = '/account/sso?LoginName=%s&Password=%s&URL=%s';
LoginURL = '';
InBoxURL = ''; //'/widgets/home/index';
ReadMessageURL = '/Messages/Default.aspx?url=';
GetWeatherMessage = WM_APP + 157;
//DefaultUpdateLogPostUrl = 'http://360.myreda.com/Insert.aspx';
MainTabImageDir = 'Images\TabImage\';
SMSURL = '/Messages/SMSManage.aspx';
MiniPageURL = '/Messages/MiniPage.aspx?LoginName=%s';
AddRemarkURL = '/Messages/Default.aspx?url=SMSManage.aspx?url=EditMemorandum.aspx?Contents=%s';
SNSHomePage = '/SNS/Login.aspx?LoginName=%s&Password=%s&DestUser=%s';
ShowSNS = False;
TeamSharePic: string = 'Images\Share.png';
LoginingGif: string = 'Images\Logining.gif';
DefaultIcon: string = 'Images\Small\DefaultIcon.ico';
TeamIcon: string = 'Images\Small\Team.ico';
SystemMessageIcon: string = 'Images\Small\SystemMessage.ico';
SMSMessageIcon: string = 'Images\Small\SMS.ico';
SNSIcon: string = 'Images\Small\SNS.ico';
CancelIcon: string = 'Images\Cancel.ico';
UpBMP: string = 'Images\Upload.png';
DownBMP: string = 'Images\Download.png';
SimpleMessagePicture: string = 'Images\SysMsg\SimpleMessage.bmp';
SystemMessagePicture: string = 'Images\SysMsg\SystemMessage.bmp';
TeamPicture: string = 'Images\Small\Team.bmp';
SearchPicture: string = 'Images\Search.bmp';
Action_Paste_GIF: string = 'Images\action_paste.png';
WorldCamPicture: string = 'Images\worldCam.jpg';
//VideoBorderBig: String = 'Images\VideoBorderBig.bmp';
//VideoBorderMiddle: String = 'Images\VideoBorderMiddle.bmp';
//VideoBorderSmall: String = 'Images\VideoBorderSmall.bmp';
DefaultTeamPicture: string = 'Images\Small\TeamHead.png';
DefaultPictureSecurity: string = 'Images\Small\Security.bmp';
DefaultPicture: string = 'Images\Small\DefaultHeadImage_96.png';
DefaultPictureBig44: string = 'Images\Small\DefaultHeadImage_44.png';
DefaultPictureBig: string = 'Images\Small\DefaultHeadImage_48.png';
DefaultPictureMiddle: string = 'Images\Small\DefaultHeadImage_24.png';
DefaultPictureSmall: string = 'Images\Small\DefaultHeadImage_16.png';
DefaultPictureBigOffline: string = 'Images\Small\DefaultHeadImageOffline_48.png';
DefaultPictureMiddleOffline: string = 'Images\Small\DefaultHeadImageOffline_24.png';
DefaultPictureSmallOffline: string = 'Images\Small\DefaultHeadImageOffline_16.png';
LeavePicture: string = 'Images\Small\Leave.bmp';
CameraIcon: string = 'Images\Small\Camera.ico';
CameraIconBitmap: string = 'Images\Small\Camera.bmp';
SelectedItemBackgroud: string = 'Images\Small\ItemBack.bmp';
AddFriendIcon: string = 'Images\Small\AddFriend.ico';
TelephoneIcon: string = 'Images\Small\Telephone.ico';
MobilePhoneIcon: string = 'Images\Small\MobilePhone.ico';
EmailIcon: string = 'Images\Small\Email.ico';
SMSIcon: string = 'Images\Small\SMS.ico';
SMSBMP: string = 'Images\Small\SMS.bmp';
SMSSendOK: string = 'Images\SMSSendOK.ico';
SMSSending: string = 'Images\SMSSending.gif';
SMSSendError: string = 'Images\SMSSendError.ico';
BranchExpandedPicture: string = 'Images\OpenFolder.ico';
BranchCollapsedPicture: string = 'Images\CloseFolder.ico';
BranchCollapsedBMP: string = 'Images\CloseFolder.png';
BranchClosedButtonPicture: string = 'Images\ClosedButton.bmp';
BranchOpenedButtonPicture: string = 'Images\OpenedButton.bmp';
GroupOpenedButtonPicture: string = 'Images\FriendOpenedButton.bmp';
GroupClosedButtonPicture: string = 'Images\FriendClosedButton.bmp';
ScrollBarBottomButtonPicture: string = 'Images\VScrollBar\ScrollBarBottomButton.bmp';
ScrollBarBottomButtonDownPicture: string = 'Images\VScrollBar\ScrollBarBottomButtonDown.bmp';
ScrollBarBottomButtonHoverPicture: string = 'Images\VScrollBar\ScrollBarBottomButtonHover.bmp';
ScrollBarTopButtonPicture: string = 'Images\VScrollBar\ScrollBarTopButton.bmp';
ScrollBarTopButtonDownPicture: string = 'Images\VScrollBar\ScrollBarTopButtonDown.bmp';
ScrollBarTopButtonHoverPicture: string = 'Images\VScrollBar\ScrollBarTopButtonHover.bmp';
ScrollBarTrackButtonBottomPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonBottom.bmp';
ScrollBarTrackButtonBottomDownPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonBottomDown.bmp';
ScrollBarTrackButtonBottomHoverPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonBottomHover.bmp';
ScrollBarTrackButtonMiddlePicture: string = 'Images\VScrollBar\ScrollBarTrackButtonMiddle.bmp';
ScrollBarTrackButtonMiddleDownPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonMiddleDown.bmp';
ScrollBarTrackButtonMiddleHoverPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonMiddleHover.bmp';
ScrollBarTrackButtonTopPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonTop.bmp';
ScrollBarTrackButtonTopDownPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonTopDown.bmp';
ScrollBarTrackButtonTopHoverPicture: string = 'Images\VScrollBar\ScrollBarTrackButtonTopHover.bmp';
ScrollBackgroundPicture: string = 'Images\VScrollBar\ScrollBackground.bmp';
ScrollBarButtonPicture: string = 'Images\VScrollBar\MiddleButton.bmp';
ConfigXMLFilePath: string = 'XML\';
UpdateLogXMLFile: string = 'Online.xml';
GroupConfigXMLFile: string = 'GroupConfig.XML';
StyleConfigXMLFile: string = 'StyleConfig.XML';
DefaultConfigXMLFile: string = 'DefaultConfig.XML';
InputConfigXMLFile: string = 'InputConfig.XML';
HintAndSoundConfigXMLFile: string = 'HintAndSoundConfig.XML';
ReceiveFileConfigXMLFile: string = 'ReceiveFileConfig.XML';
SystemMessagesCounterXMLFile: string = 'SystemMessagesCounter.XML';
SafeConfigXMLFile: string = 'SafeConfig.XML';
AutoUpdateConfigXMLFile: string = 'AutoUpdateConfig.XML';
WindowColorsXMLFile: string = 'WindowColors.XML';
BackGroundImagesXMLFile: string = 'BackGroundImages.XML';
HotKeyConfigXMLFile: string = 'HotKeyConfig.XML';
WebPanelsXMLFile: string = 'WebPanels.XML';
OfflineAutoResponseConfigXMLFile: string = 'OfflineAutoResponseConfig.XML';
AddrBookConfig: string = 'AddrBookConfig.XML';
SysMsgInterfaceConfig: string = 'SysMsgInterfaceConfig.XML';
MessageHistoryDBFile: string = 'Users\History.dat';
PersonalMessageHistoryDBFile: string = 'MessageHistory.DAT';
FaceSmallBMP: string = '_SmallBMP';
FacePreviewBMP: string = '_PreviewBMP';
FaceSmallSize: Integer = 28;
FacePreviewSize: Integer = 92;
ShakeWindowSound: string = 'Sound\nudge.wav';
//未读消息类型，未读消息集合（StringList）中的字符串值为以下常量的值时,表示为特殊的系统消息
TeamMessageID: string = '_____________________________________TeamMessage_';
SystemMessageID: string = '___________________________________SystemMessage_';
SMSMessageID: string = '______________________________________SMSMessage_';
AVSetExeFile: string = 'Plugin\AVSet.EXE';
HelpCHMFile: string = 'HELP.CHM';
SystemFaceGroup: string = '默认表情';
NOFaceCategory: string = '未分组表情';
type
TInvokeDLLForm = function(App: TApplication; hWnd: THandle; pCall: Pointer; AReceiver: PChar; AColor: TColor): TForm; stdcall;
TWebPanel = class;
TSystemMessageType = (smSimple = 1, smSystemMessage = 2);
TRecvFileSafeLevel = (fsHigh = 0, fsMiddle = 1, fsLow = 2);
THidePosition = (hpNone = 0, hpLeft = 1, hpTop = 2, hpRight = 3);
//定义保存通讯录组和用户的数据结构
TManageGroupMessage = class
private
MessageId: string;
FGroupID: string;
FParentID: string;
FGroupName: string;
end;
TManageGroupMemberMessage = class
private
MessageId: string;
FId: string;
FDisplayName: string;
FNickName: string;
FMobile: string;
FTel: string;
FEmail: string;
FRemark: string;
FGroupId: string;
end;
TServerInfo = class
public
ServerId, ServerName: string;
end;
//检测指定的进程是否运行
TCheckRunProcessThread = class(TThread)
private
ProgramName: string;
ProcessPath: string;
protected
function GetProcessPath(ProcessID: DWORD): string;
function FindProcess(AFileName: string): boolean;
procedure Execute; override;
public
constructor Create(AProgramName, AProcessPath: string);
end;
TThreadPost = class(TThread) //以Post方式提交数据到web页面线程类。
private
FUrl: string;
FContent: string;
protected
procedure Execute; override;
public
constructor Create(URL, Content: string); overload;
end;
TUploadMission = class;
TNDMissionType = (mtDir, mtFile);
TMainForm = class(TRealICQSkinForm)
actLoginAs: TAction;
actLogout: TAction;
actPersonalSet: TAction;
actChangePass: TAction;
actClose: TAction;
actOnline: TAction;
actHidden: TAction;
actOffline: TAction;
actBusy: TAction;
actMute: TAction;
actLeave: TAction;
actOtherState: TAction;
actFindUsers: TAction;
actSaveList: TAction;
actLoadList: TAction;
actShowBigHeadImage: TAction;
actShowSmallHeadImage: TAction;
actShowNormalHeadImage: TAction;
actShowLoginName: TAction;
actShowDisplayName: TAction;
actShowAllName: TAction;
actAlwaysOnTop: TAction;
actMsgManager: TAction;
actAVSet: TAction;
actOptions: TAction;
actHelp: TAction;
actAbout: TAction;
ImgLstPageControl: TImageList;
ActionManager: TActionManager;
ColorDialog: TColorDialog;
actQuit: TAction;
RealICQClient: TRealICQClient;
actReg: TAction;
actConnectSet: TAction;
ppUserItemRightMenu: TPopupActionBar;
actSendMessage: TAction;
actDelFriend: TAction;
miSendMessage: TMenuItem;
N1: TMenuItem;
miDelFriend: TMenuItem;
actShowGroup: TAction;
actGroupManager: TAction;
actShowMiddleHeadImage: TAction;
actRemoveUser: TAction;
actShowStrangers: TAction;
actShowBlacklists: TAction;
actShowTeams: TAction;
actShowLatests: TAction;
ppChangeStates: TPopupActionBar;
O1: TMenuItem;
H1: TMenuItem;
N3: TMenuItem;
N5: TMenuItem;
N10: TMenuItem;
ImgLstTrayIcon: TImageList;
ppTrayIcon: TPopupActionBar;
MenuItem12: TMenuItem;
REALICQ1: TMenuItem;
X1: TMenuItem;
M1: TMenuItem;
S1: TMenuItem;
I1: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
actOpenMainForm: TAction;
TimerForCheckDblClick: TTimer;
ppColors: TPopupActionBar;
MenuItem18: TMenuItem;
miMoreColors: TMenuItem;
ImgLstColors: TImageList;
pnlAll: TPanel;
actSeeInformation: TAction;
miSeeUserInformation: TMenuItem;
N21: TMenuItem;
miSkins: TMenuItem;
pnlLogout: TPanel;
pnlWorkArea: TPanel;
pnlMiddle: TPanel;
pnlClient: TPanel;
TrayIcon: TTrayIcon;
actShowGIFInMailForm: TAction;
actShowGIFInTalkingForm: TAction;
TimerForFlashTrayIcon: TTimer;
ImgLstForFlashTrayIcon: TImageList;
ApplicationEvents: TApplicationEvents;
actCustomFacesManager: TAction;
actOpenRecvFileDir: TAction;
actCreateTeam: TAction;
actSendTeamMessage: TAction;
actSeeTeamInformation: TAction;
actQuitTeam: TAction;
actDisbandTeam: TAction;
actQuitOrDisbandTeams: TAction;
pnlAdvertisement: TPanel;
pnlForWebBrowser: TPanel;
WebBrowserForAdvertisement: TWebBrowser;
pnlForHideWebBrowser: TPanel;
TimerForShowSystemMessage: TTimer;
actShowHistory: TAction;
miShowHistory: TMenuItem;
actShowTeamHistory: TAction;
imgLogoutBK: TImage;
imgLogoutBKTop: TImage;
lblLoginNameTitle: TLabel;
spLoginNameBorder: TShape;
edLoginName: TEdit;
lblLoginState: TLabel;
lblPasswordTitle: TLabel;
edPassword: TEdit;
spPasswordBorder: TShape;
lblLoginStateTitle: TLabel;
spbLoginState: TRealICQSpeedButton;
spbSavePassword: TRealICQSpeedButton;
spbAutoLogin: TRealICQSpeedButton;
lblRemoveMyLoginInfo: TLabel;
lblNetworkConfig: TLabel;
lblRegister: TLabel;
ppLoginedUsers: TPopupActionBar;
MenuItem4: TMenuItem;
miClearLoginHistory: TMenuItem;
ImgLstCheckStates: TImageList;
ppLoginStates: TPopupActionBar;
miOnline: TMenuItem;
lblReConnect: TLabel;
actChangeRemark: TAction;
M2: TMenuItem;
actShowRemark: TAction;
TimerForCheckLogoutTimeout: TTimer;
ImgLstForLogining: TImageList;
TimerForLogining: TTimer;
actShowTree: TAction;
pnlWebSearch: TPanel;
pnlWebSearchSplit: TPanel;
ppContacterViewStyle: TPopupActionBar;
Z1: TMenuItem;
A1: TMenuItem;
D1: TMenuItem;
L1: TMenuItem;
P1: TMenuItem;
N22: TMenuItem;
S2: TMenuItem;
M3: TMenuItem;
B1: TMenuItem;
N23: TMenuItem;
S3: TMenuItem;
B2: TMenuItem;
N24: TMenuItem;
G1: TMenuItem;
M4: TMenuItem;
N25: TMenuItem;
N26: TMenuItem;
T1: TMenuItem;
btLogin: TRealICQButton;
ppLanguages: TPopupActionBar;
imgLogo: TImage;
TimerForHideMainForm: TTimer;
//TimerForShowMainForm: TTimer;
RealICQNetWorkDiskClient: TRealICQNetWorkDiskClient;
ppNetWorkFile: TPopupActionBar;
miNDNewDir: TMenuItem;
miNDDelete: TMenuItem;
N28: TMenuItem;
miNDRename: TMenuItem;
pnlMiddleClient: TPanel;
pnlMiddleRight: TPanel;
Spl: TSplitter;
pnlMuiltiWeb: TPanel;
pnlMuiltWebStatus: TPanel;
lblIEStatus: TLabel;
pnlMuiltiWebToolbar: TPanel;
spbPrev: TRealICQSpeedButton;
spbNext: TRealICQSpeedButton;
spbStop: TRealICQSpeedButton;
spbRefresh: TRealICQSpeedButton;
spbAddToNA: TRealICQSpeedButton;
Label2: TLabel;
spbGo: TRealICQSingleImageButton;
cbxURLInputer: TComboBoxEx;
TabSetMuiltWeb: TTabSet;
shpWebStatus: TShape;
shpWebLeftBorder: TShape;
UploadFileOpenDialog: TOpenDialog;
ppNetWorkMisson: TPopupActionBar;
miNDCancel: TMenuItem;
DownloadFileSaveDialog: TSaveDialog;
miNDDownload: TMenuItem;
pgcMultiWeb: TRealICQNoBorderPageControl;
ImgLstForShowHideRight: TImageList;
ImgLstForIEAddress: TImageList;
spbWebClose: TRealICQSpeedButton;
imgWebToolBack: TImage;
shpWebRightBorder: TShape;
sbpNewWebTab: TRealICQSpeedButton;
Bevel5: TBevel;
actOfflieAutoResponse: TAction;
L3: TMenuItem;
imgBottomMenu: TImage;
btMainMenu: TBitmapButton;
spbAddFriend: TRealICQSpeedButton;
pgcMainWorkArea: TTRealICQPageControl;
tsContacters: TTabSheet;
tsAddrBook: TTabSheet;
tsNetWorkDisk: TTabSheet;
pnlAddrBook: TPanel;
pnlNDStateBar: TPanel;
lblNDState: TLabel;
lblNDSpaceSize: TLabel;
pnlNDToolBar: TPanel;
imgNDToolbarBack: TImage;
spbNDNewDir: TRealICQSpeedButton;
spbNDDelete: TRealICQSpeedButton;
spbNDMoveUp: TRealICQSpeedButton;
spbNDUpload: TRealICQSpeedButton;
spbNDDownload: TRealICQSpeedButton;
Bevel1: TBevel;
Bevel2: TBevel;
spbNDConnect: TRealICQSpeedButton;
Bevel4: TBevel;
Bevel3: TBevel;
spbNDRefresh: TRealICQSpeedButton;
spbNDCancelAll: TRealICQSpeedButton;
spbNDDisconnect: TRealICQSpeedButton;
pnlNetWorkFiles: TPanel;
shpNDDirBorder: TShape;
edNDDir: TEdit;
pnlNDFiles: TPanel;
SplitterNDMissions: TSplitter;
pnlNDMissions: TPanel;
PageControlNDMission: TRealICQNoBorderPageControl;
tsUploadingFiles: TTabSheet;
tsDownloadingFiles: TTabSheet;
TabSetNDMissions: TTabSet;
pnlTop: TPanel;
imgTitleBackMiddle: TImage;
shpHeadBack: TShape;
imgHead: TImage;
imgLeave: TImage;
spbDisplayName: TRealICQSpeedButton;
spbWatchword: TRealICQSpeedButton;
shpWatchwordBorder: TShape;
imgHeadImageBorder: TImage;
spbSelUIColor: TRealICQSpeedButton;
spbEmail: TRealICQSpeedButton;
sbpSMS: TRealICQSpeedButton;
edWatchword: TEdit;
WebBrowserForEMail: TWebBrowser;
spbHistroyMessage: TRealICQSpeedButton;
imgLstContacterPageCtrl: TImageList;
edFilterKeyword: TEdit;
spbContacterViewStyle: TRealICQSpeedButton;
spbCancelFilter: TRealICQSpeedButton;
imgWeather: TImage;
ppMainMenu: TPopupActionBar;
miOpenRecvFileDir: TMenuItem;
miCustomFacesManager: TMenuItem;
miAVSet: TMenuItem;
N31: TMenuItem;
miLoginAs: TMenuItem;
miSet: TMenuItem;
miLogOut: TMenuItem;
miQuit: TMenuItem;
lblWeather: TLabel;
lblWeatheren: TLabel;
shpFilterBorder: TShape;
pnlToolBar: TPanel;
SysMsg: TRealICQHoverImage;
MyContacters: TRealICQHoverImage;
MyTeam: TRealICQHoverImage;
MyFriend: TRealICQHoverImage;
Latests: TRealICQHoverImage;
pnlSearch: TPanel;
ShpLeft: TShape;
ShpRight: TShape;
ShpBottom: TShape;
ScrollBoxSearchUser: TScrollBox;
spbPersonManage: TRealICQSpeedButton;
MyContactersIcon: TRealICQHoverImage;
SysMsgIcon: TRealICQHoverImage;
MyFriendIcon: TRealICQHoverImage;
MyTeamIcon: TRealICQHoverImage;
LatestsIcon: TRealICQHoverImage;
lblSearchResult: TLabel;
lblWeatherCity: TLabel;
tsCustomerService: TTabSheet;
pnlCustomerServiceStatus: TPanel;
lblCustomerServiceStatus: TLabel;
Panel1: TPanel;
ImageForCustomerTop: TImage;
btCustomerLogin: TRealICQSpeedButton;
Bevel8: TBevel;
btCustomerLogout: TRealICQSpeedButton;
btCustomerDisplayName: TRealICQSpeedButton;
ppChangeCustomerState: TPopupActionBar;
MenuItem5: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
MenuItem13: TMenuItem;
MenuItem15: TMenuItem;
MenuItem16: TMenuItem;
MenuItem17: TMenuItem;
MenuItem19: TMenuItem;
MenuItem21: TMenuItem;
MenuItem22: TMenuItem;
tsCustomers: TTabSheet;
pnlCustomer: TPanel;
ppServerList: TPopupActionBar;
MenuItem20: TMenuItem;
spbTelMeeting: TRealICQSpeedButton;
ppSelCallTel: TPopupActionBar;
miCallMobile: TMenuItem;
miCallTel: TMenuItem;
miChangePwd: TMenuItem;
pnlAddrBkStateBar: TPanel;
imgAddrBookToolbarBack: TImage;
spbAddGroupUser: TRealICQSpeedButton;
spbAddGroup: TRealICQSpeedButton;
spbImportGroupUser: TRealICQSpeedButton;
ScrollBoxAddrBook: TScrollBox;
ppAddrBookList: TPopupActionBar;
miAddGroup: TMenuItem;
miUpdateGroup: TMenuItem;
miDelGroup: TMenuItem;
miAddGroupUser: TMenuItem;
miUpdateGroupUser: TMenuItem;
miDelGroupUser: TMenuItem;
miCut: TMenuItem;
miPaste: TMenuItem;
pnlForTopMessage: TPanel;
ShpHint: TShape;
spbShowNotReadMessage: TRealICQSpeedButton;
TimerForGetBranchOnlineStates: TTimer;
TimerForGetBranchUsersOnlineStates: TTimer;
btPrevLog: TRealICQSpeedButton;
btNextLog: TRealICQSpeedButton;
lblLogs: TLabel;
lblLogsTitle: TLabel;
TimerForShowSystemNotices: TTimer;
btShowMiniPage: TRealICQSpeedButton;
miSetRemark: TMenuItem;
N29: TMenuItem;
miImportGroupUser: TMenuItem;
miGoSpace: TMenuItem;
Label3: TLabel;
pnlGroups: TPanel;
pnlMoreUser: TPanel;
ImgLoadingMoreBranchs: TImage;
pnlSelectServer: TPanel;
shpSearchMoreUser: TShape;
spServerListBorder: TShape;
spbSelectServer: TRealICQSpeedButton;
spbRefreshBranchUsers: TRealICQSpeedButton;
edtSearchMoreUser: TEdit;
edServerList: TEdit;
pnlSearchMoreUser: TPanel;
ShpSearchLeft: TShape;
ShpSearchRight: TShape;
ShpSearchBottom: TShape;
LblSearchHint: TLabel;
ImgLogining: TImage;
ScrollBoxSearchMoreUser: TScrollBox;
ScrollBoxMoreUser: TScrollBox;
pnlTeams: TPanel;
spbFindTeam: TRealICQSpeedButton;
spbCreateTeam: TRealICQSpeedButton;
pnlTemp: TPanel;
ScrollBoxContacters: TScrollBox;
ScrollBoxLatests: TScrollBox;
ScrollBoxMyFriend: TScrollBox;
ScrollBoxTeam: TScrollBox;
spbNetworkBackup: TRealICQSpeedButton;
TimerForHideUserCard: TTimer;
TimerForShowUserCard: TTimer;
RealICQHoverImage1: TRealICQHoverImage;
ImageListForStatBig: TImageList;
ImageListForStatSmall: TImageList;
M5: TMenuItem;
actPhone: TAction;
actRepast: TAction;
actMeeting: TAction;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
miLeave: TMenuItem;
miBusy: TMenuItem;
miMute: TMenuItem;
miHidden: TMenuItem;
N9: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
//spb360Safe: TRealICQSpeedButton;
spbChangeLoginName: TRealICQSpeedButton;
spbWinMeet: TRealICQSpeedButton;
ppTeamListView: TPopupActionBar;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
H3: TMenuItem;
miSendTeamSMS: TMenuItem;
MenuItem3: TMenuItem;
X2: TMenuItem;
R1: TMenuItem;
Q1: TMenuItem;
//spb360SD: TRealICQSpeedButton;
WebBrowserForPostWorkOrder: TWebBrowser;
pnlLocked: TPanel;
shp_lock_client: TShape;
img_lock_headimage_border: TImage;
img_lock_HeadPrev: TImage;
img_lockback_top: TImage;
btn_unlock: TRealICQSpeedButton;
btn_lock_DisplayName: TRealICQSpeedButton;
btn_lock: TMenuItem;
miExportGroupUser: TMenuItem;
SD: TSaveDialog;
TimerForreconnectgroup: TTimer;
ImgApp: TImage;
btnCALogin: TRealICQSpeedButton;
chrmAppCentre: TChromium;
spblock: TRealICQSpeedButton;
procedure SysMsgIconClick(Sender: TObject);
procedure TimerForreconnectgroupTimer(Sender: TObject);
procedure spbExportGroupUserClick(Sender: TObject);
procedure btn_unlockClick(Sender: TObject);
procedure btn_lockClick(Sender: TObject);
procedure WebBrowserForPostWorkOrderDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
//procedure spb360SDClick(Sender: TObject);
procedure miSendTeamSMSClick(Sender: TObject);
procedure spbWinMeetClick(Sender: TObject);
procedure RealICQClientGettedSendOfflineFileRequest(Sender: TObject; ALoginName: string; AOppositeID: Cardinal);
//procedure spb360SafeClick(Sender: TObject);
procedure RealICQClientGettedPermission(Sender: TObject);
procedure miMuteClick(Sender: TObject);
procedure miBusyClick(Sender: TObject);
procedure miLeaveClick(Sender: TObject);
procedure imgHeadImageBorderMouseLeave(Sender: TObject);
procedure imgHeadImageBorderMouseEnter(Sender: TObject);
procedure pnlToolBarResize(Sender: TObject);
procedure TimerForShowUserCardTimer(Sender: TObject);
procedure TimerForHideUserCardTimer(Sender: TObject);
procedure spbNetworkBackupClick(Sender: TObject);
procedure tsContactersResize(Sender: TObject);
procedure tsContactersShow(Sender: TObject);
procedure RealICQClientReceivedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
procedure spbRefreshBranchUsersClick(Sender: TObject);
procedure RealICQClientChangePasswordResult(Sender: TObject; APassChanged: Boolean; ANewPassword: string);
procedure RealICQClientGetDBProcedureResult(Sender: TObject; DBProcedureName, ArgIn, ArgOut: string);
procedure miGoSpaceClick(Sender: TObject);
procedure miSetRemarkClick(Sender: TObject);
procedure btShowMiniPageClick(Sender: TObject);
procedure RealICQClientGettedMiniPageSets(Sender: TObject);
procedure spbShowNotReadMessageClick(Sender: TObject);
procedure lblLogsClick(Sender: TObject);
procedure TimerForShowSystemNoticesTimer(Sender: TObject);
procedure lblLogsMouseLeave(Sender: TObject);
procedure lblLogsMouseEnter(Sender: TObject);
procedure btNextLogClick(Sender: TObject);
procedure btPrevLogClick(Sender: TObject);
procedure RealICQClientGetSystemNoticesCount(Sender: TObject; iCount: Integer; NoticesRecords: array of TSystemNotices);
procedure RealICQClientGetNotReadMessageCount(Sender: TObject; iCount: Integer);
procedure TimerForGetBranchUsersOnlineStatesTimer(Sender: TObject);
procedure TimerForGetBranchOnlineStatesTimer(Sender: TObject);
procedure TrayIconMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure RealICQClientGettedRemoteControlTransmiteControlRequest(Sender: TObject; ALoginName: string);
procedure LblHintClick(Sender: TObject);
procedure btCloseTopMessageClick(Sender: TObject);
procedure spbImportGroupUserClick(Sender: TObject);
procedure miPasteClick(Sender: TObject);
procedure miCutClick(Sender: TObject);
procedure miDelGroupUserClick(Sender: TObject);
procedure miUpdateGroupUserClick(Sender: TObject);
procedure miAddGroupUserClick(Sender: TObject);
procedure miDelGroupClick(Sender: TObject);
procedure miUpdateGroupClick(Sender: TObject);
procedure miAddGroupClick(Sender: TObject);
procedure ppAddrBookListPopup(Sender: TObject);
procedure ppAddrBookListGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure RealICQClientGettedSendFolderRequest(Sender: TObject; AID, ACount: Cardinal; ALoginName: string; AFilesStream: TStream);
procedure RealICQClientCanceledSendFolder(Sender: TObject; AID: Cardinal; ALoginName: string);
procedure RealICQClientGettedBranchUser(Sender: TObject);
procedure ppSelCallTelGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure tsCustomerServiceContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
procedure RealICQClientSearchUserResult(Sender: TObject);
procedure edtSearchMoreUserChange(Sender: TObject);
procedure edtSearchMoreUserExit(Sender: TObject);
procedure edtSearchMoreUserClick(Sender: TObject);
procedure RealICQClientGettedWebUrl(Sender: TObject);
procedure RealICQClientReceivedServerList(Sender: TObject; AServerList: string);
procedure spbSelectServerClick(Sender: TObject);
procedure MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
procedure ppServerListGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure RealICQClientGettedMoreUserList(Sender: TObject);
procedure RealICQClientGettedMoreBranchList(Sender: TObject);
procedure ppChangeCustomerStateGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure btCustomerDisplayNameClick(Sender: TObject);
procedure spbPersonManageClick(Sender: TObject);
procedure edFilterKeywordClick(Sender: TObject);
procedure ImageButtonEnter(Sender: TObject);
procedure ImageButtonLeave(Sender: TObject);
procedure ImageButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure pgcMainWorkAreaWebPanelButtonClick(Sender: TObject);
procedure ppMainMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure btMainMenuClick(Sender: TObject);
procedure tsAddrBookShow(Sender: TObject);
procedure WebBrowserAddrBookDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedure WebBrowserAddrBookBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
procedure RealICQClientGettedCancelRemoteControlTransmite(Sender: TObject; ALoginName: string);
procedure RealICQClientCancelControlRemoteControlTransmite(Sender: TObject; ALoginName: string);
procedure RealICQClientSendedRemoteControlTransmiteRequest(Sender: TObject; ALoginName: string);
procedure RealICQClientSendedRemoteControlTransmiteControlRequest(Sender: TObject; ALoginName: string);
procedure RealICQClientGettedStopRemoteControlTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
procedure RealICQClientGettedRemoteControlTransmiteScreenSize(Sender: TObject; ALoginName: string; AWidth, AHeight: Integer);
procedure RealICQClientGettedRemoteControlTransmiteScreenImage(Sender: TObject; ALoginName: string; ALeft, ATop, AWidth, AHeight: Integer; AP: TPoint; ABitmap: TBitmap);
procedure RealICQClientGettedRemoteControlTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
procedure RealICQClientGettedRemoteControlTransmiteRequest(Sender: TObject; ALoginName: string);
procedure RealICQClientGettedRemoteControlTransmiteControlResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
procedure RealICQClientGettedRemoteControlTransmiteConnectted(Sender: TObject; ALoginName: string);
procedure RealICQClientGettedRemoteControlTransmiteBeControlResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
procedure RealICQClientReceivedOfflineFile(Sender: TObject; ASender, AFileName: string; AFileSize: Int64; ASendDateTime: TDateTime);
procedure TimerForLoginingTimer(Sender: TObject);
procedure TimerForCheckLogoutTimeoutTimer(Sender: TObject);
procedure actShowRemarkExecute(Sender: TObject);
procedure actChangeRemarkExecute(Sender: TObject);
procedure actHelpExecute(Sender: TObject);
procedure actAboutExecute(Sender: TObject);
procedure lblReConnectClick(Sender: TObject);
procedure spbAutoLoginClick(Sender: TObject);
procedure spbSavePasswordClick(Sender: TObject);
procedure miOtherStateClick(Sender: TObject);
procedure miMeetingClick(Sender: TObject);
procedure miHiddenClick(Sender: TObject);
procedure miOnlineClick(Sender: TObject);
procedure ppLoginStatesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure ppChangeStatesPopup(Sender: TObject);
procedure spbLoginStateClick(Sender: TObject);
procedure miClearLoginHistoryClick(Sender: TObject);
procedure spbChangeLoginNameClick(Sender: TObject);
procedure ppLoginedUsersPopup(Sender: TObject);
procedure ppLoginedUsersGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure edLoginNameChange(Sender: TObject);
procedure lblRegisterMouseLeave(Sender: TObject);
procedure lblRegisterMouseEnter(Sender: TObject);
procedure actShowTeamHistoryExecute(Sender: TObject);
procedure actShowHistoryExecute(Sender: TObject);
procedure actAVSetExecute(Sender: TObject);
procedure actMsgManagerExecute(Sender: TObject);
procedure WebBrowserForAdvertisementBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
procedure RealICQClientReceivedSystemMessage(Sender: TObject; ASystemMessage: TRealICQSystemMessage);
procedure TimerForShowSystemMessageTimer(Sender: TObject);
procedure RealICQClientReceivedAdversement(Sender: TObject);
procedure WebBrowserForAdvertisementDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedure RealICQClientDownloadTeamFace(Sender: TObject; AFileName: string);
procedure RealICQClientPleaseUploadTeamFace(Sender: TObject; MD5String: string; var FileName: string);
procedure RealICQClientReceivedTeamMessage(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
procedure RealICQClientSendTeamMessageFailed(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
procedure RealICQClientSendedTeamMessage(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
procedure RealICQClientJoinTeamResponse(Sender: TObject; ATeamID: string; ALoginName: string; ATag: string; AAcceptted: Boolean);
procedure RealICQClientJoinTeamRequest(Sender: TObject; ARealICQTeam: TRealICQTeam; ALoginName, ATag: string);
procedure spbFindTeamClick(Sender: TObject);
procedure RealICQClientTeamQuitted(Sender: TObject; ARealICQTeam: TRealICQTeam; ALoginName: string);
procedure RealICQClientTeamDisbanded(Sender: TObject; ARealICQTeam: TRealICQTeam);
procedure actQuitOrDisbandTeamsExecute(Sender: TObject);
procedure ppTeamListViewPopup(Sender: TObject);
procedure ppTeamListViewGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure actDisbandTeamExecute(Sender: TObject);
procedure actQuitTeamExecute(Sender: TObject);
procedure actSeeTeamInformationExecute(Sender: TObject);
procedure actSendTeamMessageExecute(Sender: TObject);
procedure RealICQClientJoinedTeam(Sender: TObject; ARealICQTeam: TRealICQTeam);
procedure RealICQClientTeamInfoReady(Sender: TObject; ARealICQTeam: TRealICQTeam);
procedure actCreateTeamExecute(Sender: TObject);
procedure RealICQClientGettedCancelVideoTransmite(Sender: TObject; ALoginName: string);
procedure RealICQClientGettedStopVideoTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
procedure RealICQClientSendedVideoTransmiteRequest(Sender: TObject; ALoginName: string);
procedure RealICQClientGettedVideoTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
procedure RealICQClientGettedVideoTransmiteRequest(Sender: TObject; ALoginName: string);
procedure RealICQClientGettedVideoTransmiteConnectted(Sender: TObject; ALoginName: string; ASendBigBmp, ARecvBigBmp: Boolean);
procedure RealICQClientGettedAudioTransmiteConnectted(Sender: TObject; ALoginName: string);
procedure RealICQClientGettedStopAudioTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
procedure RealICQClientGettedCancelAudioTransmite(Sender: TObject; ALoginName: string);
procedure RealICQClientGettedAudioTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
procedure RealICQClientGettedAudioTransmiteRequest(Sender: TObject; ALoginName: string);
procedure RealICQClientSendedAudioTransmiteRequest(Sender: TObject; ALoginName: string);
procedure RealICQClientInputting(Sender: TObject; ALoginName: string; AInputting: Boolean);
procedure actOpenRecvFileDirExecute(Sender: TObject);
procedure actCustomFacesManagerExecute(Sender: TObject);
procedure RealICQClientPleaseSendFaceToMe(Sender: TObject; ALoginName, AFaceMD5Code: string);
procedure RealICQClientCancelSendFile(Sender: TObject; ALoginName: string; AOppositeID: Cardinal);
procedure RealICQClientSendedSendFileRequest(Sender, FileTransmitter: TObject);
procedure RealICQClientGettedSendFileRequest(Sender: TObject; SendFileRequestInfo: TSendFileRequestInfo);
procedure ApplicationEventsException(Sender: TObject; E: Exception);
procedure RealICQClientDisconnected(Sender: TObject);
procedure TimerForFlashTrayIconTimer(Sender: TObject);
procedure RealICQClientReceivedMessage(Sender: TObject; RealICQMessage: TRealICQMessage);
procedure RealICQClientSendMessageFailed(Sender: TObject; RealICQMessage: TRealICQMessage);
procedure FormShow(Sender: TObject);
procedure actShowGIFInTalkingFormExecute(Sender: TObject);
procedure actShowGIFInMailFormExecute(Sender: TObject);
procedure RealICQClientUserExInformationChanged(Sender: TObject; RealICQUser: TRealICQUser);
procedure actSendMessageExecute(Sender: TObject);
procedure RealICQClientDownloadFile(Sender: TObject; AFileName: string);
procedure RealICQClientGetWebTabs(Sender: TObject; ATabCount: Integer; WebTabRecords: array of TWebTabRecord);
procedure spbCancelFilterClick(Sender: TObject);
procedure edFilterKeywordChange(Sender: TObject);
procedure edFilterKeywordExit(Sender: TObject);
procedure actSeeInformationExecute(Sender: TObject);
procedure ppColorsPopup(Sender: TObject);
procedure miMoreColorsClick(Sender: TObject);
procedure ppColorsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure TrayIconMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure actCloseExecute(Sender: TObject);
procedure TrayIconClick(Sender: TObject);
procedure TimerForCheckDblClickTimer(Sender: TObject);
procedure ppTrayIconGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure TrayIconDblClick(Sender: TObject);
procedure actOpenMainFormExecute(Sender: TObject);
procedure actQuitExecute(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure ppChangeStatesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure spbDisplayNameClick(Sender: TObject);
procedure actAlwaysOnTopExecute(Sender: TObject);
procedure actShowTeamsExecute(Sender: TObject);
procedure actShowBlacklistsExecute(Sender: TObject);
procedure actShowStrangersExecute(Sender: TObject);
procedure actRemoveUserExecute(Sender: TObject);
procedure RealICQClientAddedBlacklists(Sender: TObject; ALoginName: string);
procedure RealICQClientGettedBlacklists(Sender: TObject);
procedure actGroupManagerExecute(Sender: TObject);
procedure actShowMiddleHeadImageExecute(Sender: TObject);
procedure actShowGroupExecute(Sender: TObject);
procedure RealICQClientRemovedUser(Sender: TObject; ALoginName: string);
procedure ppUserItemRightMenuPopup(Sender: TObject);
procedure ppUserItemRightMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure actDelFriendExecute(Sender: TObject);
procedure RealICQClientReConnectExecute(Sender: TObject; ASeconds: Integer);
procedure btLoginClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure spbSelUIColorClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure RealICQClientLoginResult(Sender: TObject; LoginResultType: TRealICQLoginResultType; ResultMessage: string);
procedure actLoginExecute(Sender: TObject);
procedure actLogoutExecute(Sender: TObject);
procedure actLoginAsExecute(Sender: TObject);
procedure RealICQClientLoginStateChanged(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure RealICQClientGettedFriendList(Sender: TObject);
procedure RealICQClientUserInformationReady(Sender: TObject; RealICQUser: TRealICQUser);
procedure actOnlineExecute(Sender: TObject);
procedure actHiddenExecute(Sender: TObject);
procedure actLeaveExecute(Sender: TObject);
procedure actOtherStateExecute(Sender: TObject);
procedure RealICQClientBeDropped(Sender: TObject; Excuse: string);
procedure RealICQClientLoginFailed(Sender: TObject; E: Exception);
procedure actRegExecute(Sender: TObject);
procedure actShowLoginNameExecute(Sender: TObject);
procedure actShowDisplayNameExecute(Sender: TObject);
procedure actShowAllNameExecute(Sender: TObject);
procedure actShowBigHeadImageExecute(Sender: TObject);
procedure actShowSmallHeadImageExecute(Sender: TObject);
procedure actShowNormalHeadImageExecute(Sender: TObject);
procedure actFindUsersExecute(Sender: TObject);
procedure RealICQClientAddFriendRequest(Sender: TObject; ALoginName, ATag: string);
procedure RealICQClientAddFriendResponse(Sender: TObject; ALoginName, ATag: string; AAcceptted: Boolean);
procedure actOptionsExecute(Sender: TObject);
procedure actPersonalSetExecute(Sender: TObject);
procedure actConnectSetExecute(Sender: TObject);
procedure actChangePassExecute(Sender: TObject);
procedure actShowTreeExecute(Sender: TObject);
procedure edWebSearchKeyWordEnter(Sender: TObject);
procedure edWebSearchKeyWordExit(Sender: TObject);
procedure spbWebSearchClick(Sender: TObject);
procedure edWebSearchKeyWordKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure RealICQClientShakeWindow(Sender: TObject; ALoginName: string);
procedure ppContacterViewStyleGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure spbContacterViewStyleClick(Sender: TObject);
procedure spbWatchwordClick(Sender: TObject);
procedure edWatchwordExit(Sender: TObject);
procedure edWatchwordKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure ApplicationEventsDeactivate(Sender: TObject);
procedure ppLanguagesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure ppLanguagesPopup(Sender: TObject);
procedure spbSelLanguageClick(Sender: TObject);
procedure edPasswordEnter(Sender: TObject);
procedure TimerForHideMainFormTimer(Sender: TObject);
//procedure TimerForShowMainFormTimer(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure sbpSMSClick(Sender: TObject);
procedure RealICQClientSMSResult(Sender: TObject; AMessageID: Cardinal; AResult: Integer);
procedure RealICQClientReceivedSMS(Sender: TObject; ASMSSender, ASMSContent: string; ASMSDateTime: TDateTime);
procedure RealICQClientReceivedCustomMessage(Sender: TObject; AContent: string);
procedure spbEmailClick(Sender: TObject);
procedure tsNetWorkDiskShow(Sender: TObject);
procedure RealICQNetWorkDiskClientConnectStateChanged(Sender: TObject);
procedure RealICQNetWorkDiskClientLoginFailed(Sender: TObject; E: Exception);
procedure RealICQNetWorkDiskClientLoginResult(Sender: TObject; LoginResultType: Byte);
procedure spbNDConnectClick(Sender: TObject);
procedure RealICQNetWorkDiskClientDirectoryListReady(Sender: TObject);
procedure spbNDMoveUpClick(Sender: TObject);
procedure spbNDNewDirClick(Sender: TObject);
procedure RealICQNetWorkDiskClientNewDirResult(Sender: TObject; Directory: TRealICQNetWorkDiskDirectory);
procedure ppNetWorkFileGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure ppNetWorkFilePopup(Sender: TObject);
procedure spbNDDeleteClick(Sender: TObject);
procedure miNDRenameClick(Sender: TObject);
procedure RealICQNetWorkDiskClientRenamedDir(Sender: TObject; ADirectory: TRealICQNetWorkDiskDirectory);
procedure RealICQNetWorkDiskClientRenamedFile(Sender: TObject; AFile: TRealICQNetWorkDiskFile);
procedure RealICQNetWorkDiskClientDeleteResult(Sender: TObject; AList: string);
procedure spbNDRefreshClick(Sender: TObject);
procedure spbNDUploadClick(Sender: TObject);
procedure RealICQNetWorkDiskClientUploadedFile(Sender: TObject; AFile: TRealICQNetWorkDiskFile; AMissionID: string);
procedure TabSetNDMissionsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
procedure TabSetNDMissionsClick(Sender: TObject);
procedure RealICQNetWorkDiskClientUploadFileAborted(Sender: TObject; AMissionID: string);
procedure RealICQNetWorkDiskClientUploadingFile(Sender: TObject; ATransmitter: TResponsionStreamTransmitter; ATransmittedSize: Int64);
procedure ppNetWorkMissonGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
procedure ppNetWorkMissonPopup(Sender: TObject);
procedure miNDCancelClick(Sender: TObject);
procedure RealICQNetWorkDiskClientGettedUsedSpaceSize(Sender: TObject);
procedure spbNDCancelAllClick(Sender: TObject);
procedure RealICQNetWorkDiskClientNoSpace(Sender: TObject);
procedure spbNDDisconnectClick(Sender: TObject);
procedure RealICQNetWorkDiskClientDownloadFileAborted(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
procedure RealICQNetWorkDiskClientDownloadFileCompleted(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
procedure spbNDDownloadClick(Sender: TObject);
procedure RealICQNetWorkDiskClientDownloadFileTransmitting(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
procedure pgcMainWorkAreaTabChanging(Sender: TObject; NewIndex: Integer; var AllowChanged: Boolean);
procedure TabSetMuiltWebClick(Sender: TObject);
procedure spbShowHideRightClick(Sender: TObject);
procedure cbxURLInputerDropDown(Sender: TObject);
procedure spbGoClick(Sender: TObject);
procedure cbxURLInputerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure cbxURLInputerSelect(Sender: TObject);
procedure spbPrevClick(Sender: TObject);
procedure spbStopClick(Sender: TObject);
procedure spbNextClick(Sender: TObject);
procedure spbRefreshClick(Sender: TObject);
procedure spbAddToNAClick(Sender: TObject);
procedure spbPrintPrevClick(Sender: TObject);
procedure spbWebCloseClick(Sender: TObject);
procedure sbpNewWebTabClick(Sender: TObject);
procedure TabSetMuiltWebGetImageIndex(Sender: TObject; TabIndex: Integer; var ImageIndex: Integer);
procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
procedure RealICQClientReceivedOfflineAutoResponseSet(Sender: TObject; AEnabled: Boolean; AText: string);
procedure actOfflieAutoResponseExecute(Sender: TObject);
procedure RealICQClientUsersBranchReady(Sender: TObject);
procedure WebBrowserForContactersBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
procedure RealICQClientGettedSysMsgInterfaces(Sender: TObject);
procedure RealICQClientGettedCanSendSMSCount(Sender: TObject);
// procedure ImgQrCodeClick(Sender: TObject);
procedure SysMsgClick(Sender: TObject);
procedure btnCALoginClick(Sender: TObject);
procedure btOAClick(Sender: TObject);
procedure btSwapClick(Sender: TObject);
//procedure TimerForShowHideMainFrmTimer(Sender: TObject);
private
FIsLogout: Boolean;
FLastGetSystemNoticesTicket: Cardinal;
FSystemNoticeIndex: Integer;
FSystemNotices: TList;
FNotAddedEmployeeList: TStringList;
procedure ShowBranchAndUsers(ExpandSelfNode: Boolean = False);
procedure ShowBranchAndFriends;
procedure GetOtherBranchs;
procedure GetBranchUser(Branch: TRealICQBranch);
procedure ShowSystemNotices;
procedure OpenNewWorkDisk(Path: string);
private
FFilter: Boolean;
FKeyList: TStrings;
FProductType: TRealICQProductType;
FUserType: TRealICQUserType;
FCurrentServerID: string;
FTopSystemMessage: TRealICQSystemMessage;
FServerInfoList: TStringList;
FWebPanels: TStringList;
FAutoHide: Boolean;
FNewConsole: Boolean;
FAutoShowRequestMessage: Boolean;
FMovingMainForm: Boolean;
FWindowMoveing: Boolean;
//FDblClickedTrayIcon: Boolean;
FMainFormHidden: Boolean;
FHidePosition: THidePosition;
FConfirmReplaceResult: Integer;
FLastDownloadDirectory: string;
FAddrBookURL: string;
// FPCAMessage:TPCAMessage;
// FGroupAddress: string;
// FGroupPort: Integer;
// FGroupImagePort: Integer;
// FGroupShareAddress: string;
// FGroupSharePort: Integer;
//procedure PostUpdateLog;
procedure GetWeather(City, Weatheren, Weather: string);
procedure WMMoving(var Msg: TWMMoving); message WM_MOVING;
procedure WMSizing(var Msg: TMessage); message WM_SIZING;
procedure WMSize(var Msg: TMessage); message WM_SIZE;
procedure WMMove(var Msg: TMessage); message WM_MOVE;
procedure WMNCMouseMove(var msg: TWMNCMousemove); message WM_NCMOUSEMOVE;
procedure WindowMove(blnShow: Boolean; iBase: Integer);
procedure AddUploadMission(AUploadMissionType: TNDMissionType; ADirectoryID: Integer; AName: string; CheckMission: Boolean = True);
procedure CheckUploadMissions;
procedure GoNextLevelUploadMissions(UploadMission: TUploadMission);
procedure CheckNDControlState;
procedure AddDownloadMission(ADownloadMissionType: TNDMissionType; ADirectoryName: string; AFileID: Integer = 0; AFileName: string = ''; CheckMission: Boolean = True);
procedure CheckDownloadMissions;
procedure ShowNetWorkDiskSpaceInfo;
procedure WebBrowserRightStatusTextChange(ASender: TObject; const Text: WideString);
procedure WebBrowserRightTitleChange(ASender: TObject; const Text: WideString);
procedure WebBrowserRightDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedure WebBrowserRightDocumentCompleteForPost(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedure WebBrowserRightNewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
procedure WebBrowserRightWindowClosing(ASender: TObject; IsChildWindow: WordBool; var Cancel: WordBool);
public
MessageBoxForm: TMessageBoxForm;
property WebPanels: TStringList read FWebPanels;
procedure LoadWebPanelsFromXML;
procedure SaveWebPanelsToXML;
procedure ShowWebTabs;
procedure HideMainForm;
procedure ShowMainForm;
function AddWebBrowserToPageControl(AUrl: string; WebPanelTag: Integer = -1): TWebBrowser;
procedure OpenNotReadMessage(iIndex: Integer);
procedure SaveBranchUserDataToXML(FileName: string);
procedure UpdatePostLogState(Status: Boolean);
procedure ShowOrHideMuiltiWeb;
private
//FDownFile: TDownFile;
{通讯录}
FCutNode: TTreeNode;
FManageGroupMsgList: TStringList;
FManageGroupMemberMsgList: TStringList;
{通讯录}
FGetUsersTask: TStringList;
FHintWindow: TSingleBorderHintWindow;
ActiveButtonTag: Integer;
FToolBarButtonList: TStringList;
FToolBarButtonIconList: TStringList;
FFriendInfo: TStringList; //存储从好友列表移动到黑名单的好友信息
FLoginAsSavePassword, FSavePassword, FAutoLogin: Boolean;
FLoginState: TRealICQLoginState;
FLeaveMessage: string;
FCanAlert, FHidden: Boolean;
FUIMainColor: TColor;
FShowGroup: Boolean;
FGroups: TStringList;
FLVSelectedItemBorderColor: TColor;
FLVSelectedItemBorderInnerColor: TColor;
FLVSelectedItemBackColor: TColor;
FLVHeadImageBorderColor: TColor;
FLVHeadImageBackColor: TColor;
FLVStyle: TRealICQContacterListItemStyle;
FLVCaptionStyle: TRealICQContacterListItemCaptionStyle;
FShowTree: Boolean; //是否以树型方式组织联系人列表
FShowStrangers: Boolean;
FShowBlacklists: Boolean;
FShowTeams: Boolean;
FShowLatests: Boolean;
FShowGIFInMailForm: Boolean;
FShowGIFInTalkingForm: Boolean;
FFlashTrayIconIndex: Integer;
FFlashTrayIconIndexAtLogining: Integer;
FAlwaysOnTop: Boolean;
FTalkingFormAlwaysOnTop: Boolean;
FCtrlEnterSendMessage: Boolean;
FCopyScreenHideTalkForm: Boolean;
FReadMessageHotKey: string; // Cardinal;
FCopyScreenHotKey: string; // Cardinal;
FMainFormLeft: Integer;
FMainFormTop: Integer;
FMainFormWidth: Integer;
FMainFormHeight: Integer;
FTalkingFormLeft: Integer;
FTalkingFormTop: Integer;
FTalkingFormWidth: Integer;
FTalkingFormHeight: Integer;
FTalkingRightWidth: Integer;
FSMSFormLeft, FSMSFormTop, FSMSFormWidth, FSMSFormHeight: Integer;
FConfirmSendOfflineFile: Boolean;
FShowMainFormOnStart: Boolean;
FCursorPosX: Integer;
FCursorPosY: Integer;
FLastDBlClickTicket: Cardinal;
FNeedShowUserCardLoginName: string;
FShowUserCardTargetTop: Integer;
FWebTabs: TList;
//未处理的系统消息集合
FSystemMessages: TList;
FLastSearchKeyWord: string;
// FLastActiveIndex: Integer;
FSearchListViewInVisible: Boolean;
FSearchListView: TRealICQContacterListView;
FSearchMoreUserListView: TRealICQContacterListView;
//显示系统消息的ListView
FLVSystemMessage: TRealICQContacterListView;
//显示群组列表的ListView
FLVTeams: TRealICQContacterListView;
//显示最近联系人列表的ListView
FLVNetWorkDisk: TRealICQContacterListView;
FLVNetWorkDiskUploadingFiles: TRealICQContacterListView;
FLVNetWorkDiskDownloadingFiles: TRealICQContacterListView;
//客服最近联系列表w
FTVCustomerLatests: TRealICQContacterTreeView;
FLVCustomers: TRealICQContacterListView;
FContacterListViews: TStringList;
FContacterTreeViews: TStringList;
FTrayIconRect: TRect;
FGettedTrayIconRect: Boolean;
FInputFont: TFont;
FSystemFaceCount: Integer;
FFaceList, FTempFaceList, FFaceCategory: TStringList;
FShowHintOnOnline: Boolean;
FShowHintOnOffline: Boolean;
FDontShowHintOnBusy: Boolean;
FPlaySoundOnOnline: Boolean;
FPlaySoundOnOffline: Boolean;
FPlaySoundOnGetMessage: Boolean;
FPlaySoundOnGetSystemMessage: Boolean;
FFlashCaptionOnOnline: Boolean;
FFlashImageOnGetMessage: Boolean;
FShowShakeWindow: Boolean;
FShowCustomMessage: Boolean;
FShowFileTransCompleted: Boolean;
FOnlineEventSound: string;
FOfflineEventSound: string;
FMessageEventSound: string;
FSystemMessageEventSound: string;
FRecvFileSafeLevel: TRecvFileSafeLevel;
FAllowURL: Boolean;
FAutoSaveMessage: Boolean;
FShowHistoryInNewWindow: Boolean;
FAutoUpdate: Boolean;
FRecvFileDir: string;
FUseCacheDir: Boolean;
FCacheDir: string;
FLimitCacheDirSize: Boolean;
FMaxCacheDirSize: Integer;
FAudoDeleteCacheFile: Boolean;
FAudoDeleteCacheFileDate: Integer;
FScanVirus: Boolean;
FScanVirusProgram: string;
FDontUseCacheFileOnBigFile: Boolean;
FDontUseCacheFileOnBigFileSize: Integer;
//读取/保存历史记录的对象
FDBHistory: TRealICQDBHistory;
FOfflineAutoResponseTexts: TStringList;
CLOSEWINDOWS: UINT; //接收别的进程发送的退出程序的消息
procedure DownFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
procedure DownFaceFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
procedure QuitWindows();
procedure ShowFriendLists;
procedure ShowBlacklists;
procedure CheckCacheDir;
procedure LoadOfflineAutoResponseSets;
//读取最近的联系人列表
procedure LoadLatests;
procedure AddMessageHistory(ASystemMessageType: TSystemMessageType; ASimpleMessage: string; ASystemMessage: TRealICQSystemMessage);
function GetSelectedLoginName: string;
procedure SetTalkingFormAlwaysOnTop(Value: Boolean);
procedure SetCtrlEnterSendMessage(Value: Boolean);
procedure SetCopyScreenHideTalkForm(Value: Boolean);
procedure SetSearchListViewVisible(AShow: Boolean);
procedure SetUIState;
procedure SetLoginControlsVisible(Value: Boolean);
procedure SetLoginStateControlState;
procedure LoadMainTabImage;
procedure LoadHintAndSoundConfigs;
procedure LoadReceiveFileConfigs;
procedure LoadSafeConfigs;
procedure LoadGroupConfigs;
procedure SaveIfShowGroupConfig;
procedure ShowGroupInterface;
procedure LoadStyleConfigs;
procedure SaveStyleConfigs;
procedure LoadHotKeyConfigs;
procedure SaveHotKeyConfigs;
procedure SetReadMessageHotKey(Value: string);
procedure SetCopyScreenHotKey(Value: string);
procedure LoadDefaultConfigs;
procedure LoadAutoUpdateConfigs;
procedure LoadInputConfigs;
procedure SaveInputFontConfig;
//procedure LoadGroupConfig;
function GetSystemMessageCounter(AMessageID: Integer): Integer;
procedure IncSystemMessageCounter(AMessageID: Integer);
procedure SetInputFont(Value: TFont);
procedure SetShowGroup(Value: Boolean);
function GetListViewByLoginName(ALoginName: string; AOnlyInGroups: Boolean = False): TRealICQContacterListView;
procedure SetFlashCaptionOnOnlineValue(Value: Boolean);
procedure SetLoginStateMenuChecked;
procedure SetStyleMenuChecked;
procedure miChangeLoginNameClick(Sender: TObject);
procedure miChangeServerClick(Sender: TObject);
procedure miMoveGroupClick(Sender: TObject);
procedure miMoveToBlacklistsClick(Sender: TObject);
procedure miMoveToStrangersClick(Sender: TObject);
procedure ItemShowHint(Sender: TObject; Item: TRealICQContacterListItem; var HintStr: string);
procedure NDItemDoubleClick(Item: TRealICQContacterListItem);
procedure NDSelectItemChanged(Item: TRealICQContacterListItem);
procedure NDMissionItemIconButtonClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
procedure NDMissionDropFiles(Sender: TObject; var Message: TMessage);
procedure NDItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure NodeBranchClick(Sender: TObject; Branch: TRealICQBranch);
procedure NodeOnline(Employee: TRealICQEmployee);
procedure NodeOffline(Employee: TRealICQEmployee);
procedure NodeDoubleClick(Employee: TRealICQEmployee);
procedure NodeIconButtonClick(Sender: TObject; Employee: TRealICQEmployee; IconButtonType: TRealICQContacterTreeNodeIconButtonType);
procedure NodeIconButtonDblClick(Sender: TObject; Employee: TRealICQEmployee; IconButtonType: TRealICQContacterTreeNodeIconButtonType);
procedure NodeOnMouseEnter(Employee: TRealICQEmployee);
procedure NodeOnMouseLeave(Employee: TRealICQEmployee);
{通讯录}
procedure NodeGroupClick(Sender: TObject; Group: TRealICQBranch);
procedure GetChildsGroupId(GroupId: string; var Groups: string);
procedure GettedAddrBookUsers(Sender: TObject);
procedure GettedAddrBookUsers1(Sender: TObject);
procedure GettedAddrBookGroups(Sender: TObject);
procedure LoadAddrBook(ExpandGroupId: string);
procedure GettedManageAddrBookResult(Sender: TObject; OperatModal: Integer; OperatCommand: Integer; RetValue, MessageId: Cardinal);
function GetGroupUsers(GroupId: string): Integer;
function GetAddrBookUserIndex(GroupId, LoginName: string): Integer;
function GetAddrBookUser(GroupId, LoginName: string): TRealICQUser;
{通讯录}
procedure miSkinClick(Sender: TObject);
procedure miColorClick(Sender: TObject);
procedure WebTabShow(Sender: TObject);
procedure miLanguageClick(Sender: TObject);
private
FCheckedUpdate: Boolean;
TabAcountIndex: Integer;
FNotReadMessages: TStringList; {未读消息}
HotKeyID_ReadMessage: Integer;
HotKeyID_CopyScreen: Integer;
procedure WMHotKeyHandle(var Msg: TWMHotKey); message WM_HotKey;
procedure ShowRealICQMessage(RealICQMessage: TRealICQMessage; ShowSendFailed: Boolean; ARealICQClient: TRealICQClient);
procedure ShowSystemMessage(ASystemMessage: TRealICQSystemMessage);
procedure SetShowMainFormOnStart(Value: Boolean);
procedure SaveWindowState;
function GetBitmapFromFileExt(AFileName: string): string;
protected
procedure ChangeLanguage(ALanguageIniFile: string); override;
procedure Post(stURL, stPostData: string; var wbWebBrowser: TWebBrowser);
procedure WMQueryEndSession(var message: TWMQUERYENDSESSION); message WM_QUERYENDSESSION;
procedure WMPowerBroadcast(var message: TMessage); message WM_POWERBROADCAST;
procedure CMWininichange(var Message: TWMWinIniChange); message CM_WININICHANGE;
procedure WndProc(var Message: TMessage); override;
procedure CreateParams(var Params: TCreateParams); override;
public
FLVLatests: TRealICQContacterListView;
constructor Create(AOwner: TComponent); override;
procedure ChangeUIColor(AColor: TColor); override;
procedure ChangePPMenuColorMap(PopupMenuEx: TCustomActionPopupMenuEx);
procedure NodeOnHeadImageMouseEnter(Employee: TRealICQEmployee);
procedure NodeOnHeadImageMouseLeave(Employee: TRealICQEmployee);
procedure ShowMeInformation;
procedure ShowUserCardForm(ALoginName: string; ATargetTop: Integer);
procedure HideUserCardForm;
procedure UpdateAddrBookInfo(RealICQUser: TRealICQUser);
//function GetDefaultBrowser: string; //获取默认浏览器
procedure ShowRealICQTeamMessage(RealICQTeamMessage: TRealICQTeamMessage; ShowSendFailed: Boolean);
procedure WebSocketRemoveTeamResponse(aTeamID: string);
procedure WebSocketQuitTeam(aTeamID: string);
procedure WebSocketSendReadTeamInfo(aTeamID: string);
procedure WebSocketRecivedbroadcastmesssage(aID, aGroupID, aSayer, aStyle, aMsg: string; aTimesTamp: TDateTime);
procedure WebSocketJionTeamRequest(TeamID, ALoginName, ATag: string);
procedure DownLoadUpdateConfig;
procedure OpenWebTab(TabSheet: TTabSheet; WebPanel: TWebPanel; AcountIndex: Integer);
procedure UploadWebTabAccounts;
procedure GetBranchEmpOnlineAndSum(Branchs: TStringList; BranchInfo: TRealICQBranchInfo; var OnlineEmployee, EmployeeCount: Integer);
function GetBranchName(LoginName: string): string;
function GetCompany: string;
procedure StopHeadImageFlash(AID: string);
{通讯录}
function GetGroupUserCount: Integer;
procedure SaveContacter(Name, Mobile, Tel, Email, Remark, BranchId: string);
procedure GetParentGroupNameList(BranchInfo: TRealICQBranchInfo; var Groups: string);
procedure CreateManageGroupMessage(GroupId, GroupName, ParentId, MessageId: string);
procedure CreateManageGroupMemberMessage(ID, DisplayName, NickName, Mobile, Tel, Email, Remark, GroupId, MessageId: string);
{通讯录}
procedure ItemOnline(Item: TRealICQContacterListItem);
procedure ItemOffline(Item: TRealICQContacterListItem);
procedure ItemDoubleClick(Item: TRealICQContacterListItem);
procedure ItemIconButtonClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
procedure ItemIconButtonDblClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
procedure ItemOnMouseEnter(Item: TRealICQContacterListItem);
procedure ItemOnMouseLeave(Item: TRealICQContacterListItem);
procedure ItemOnHeadImageEnter(Item: TRealICQContacterListItem);
procedure ItemOnHeadImageLeave(Item: TRealICQContacterListItem);
procedure SetToolBarState(Sender: TObject);
function GetActiveTabSheetName: string;
function AddFriendTreeView(AOwner: TWinControl; GroupName: string): Integer;
function AddContacterListView(AOwner: TWinControl; GroupName: string): Integer;
function AddContacterTreeView(AOwner: TWinControl; GroupName: string): Integer;
procedure UpdateContacterListView(RealICQContacterListView: TRealICQContacterListView);
procedure CheckWindowPositon;
//procedure BindUserDataToItem(RealICQContacterListItem: TRealICQContacterListItem; RealICQUser: TRealICQUser; ANeedFlash: Boolean = True);
//procedure BindUserDataToItemForGroup(RealICQContacterListItem: TRealICQContacterListItem; RealICQUser: TRealICQUser; AGroupAlias: string; ANeedFlash: Boolean = True);
//procedure UpdateEmployeeNode(Employee: TRealICQEmployee; RealICQUser: TRealICQUser; ANeedFlash: Boolean);
//procedure UpdateFriendNode(Friend: TRealICQEmployee; RealICQUser: TRealICQUser; ANeedFlash: Boolean);
procedure StopFlash(ALoginName: string);
procedure StopFlashTeam(ATeamID: string);
procedure SetGetMoreUserEvent;
procedure SaveDefaultConfigs;
// procedure LoadSysMsgInterfaceConfig;
// procedure SaveSysMsgInterfaceConfig;
property ProductType: TRealICQProductType read FProductType write FProductType;
property UserType: TRealICQUserType read FUserType write FUserType;
property Filter: Boolean read FFilter write FFilter;
property KeyList: TStrings read FKeyList write FKeyList;
procedure SaveGroupConfigs;
procedure SaveHintAndSoundConfigs;
procedure SaveCustomFaceConfig;
procedure SaveReceiveFileConfigs;
procedure SaveSafeConfigs;
procedure SaveAutoUpdateConfigs;
procedure SaveOfflineAutoResponseSets;
procedure SetDOMStyle(Doc: IHTMLDocument2);
procedure OpenMessagesManagerForm;
property ServerInfoList: TStringList read FServerInfoList write FServerInfoList;
property ContacterListViews: TStringList read FContacterListViews;
property ContacterTreeViews: TStringList read FContacterTreeViews;
property ListViewLatests: TRealICQContacterListView read FLVLatests;
property CurrentServerID: string read FCurrentServerID;
property UIMainColor: TColor read FUIMainColor;
property CanAlert: Boolean read FCanAlert;
property OfflineAutoResponseTexts: TStringList read FOfflineAutoResponseTexts write FOfflineAutoResponseTexts;
property ShowGroup: Boolean read FShowGroup write SetShowGroup;
property Groups: TStringList read FGroups write FGroups;
property TalkingFormAlwaysOnTop: Boolean read FTalkingFormAlwaysOnTop write SetTalkingFormAlwaysOnTop;
property CtrlEnterSendMessage: Boolean read FCtrlEnterSendMessage write SetCtrlEnterSendMessage;
property CopyScreenHideTalkForm: Boolean read FCopyScreenHideTalkForm write SetCopyScreenHideTalkForm;
property InputFont: TFont read FInputFont write SetInputFont;
property FaceList: TStringList read FFaceList;
property TempFaceList: TStringList read FTempFaceList;
property FaceCategory: TStringList read FFaceCategory;
property SystemFaceCount: Integer read FSystemFaceCount;
property ShowGIFInMailForm: Boolean read FShowGIFInMailForm;
property ShowGIFInTalkingForm: Boolean read FShowGIFInTalkingForm;
property NotReadMessages: TStringList read FNotReadMessages;
property TalkingFormLeft: Integer read FTalkingFormLeft write FTalkingFormLeft;
property TalkingFormTop: Integer read FTalkingFormTop write FTalkingFormTop;
property TalkingFormWidth: Integer read FTalkingFormWidth write FTalkingFormWidth;
property TalkingFormHeight: Integer read FTalkingFormHeight write FTalkingFormHeight;
property TalkingRightWidth: Integer read FTalkingRightWidth write FTalkingRightWidth;
property SMSFormLeft: Integer read FSMSFormLeft write FSMSFormLeft;
property SMSFormTop: Integer read FSMSFormTop write FSMSFormTop;
property SMSFormWidth: Integer read FSMSFormWidth write FSMSFormWidth;
property SMSFormHeight: Integer read FSMSFormHeight write FSMSFormHeight;
property ShowMainFormOnStart: Boolean read FShowMainFormOnStart write SetShowMainFormOnStart;
property ConfirmSendOfflineFile: Boolean read FConfirmSendOfflineFile write FConfirmSendOfflineFile;
property AlwaysOnTop: Boolean read FAlwaysOnTop write FAlwaysOnTop;
property AutoHide: Boolean read FAutoHide write FAutoHide;
property AutoShowRequestMessage: Boolean read FAutoShowRequestMessage write FAutoShowRequestMessage;
property ShowHintOnOnline: Boolean read FShowHintOnOnline write FShowHintOnOnline;
property ShowHintOnOffline: Boolean read FShowHintOnOffline write FShowHintOnOffline;
property DontShowHintOnBusy: Boolean read FDontShowHintOnBusy write FDontShowHintOnBusy;
property PlaySoundOnOnline: Boolean read FPlaySoundOnOnline write FPlaySoundOnOnline;
property PlaySoundOnOffline: Boolean read FPlaySoundOnOffline write FPlaySoundOnOffline;
property PlaySoundOnGetMessage: Boolean read FPlaySoundOnGetMessage write FPlaySoundOnGetMessage;
property PlaySoundOnGetSystemMessage: Boolean read FPlaySoundOnGetSystemMessage write FPlaySoundOnGetSystemMessage;
property FlashCaptionOnOnline: Boolean read FFlashCaptionOnOnline write FFlashCaptionOnOnline;
property FlashImageOnGetMessage: Boolean read FFlashImageOnGetMessage write FFlashImageOnGetMessage;
property ShowShakeWindow: Boolean read FShowShakeWindow write FShowShakeWindow;
property ShowCustomMessage: Boolean read FShowCustomMessage write FShowCustomMessage;
property ShowFileTransCompleted: Boolean read FShowFileTransCompleted write FShowFileTransCompleted;
property OnlineEventSound: string read FOnlineEventSound write FOnlineEventSound;
property OfflineEventSound: string read FOfflineEventSound write FOfflineEventSound;
property MessageEventSound: string read FMessageEventSound write FMessageEventSound;
property SystemMessageEventSound: string read FSystemMessageEventSound write FSystemMessageEventSound;
property RecvFileDir: string read FRecvFileDir write FRecvFileDir;
property UseCacheDir: Boolean read FUseCacheDir write FUseCacheDir;
property CacheDir: string read FCacheDir write FCacheDir;
property LimitCacheDirSize: Boolean read FLimitCacheDirSize write FLimitCacheDirSize;
property MaxCacheDirSize: Integer read FMaxCacheDirSize write FMaxCacheDirSize;
property AudoDeleteCacheFile: Boolean read FAudoDeleteCacheFile write FAudoDeleteCacheFile;
property AudoDeleteCacheFileDate: Integer read FAudoDeleteCacheFileDate write FAudoDeleteCacheFileDate;
property ScanVirus: Boolean read FScanVirus write FScanVirus;
property ScanVirusProgram: string read FScanVirusProgram write FScanVirusProgram;
property DontUseCacheFileOnBigFile: Boolean read FDontUseCacheFileOnBigFile write FDontUseCacheFileOnBigFile;
property DontUseCacheFileOnBigFileSize: Integer read FDontUseCacheFileOnBigFileSize write FDontUseCacheFileOnBigFileSize;
property RecvFileSafeLevel: TRecvFileSafeLevel read FRecvFileSafeLevel write FRecvFileSafeLevel;
property AllowURL: Boolean read FAllowURL write FAllowURL;
property AutoSaveMessage: Boolean read FAutoSaveMessage write FAutoSaveMessage;
property ShowHistoryInNewWindow: Boolean read FShowHistoryInNewWindow write FShowHistoryInNewWindow;
property ReadMessageHotKey: string read FReadMessageHotKey write SetReadMessageHotKey;
property CopyScreenHotKey: string read FCopyScreenHotKey write SetCopyScreenHotKey;
property AutoUpdate: Boolean read FAutoUpdate write FAutoUpdate;
property AddrBookURL: string read FAddrBookURL write FAddrBookURL;
property DBHistory: TRealICQDBHistory read FDBHistory;
// property GroupAddress: string read FGroupAddress write FGroupAddress;
// property GroupPort: Integer read FGroupPort write FGroupPort;
// property GroupImagePort: Integer read FGroupImagePort write FGroupImagePort;
// property GroupShareAddress: string read FGroupShareAddress write FGroupShareAddress;
// property GroupSharePort: Integer read FGroupSharePort write FGroupSharePort;
end;
TUploadMission = class
private
FID: string;
FUploadMissionType: TNDMissionType;
FDirectoryID: Integer;
FName: string;
public
constructor Create(AUploadMissionType: TNDMissionType; ADirectoryID: Integer; AName: string);
destructor Destroy; override;
property ID: string read FID;
property UploadMissionType: TNDMissionType read FUploadMissionType;
property DirectoryID: Integer read FDirectoryID;
property Name: string read FName;
end;
TDownloadMission = class
FID: string;
FDownloadMissionType: TNDMissionType;
FFileID: Integer;
FFileName: string;
FDirectoryName: string;
public
constructor Create(ADownloadMissionType: TNDMissionType; ADirectoryName: string; AFileID: Integer = 0; AFileName: string = '');
destructor Destroy; override;
property ID: string read FID;
property DownloadMissionType: TNDMissionType read FDownloadMissionType;
property FileID: Integer read FFileID;
property FileName: string read FFileName;
property DirectoryName: string read FDirectoryName;
end;
TNavigateType = (ntGET, ntPOST, ntFill);
//WEB标签面版数据
TWebPanel = class
private
FMustShow: Boolean;
FShow: Boolean;
FID, FName, FURL, FImage: string;
FNavigateType: TNavigateType;
FPostFields: string;
FUserIMLoginName: Boolean;
FUserIMPassword: Boolean;
FCustomLoginName, FCustomPassword: string;
FContent: string;
FAcounts: TList;
public
constructor Create();
destructor Destroy; override;
property MustShow: Boolean read FMustShow write FMustShow;
property Show: Boolean read FShow write FShow;
property ID: string read FID write FID;
property Name: string read FName write FName;
property URL: string read FURL write FURL;
property Image: string read FImage write FImage;
property NavigateType: TNavigateType read FNavigateType write FNavigateType;
property PostFields: string read FPostFields write FPostFields;
property UserIMLoginName: Boolean read FUserIMLoginName write FUserIMLoginName;
property UserIMPassword: Boolean read FUserIMPassword write FUserIMPassword;
property CustomLoginName: string read FCustomLoginName write FCustomLoginName;
property CustomPassword: string read FCustomPassword write FCustomPassword;
property Content: string read FContent write FContent;
property Acounts: TList read FAcounts write FAcounts;
end;
//未读消息（文字消息）
TNotReadMessage = class
private
FRealICQMessage: TRealICQMessage;
FShowSendFailed: Boolean;
FRealICQClient: TRealICQClient;
public
destructor Destroy; override;
property RealICQMessage: TRealICQMessage read FRealICQMessage write FRealICQMessage;
property ShowSendFailed: Boolean read FShowSendFailed;
end;
//未读消息（文字消息）
TNotReadTeamMessage = class
private
FRealICQTeamMessage: TRealICQTeamMessage;
FShowSendFailed: Boolean;
public
destructor Destroy; override;
property RealICQTeamMessage: TRealICQTeamMessage read FRealICQTeamMessage write FRealICQTeamMessage;
property ShowSendFailed: Boolean read FShowSendFailed;
end;
//未读消息（手机短消息）
TNotReadSMSMessage = class
private
FSMSSender, FSMSContent: string;
FSMSDateTime: TDateTime;
public
property SMSSender: string read FSMSSender;
property SMSContent: string read FSMSContent;
property SMSDateTime: TDateTime read FSMSDateTime;
end;
TWebTabAcount = class
private
FWebTabID: Integer;
FTitle: string;
FLoginName: string;
FPassword: string;
FExplain: string;
public
published
property WebTabID: Integer read FWebTabID write FWebTabID;
property Title: string read FTitle write FTitle;
property LoginName: string read FLoginName write FLoginName;
property Password: string read FPassword write FPassword;
property Explain: string read FExplain write FExplain;
end;
//添加表示用户状态的图标至指定的 ImageList 中
procedure AddUserStatePictureToImageList(ImageList: TImageList);
procedure ClearFileMissions;
var
MainForm: TMainForm;
DisplayWebs: Boolean;
LVSystemMessage, LVMyContacters, LVFriends, LVStrangers, LVBlacklists, LVLatests, LVTeams, LVMoreUsers, LVAddrbook, LVSearch: string;
CsvLines, CommaStr: TStringList;
implementation
uses
RegFrm, SearchFrm, VCardFrm, AddFriendRequestFrm, AddFriendFrm, OptionsFrm,
ChangePassFrm, GroupManagerFrm, OnlineOfflineAlertFrm, SeeInformationFrm{UserCardDetailView},
TalkingFrm, TrueHiddenMainFrm, SelFaceFrm, CustomFacesManagerFrm, AddFaceFrm,
CreateTeamFrm, PtoPFileTransmitter, FileTransmitterObjective, NotifyAlertFrm,
TeamOptionsFrm, SearchTeamFrm, SystemMessageFrm, MessagesManagerFrm,
UserCardFrm, VideoFrm, ShareUtils, CopyScreenFrm, SMSFrm,
ConfirmReplaceNDFileFrm, RemoteControlFrm, ReceiveFolderRequestFrm,
NotReadMessageBoxFrm, AddWebTabFrm, SelWebTabAcountsFrm,
LoggerImport, TeamsAdapter, MainFormContrller, Authority, FileTransmitAdapter,
DataProviderImport, BranchService, UsersService, FriendsService,
WorkmatesService, MessagesHander, CAImport, InterfaceCA, PerlRegEx,
GroupConfig, ConditionConfig, LimitCondition,
AboutFrm, TextMessageService, ViewManager, InterfaceUI, GuideView,
RealICQUtility;
var
HookID: THandle;
FUploadMissions, FDownloadMissions: TStringList;
FSavedUploadMissions, FSavedDownloadMissions: TList;
//------------------------------------------------------------------------------
procedure AddUserStatePictureToImageList(ImageList: TImageList);
var
Bitmap: TBitmap;
//BitmapLeave: TBitmap;
//png: TPNGObject;
//Icon: TIcon;
begin
Bitmap := TBitmap.Create;
//Icon := TIcon.Create;
//BitmapLeave := TBitmap.Create;
//png := TPNGObject.Create;
try
// try
// Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
// except
// end;
// ImageList.Add(Bitmap, nil);
// Grayscale(Bitmap);
// ImageList.Insert(0, Bitmap, nil);
// try
// Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
// BitmapLeave.LoadFromFile(LeavePicture);
// Bitmap.Canvas.Draw(0, 8, BitmapLeave);
// except
// end;
// ImageList.Add(Bitmap, nil);
//-----------------------------------------------
//png.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
//Image1.Picture.Bitmap.Assign(png);
// try
// Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultIcon);
// except
// end;
// ImageList.AddIcon(Icon);
// try
// Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultIcon);
// except
// end;
// ImageList.AddIcon(Icon);
// try
// Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultIcon);
// except
// end;
// ImageList.AddIcon(Icon);
try
Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\Small\DefaultHeadImageOffline_16.bmp');
except
end;
ImageList.Add(Bitmap, nil);
try
Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\Small\DefaultHeadImage_16.bmp');
except
end;
ImageList.Add(Bitmap, nil);
try
Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\Small\DefaultHeadImage_leave_16.bmp');
except
end;
ImageList.Add(Bitmap, nil);
try
Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\OpenFolder.bmp');
except
end;
ImageList.Add(Bitmap, nil);
try
Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\CloseFolder.bmp');
except
end;
ImageList.Add(Bitmap, nil);
try
Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + TeamPicture);
except
end;
ImageList.Add(Bitmap, nil);
try
Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + SystemMessagePicture);
except
end;
ImageList.Add(Bitmap, nil);
try
Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + SearchPicture);
except
end;
ImageList.Add(Bitmap, nil);
try
Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + SMSBMP);
except
end;
ImageList.Add(Bitmap, nil);
finally
//BitmapLeave.Free;
Bitmap.Free;
//Icon.Free;
//png.Free;
end;
end;
//------------------------------------------------------------------------------
function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
var
szClassName: array[0..255] of Char;
const
ie_name = 'Internet Explorer_Server';
begin
case nCode < 0 of
True:
Result := CallNextHookEx(HookID, nCode, wParam, lParam) else
case wParam of
WM_RBUTTONDOWN, WM_RBUTTONUP:
begin
GetClassName(PMOUSEHOOKSTRUCT(lParam)^.HWND, szClassName, SizeOf(szClassName));
if (lstrcmp(@szClassName[0], @ie_name[1]) = 0) and (IsChild(MainForm.WebBrowserForAdvertisement.Handle, PMOUSEHOOKSTRUCT(lParam)^.HWND) or InTalkingFormTeamDisk(PMOUSEHOOKSTRUCT(lParam)^.HWND) or InTalkingFormAdvertisement(PMOUSEHOOKSTRUCT(lParam)^.HWND)) then
begin
Result := HC_SKIP {屏蔽WebBrowser上的右键}
end
else
begin
Result := CallNextHookEx(HookID, nCode, wParam, lParam);
end;
end
else
Result := CallNextHookEx(HookID, nCode, wParam, lParam);
end;
end;
end;
{$R *.dfm}
{TWebPanel}
constructor TWebPanel.Create();
begin
FAcounts := TList.Create;
end;
destructor TWebPanel.Destroy;
var
WebTabAcount: TWebTabAcount;
begin
try
while FAcounts.Count > 0 do
begin
WebTabAcount := FAcounts[0];
FAcounts.Delete(0);
try
FreeAndNil(WebTabAcount);
except
end;
end;
try
FreeAndNil(FAcounts);
except
end;
finally
inherited Destroy;
end;
end;
{TDownloadMission}
//------------------------------------------------------------------------------
constructor TDownloadMission.Create(ADownloadMissionType: TNDMissionType; ADirectoryName: string; AFileID: Integer = 0; AFileName: string = '');
begin
FDownloadMissionType := ADownloadMissionType;
FDirectoryName := ADirectoryName;
FFileID := AFileID;
FFileName := AFileName;
FID := IntToStr(GetTickCount);
while FDownloadMissions.IndexOf(FID) >= 0 do
begin
FID := IntToStr(GetTickCount);
Sleep(10);
Application.ProcessMessages;
end;
FDownloadMissions.AddObject(FID, Self);
end;
//------------------------------------------------------------------------------
destructor TDownloadMission.Destroy;
begin
try
try
FDownloadMissions.Delete(FDownloadMissions.IndexOf(FID));
except
end;
finally
inherited Destroy;
end;
end;
{TUploadMission}
//------------------------------------------------------------------------------
constructor TUploadMission.Create(AUploadMissionType: TNDMissionType; ADirectoryID: Integer; AName: string);
begin
FUploadMissionType := AUploadMissionType;
FDirectoryID := ADirectoryID;
FName := AName;
FID := IntToStr(Integer(FUploadMissionType)) + IntToStr(FDirectoryID) + FName;
end;
//------------------------------------------------------------------------------
destructor TUploadMission.Destroy;
begin
try
try
FUploadMissions.Delete(FUploadMissions.IndexOf(FID));
except
end;
finally
inherited Destroy;
end;
end;
{TNotReadMessage}
//------------------------------------------------------------------------------
destructor TNotReadMessage.Destroy;
begin
try
FreeAndNil(FRealICQMessage);
finally
inherited Destroy;
end;
end;
{TNotReadTeamMessage}
//------------------------------------------------------------------------------
destructor TNotReadTeamMessage.Destroy;
begin
try
FreeAndNil(FRealICQTeamMessage);
finally
inherited Destroy;
end;
end;
{TMainForm}
function TMainForm.GetBitmapFromFileExt(AFileName: string): string;
var
FileExt, IconTempFileName, FFileExtImage: string;
TempFile: array[0..MAX_PATH] of char;
SHFI: TSHFileInfo;
Bitmap: TBitmap;
begin
try
FileExt := ExtractFileExt(AFileName);
FFileExtImage := TRealICQClient.GetFileExtImagesDir + Copy(FileExt, 2, Length(FileExt) - 1) + '.BMP';
if not FileExists(FFileExtImage) then
begin
GetTempPath(MAX_PATH, TempFile);
GetTempFileName(TempFile, PChar(FileExt), GetTickCount, TempFile);
IconTempFileName := ReplaceStr(TempFile, ExtractFileExt(TempFile), FileExt);
TFileStream.Create(IconTempFileName, fmCreate).Free;
SHGetFileInfo(PChar(IconTempFileName), 0, SHFI, SizeOf(SHFI), SHGFI_ICON or SHGFI_SMALLICON);
DeleteFile(PChar(IconTempFileName));
Bitmap := TBitmap.Create;
try
Bitmap.Width := 16;
Bitmap.Height := 16;
DrawIconEx(Bitmap.Canvas.Handle, 0, 0, SHFI.hIcon, 16, 16, 0, 0, DI_NORMAL);
Bitmap.SaveToFile(FFileExtImage);
finally
FreeAndNil(Bitmap);
end;
end;
Result := FFileExtImage;
except
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetShowMainFormOnStart(Value: Boolean);
begin
if FShowMainFormOnStart = Value then
Exit;
FShowMainFormOnStart := Value;
SaveDefaultConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetTalkingFormAlwaysOnTop(Value: Boolean);
begin
if FTalkingFormAlwaysOnTop = Value then
Exit;
FTalkingFormAlwaysOnTop := Value;
SaveStyleConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetCtrlEnterSendMessage(Value: Boolean);
begin
if FCtrlEnterSendMessage = Value then
Exit;
FCtrlEnterSendMessage := Value;
SaveStyleConfigs;
end;
procedure TMainForm.SetCopyScreenHideTalkForm(Value: Boolean);
begin
if FCopyScreenHideTalkForm = Value then
Exit;
FCopyScreenHideTalkForm := Value;
SaveStyleConfigs;
end;
procedure TMainForm.SetShowGroup(Value: Boolean);
begin
FShowGroup := Value;
ShowGroupInterface;
end;
procedure TMainForm.SaveIfShowGroupConfig;
var
XMLFile: string;
XMLDocument: TXMLDocument;
GroupConfigNode: IXMLNode;
begin
XMLFile := TRealICQClient.GetUserDir + GroupConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + GroupConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
GroupConfigNode := XMLDocument.DocumentElement;
GroupConfigNode.ChildNodes.FindNode('ShowGroup').Attributes['Value'] := FShowGroup;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveGroupConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
GroupConfigNode, GroupListNode, GroupNode: IXMLNode;
GroupMembers: TStringList;
iLoop, jLoop: Integer;
begin
XMLFile := TRealICQClient.GetUserDir + GroupConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + GroupConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
GroupConfigNode := XMLDocument.DocumentElement;
GroupListNode := GroupConfigNode.ChildNodes.FindNode('Groups');
for iLoop := 0 to GroupListNode.ChildNodes.Count - 1 do
begin
GroupNode := GroupListNode.ChildNodes[iLoop];
GroupNode.ChildNodes.Clear;
end;
GroupListNode.ChildNodes.Clear;
for iLoop := 0 to FGroups.Count - 1 do
begin
GroupNode := GroupListNode.AddChild('Group');
GroupNode.Attributes['Name'] := FGroups[iLoop];
GroupNode.Attributes['Position'] := iLoop;
GroupMembers := FGroups.Objects[iLoop] as TStringList;
for jLoop := 0 to GroupMembers.Count - 1 do
begin
if (not TFriendsService.GetService.IsFriend(GroupMembers[jLoop])) and (not TWorkmatesService.GetService.IsWorkmate(GroupMembers[jLoop])) then
continue;
if (AnsiSameText(RealICQClient.LoginName, GroupMembers[jLoop]) and (RealICQClient.WorkingMode = wmPublic)) then
continue;
GroupNode.AddChild('GroupMember').Text := GroupMembers[jLoop];
end;
end;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetInputFont(Value: TFont);
begin
FInputFont.Assign(Value);
SaveInputFontConfig;
end;
//------------------------------------------------------------------------------
function TMainForm.GetSystemMessageCounter(AMessageID: Integer): Integer;
var
XMLFile: string;
XMLDocument: TXMLDocument;
CountersNode, CounterNode: IXMLNode;
iLoop: Integer;
CountersDate: TDateTime;
begin
Result := 0;
XMLFile := TRealICQClient.GetUserDir + SystemMessagesCounterXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + SystemMessagesCounterXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
CountersNode := XMLDocument.DocumentElement;
try
CountersDate := StrToDate(CountersNode.Attributes['Date']);
except
CountersDate := StrToDate(AnsiReplaceStr(CountersNode.Attributes['Date'], '-', '/'));
end;
if CompareDate(CountersDate, Now) <> 0 then
begin
CountersNode.Attributes['Date'] := DateToStr(Now);
CountersNode.ChildNodes.Clear;
XMLDocument.SaveToFile();
Exit;
end;
for iLoop := 0 to CountersNode.ChildNodes.Count - 1 do
begin
CounterNode := CountersNode.ChildNodes[iLoop];
if StrToInt(CounterNode.Attributes['ID']) = AMessageID then
begin
Result := StrToInt(CounterNode.Attributes['Counter']);
Exit;
end;
end;
finally
XMLDocument.Free;
end;
except
try
DeleteFile(XMLFile);
except
end;
Result := 0;
end;
end;
//------------------------------------------------------------------------------
//procedure TMainForm.ImgQrCodeClick(Sender: TObject);
//begin
// QRCodeForm := TQRCodeForm.Create(Self);
// try
// QRCodeForm.ShowModal;
// finally
// FreeAndNil(QRCodeForm);
// end;
//end;
procedure TMainForm.IncSystemMessageCounter(AMessageID: Integer);
var
XMLFile: string;
XMLDocument: TXMLDocument;
CountersNode, CounterNode: IXMLNode;
iLoop: Integer;
Finded: Boolean;
CountersDate: TDateTime;
begin
XMLFile := TRealICQClient.GetUserDir + SystemMessagesCounterXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + SystemMessagesCounterXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
CountersNode := XMLDocument.DocumentElement;
try
CountersDate := StrToDate(CountersNode.Attributes['Date']);
except
CountersDate := StrToDate(AnsiReplaceStr(CountersNode.Attributes['Date'], '-', '/'));
end;
if CompareDate(CountersDate, Now) <> 0 then
begin
CountersNode.Attributes['Date'] := DateToStr(Now);
CountersNode.ChildNodes.Clear;
end;
Finded := False;
for iLoop := 0 to CountersNode.ChildNodes.Count - 1 do
begin
CounterNode := CountersNode.ChildNodes[iLoop];
if StrToInt(CounterNode.Attributes['ID']) = AMessageID then
begin
CounterNode.Attributes['Counter'] := IntToStr(StrToInt(CounterNode.Attributes['Counter']) + 1);
Finded := True;
Break;
end;
end;
if not Finded then
begin
CounterNode := CountersNode.AddChild('SystemMessage');
CounterNode.Attributes['ID'] := IntToStr(AMessageID);
CounterNode.Attributes['Counter'] := '1';
end;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveCustomFaceConfig;
var
XMLFile, FaceCategorys: string;
XMLDocument: TXMLDocument;
InputConfigNode, FacesNode, FaceNode: IXMLNode;
iLoop, jLoop: Integer;
Face: TFace;
begin
XMLFile := TRealICQClient.GetUserDir + InputConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + InputConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
//删除系统表情
XMLDocument.LoadFromFile(XMLFile);
InputConfigNode := XMLDocument.DocumentElement;
FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
FacesNode.ChildNodes.Clear;
XMLDocument.SaveToFile();
XMLDocument.Active := False;
end;
XMLDocument.Active := True;
XMLDocument.LoadFromFile(XMLFile);
InputConfigNode := XMLDocument.DocumentElement;
if InputConfigNode.ChildNodes.FindNode('FaceCategory') = nil then
begin
InputConfigNode.AddChild('FaceCategory').Text := '';
XMLDocument.SaveToFile();
end;
FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
FacesNode.ChildNodes.Clear;
FaceCategorys := '';
for iLoop := 0 to FFaceCategory.Count - 1 do
begin
for jLoop := FSystemFaceCount to FaceList.Count - 1 do
begin
Face := FaceList.Objects[jLoop] as TFace;
if AnsiSameText(Face.Category, FFaceCategory[iLoop]) then
begin
FaceNode := FacesNode.AddChild('Face');
FaceNode.Text := ExtractFileName(Face.FileName);
FaceNode.Attributes['ShortCut'] := Face.ShortCut;
FaceNode.Attributes['Name'] := Face.Name;
FaceNode.Attributes['MD5Code'] := Face.MD5Code;
FaceNode.Attributes['Category'] := Face.Category;
end;
end;
if iLoop < FFaceCategory.Count - 1 then
FaceCategorys := FaceCategorys + FFaceCategory[iLoop] + ','
else
FaceCategorys := FaceCategorys + FFaceCategory[iLoop];
end;
InputConfigNode.ChildNodes.FindNode('FaceCategory').Text := FaceCategorys;
if SelFaceForm <> nil then
SelFaceForm.ReDrawFaces;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveInputFontConfig;
var
XMLFile: string;
XMLDocument: TXMLDocument;
InputConfigNode, FacesNode: IXMLNode;
begin
XMLFile := TRealICQClient.GetUserDir + InputConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + InputConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
//删除系统表情
XMLDocument.LoadFromFile(XMLFile);
InputConfigNode := XMLDocument.DocumentElement;
FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
FacesNode.ChildNodes.Clear;
XMLDocument.SaveToFile();
XMLDocument.Active := False;
end;
XMLDocument.Active := True;
XMLDocument.LoadFromFile(XMLFile);
InputConfigNode := XMLDocument.DocumentElement;
try
InputConfigNode.ChildNodes.FindNode('Font').Text := FontToString(FInputFont);
except
InputConfigNode.ChildNodes.FindNode('Font').Text := FontToString(Font);
end;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.LoadInputConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
InputConfigNode, FacesNode, FaceNode: IXMLNode;
Face: TFace;
iLoop: Integer;
Category: string;
begin
FInputFont.Assign(Font);
{$region '删除前一个用户的表情'}
TRealICQUtility.ClearStringList(FFaceList);
TRealICQUtility.ClearStringList(FTempFaceList);
FFaceCategory.Clear;
FSystemFaceCount := 0;
{$endregion}
{$region '读取系统表情'}
FFaceCategory.Add(SystemFaceGroup);
XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + InputConfigXMLFile;
SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
XMLDocument.LoadFromFile(XMLFile);
InputConfigNode := XMLDocument.DocumentElement;
try
StringToFont(InputConfigNode.ChildNodes.FindNode('Font').Text, FInputFont);
except
FInputFont.Assign(Font);
end;
FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
for iLoop := 0 to FacesNode.ChildNodes.Count - 1 do
begin
FaceNode := FacesNode.ChildNodes[iLoop];
Face := TFace.Create(ExtractFilePath(paramstr(0)) + FaceNode.Text, FaceNode.Attributes['ShortCut'], FaceNode.Attributes['Name'], '', SystemFaceGroup);
FFaceList.AddObject(Face.ShortCut, Face);
Inc(FSystemFaceCount);
end;
finally
XMLDocument.Free;
end;
{$endregion}
{$region '读取自定义表情'}
XMLFile := TRealICQClient.GetUserDir + InputConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + InputConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
//删除系统表情
XMLDocument.LoadFromFile(XMLFile);
InputConfigNode := XMLDocument.DocumentElement;
FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
FacesNode.ChildNodes.Clear;
XMLDocument.SaveToFile();
XMLDocument.Active := False;
end;
XMLDocument.Active := True;
XMLDocument.LoadFromFile(XMLFile);
InputConfigNode := XMLDocument.DocumentElement;
try
StringToFont(InputConfigNode.ChildNodes.FindNode('Font').Text, FInputFont);
except
FInputFont.Assign(Font);
end;
if InputConfigNode.ChildNodes.FindNode('FaceCategory') = nil then
begin
InputConfigNode.AddChild('FaceCategory').Text := '';
XMLDocument.SaveToFile();
end;
FreeAndNil(FFaceCategory);
FFaceCategory := SplitString(InputConfigNode.ChildNodes.FindNode('FaceCategory').Text, ',');
if FFaceCategory.IndexOf('') >= 0 then
FFaceCategory.Delete(FFaceCategory.IndexOf(''));
FacesNode := InputConfigNode.ChildNodes.FindNode('Faces');
for iLoop := 0 to FacesNode.ChildNodes.Count - 1 do
begin
FaceNode := FacesNode.ChildNodes[iLoop];
try
Category := FaceNode.Attributes['Category'];
except
Category := NOFaceCategory;
end;
if FFaceCategory.IndexOf(Category) = -1 then
begin
if AnsiSameText(Category, NOFaceCategory) then
FFaceCategory.Insert(0, Category)
else
FFaceCategory.Add(Category);
end;
Face := TFace.Create(TRealICQClient.GetCustomFaceDir + FaceNode.Text, FaceNode.Attributes['ShortCut'], FaceNode.Attributes['Name'], FaceNode.Attributes['MD5Code'], Category);
FFaceList.AddObject(Face.MD5Code, Face);
end;
finally
XMLDocument.Free;
end;
{$endregion}
end;
//------------------------------------------------------------------------------
procedure TMainForm.LoadSafeConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
SafeConfigNode: IXMLNode;
begin
XMLFile := TRealICQClient.GetUserDir + SafeConfigXMLFile;
SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + SafeConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
SafeConfigNode := XMLDocument.DocumentElement;
FRecvFileSafeLevel := TRecvFileSafeLevel(Integer(SafeConfigNode.ChildNodes.FindNode('RecvFileSafeLevel').Attributes['Value']));
FAllowURL := SafeConfigNode.ChildNodes.FindNode('AllowURL').Attributes['Value'];
FShowHistoryInNewWindow := SafeConfigNode.ChildNodes.FindNode('ShowHistoryInNewWindow').Attributes['Value'];
FAutoSaveMessage := SafeConfigNode.ChildNodes.FindNode('AutoSaveMessage').Attributes['Value'];
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveSafeConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
SafeConfigNode: IXMLNode;
begin
XMLFile := TRealICQClient.GetUserDir + SafeConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + SafeConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
SafeConfigNode := XMLDocument.DocumentElement;
SafeConfigNode.ChildNodes.FindNode('RecvFileSafeLevel').Attributes['Value'] := Integer(FRecvFileSafeLevel);
SafeConfigNode.ChildNodes.FindNode('AllowURL').Attributes['Value'] := FAllowURL;
SafeConfigNode.ChildNodes.FindNode('ShowHistoryInNewWindow').Attributes['Value'] := FShowHistoryInNewWindow;
SafeConfigNode.ChildNodes.FindNode('AutoSaveMessage').Attributes['Value'] := FAutoSaveMessage;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.LoadWebPanelsFromXML;
var
ADesKey: string;
iLoop: Integer;
XMLFile: string;
XMLDocument: TXMLDocument;
WebPanelsNode, WebPanelNode: IXMLNode;
WebPanel: TWebPanel;
begin
XMLFile := TRealICQClient.GetUserDir + WebPanelsXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
XMLDocument.XML.Text := '' + '' + '';
XMLDocument.Active := True;
XMLDocument.SaveToFile(XMLFile);
end
else
begin
XMLDocument.LoadFromFile(XMLFile);
end;
WebPanelsNode := XMLDocument.DocumentElement;
while FWebPanels.Count > 0 do
begin
FWebPanels.Objects[0].Free;
FWebPanels.Delete(0);
end;
FWebPanels.Clear;
ADesKey := MD5En(RealICQClient.LoginName);
for iLoop := WebPanelsNode.ChildNodes.Count - 1 downto 0 do
begin
WebPanelNode := WebPanelsNode.ChildNodes[iLoop];
WebPanel := TWebPanel.Create;
try
WebPanel.FMustShow := WebPanelNode.Attributes['MustShow'];
except
WebPanel.FMustShow := False;
end;
try
WebPanel.FShow := WebPanelNode.Attributes['Show'];
except
WebPanel.FShow := False;
end;
try
WebPanel.FID := WebPanelNode.Attributes['ID'];
except
WebPanel.FID := '';
end;
WebPanel.FName := DESryStrHex(WebPanelNode.Attributes['Name'], ADesKey);
WebPanel.FURL := DESryStrHex(WebPanelNode.Attributes['URL'], ADesKey);
WebPanel.FImage := DESryStrHex(WebPanelNode.Attributes['Image'], ADesKey);
WebPanel.FNavigateType := WebPanelNode.Attributes['NavigateType'];
WebPanel.FPostFields := DESryStrHex(WebPanelNode.Attributes['PostFields'], ADesKey);
WebPanel.FUserIMLoginName := WebPanelNode.Attributes['UserIMLoginName'];
WebPanel.FUserIMPassword := WebPanelNode.Attributes['UserIMPassword'];
WebPanel.FCustomLoginName := DESryStrHex(WebPanelNode.Attributes['CustomLoginName'], ADesKey);
WebPanel.FCustomPassword := DESryStrHex(WebPanelNode.Attributes['CustomPassword'], ADesKey);
FWebPanels.AddObject(WebPanel.FID, WebPanel);
end;
except
end;
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveWebPanelsToXML;
var
ADesKey: string;
iLoop: Integer;
XMLFile: string;
XMLDocument: TXMLDocument;
WebPanelsNode, WebPanelNode: IXMLNode;
WebPanel: TWebPanel;
begin
XMLFile := TRealICQClient.GetUserDir + WebPanelsXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
XMLDocument.XML.Text := '' + '' + '';
XMLDocument.Active := True;
end
else
begin
XMLDocument.LoadFromFile(XMLFile);
end;
WebPanelsNode := XMLDocument.DocumentElement;
ADesKey := MD5En(RealICQClient.LoginName);
WebPanelsNode.ChildNodes.Clear;
for iLoop := 0 to FWebPanels.Count - 1 do
begin
WebPanel := FWebPanels.Objects[iLoop] as TWebPanel;
WebPanelNode := WebPanelsNode.AddChild('WebPanel');
WebPanelNode.Attributes['MustShow'] := WebPanel.FMustShow;
WebPanelNode.Attributes['Show'] := WebPanel.FShow;
WebPanelNode.Attributes['ID'] := WebPanel.FID;
WebPanelNode.Attributes['Name'] := EncryStrHex(WebPanel.FName, ADesKey);
WebPanelNode.Attributes['URL'] := EncryStrHex(WebPanel.FURL, ADesKey);
WebPanelNode.Attributes['Image'] := EncryStrHex(WebPanel.FImage, ADesKey);
WebPanelNode.Attributes['NavigateType'] := WebPanel.FNavigateType;
WebPanelNode.Attributes['PostFields'] := EncryStrHex(WebPanel.FPostFields, ADesKey);
WebPanelNode.Attributes['UserIMLoginName'] := WebPanel.FUserIMLoginName;
WebPanelNode.Attributes['UserIMPassword'] := WebPanel.FUserIMPassword;
WebPanelNode.Attributes['CustomLoginName'] := EncryStrHex(WebPanel.FCustomLoginName, ADesKey);
WebPanelNode.Attributes['CustomPassword'] := EncryStrHex(WebPanel.FCustomPassword, ADesKey);
end;
XMLDocument.SaveToFile(XMLFile);
except
end;
finally
XMLDocument.Free;
end;
end;
{
//----------------------------------------------------------
procedure TMainForm.LoadSysMsgInterfaceConfig;
var
XMLFile: String;
XMLDocument: TXMLDocument;
ConfigNodes,ConfigNode: IXMLNode;
iLoop:Integer;
SysMsgInterface:TSysMsgInterface;
MsgIID:String;
begin
XMLFile := TRealICQClient.GetUserDir+SysMsgInterfaceConfig;
XMLDocument := TXMLDocument.Create(Self);
try
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
XMLDocument.XML.Text := '' +
'' +
'';
XMLDocument.Active := True;
XMLDocument.SaveToFile(XMLFile);
end
else
begin
XMLDocument.LoadFromFile(XMLFile);
end;
ConfigNodes := XMLDocument.DocumentElement;
for iLoop := 0 to ConfigNodes.ChildNodes.Count - 1 do
begin
ConfigNode:=ConfigNodes.ChildNodes[iLoop];
MsgIID:=ConfigNode.Attributes['MsgIID'];
if MainForm.RealICQClient.SysMsgInterfaces.IndexOf(MsgIID)>=0 then
begin
SysMsgInterface:=MainForm.RealICQClient.SysMsgInterfaces.Objects[MainForm.RealICQClient.SysMsgInterfaces.IndexOf(MsgIID)] as TSysMsgInterface;
SysMsgInterface.ShowMsg:=ConfigNode.Attributes['ShowMsg'];
end;
end;
except
//
end;
finally
XMLDocument.Free;
end;
end; }
{
//-----------------------------------------------------------
procedure TMainForm.SaveSysMsgInterfaceConfig;
var
XMLFile: String;
XMLDocument: TXMLDocument;
ConfigNodes,ConfigNode: IXMLNode;
iLoop:Integer;
SysMsgInterface:TSysMsgInterface;
begin
XMLFile := TRealICQClient.GetUserDir+SysMsgInterfaceConfig;
XMLDocument := TXMLDocument.Create(Self);
try
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
XMLDocument.XML.Text := '' +
'' +
'';
XMLDocument.Active := True;
end
else
begin
XMLDocument.LoadFromFile(XMLFile);
end;
ConfigNodes := XMLDocument.DocumentElement;
ConfigNodes.ChildNodes.Clear;
for iLoop := 0 to MainForm.RealICQClient.SysMsgInterfaces.Count - 1 do
begin
SysMsgInterface:=MainForm.RealICQClient.SysMsgInterfaces.Objects[iLoop] as TSysMsgInterface;
ConfigNode:=ConfigNodes.AddChild('SysMsgInterface');
ConfigNode.Attributes['MsgIID']:=SysMsgInterface.MsgIID;
ConfigNode.Attributes['ShowMsg']:=SysMsgInterface.ShowMsg;
end;
XMLDocument.SaveToFile(XMLFile);
except
end;
finally
XMLDocument.Free;
end;
end; }
//------------------------------------------------------------------------------
procedure TMainForm.LoadReceiveFileConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
ReceiveFileConfigNode: IXMLNode;
begin
XMLFile := TRealICQClient.GetUserDir + ReceiveFileConfigXMLFile;
SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + ReceiveFileConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
ReceiveFileConfigNode := XMLDocument.DocumentElement;
FRecvFileDir := ReceiveFileConfigNode.ChildNodes.FindNode('RecvFileDir').Attributes['Value'];
FUseCacheDir := ReceiveFileConfigNode.ChildNodes.FindNode('UseCacheDir').Attributes['Value'];
FCacheDir := ReceiveFileConfigNode.ChildNodes.FindNode('CacheDir').Attributes['Value'];
FLimitCacheDirSize := ReceiveFileConfigNode.ChildNodes.FindNode('LimitCacheDirSize').Attributes['Value'];
FMaxCacheDirSize := ReceiveFileConfigNode.ChildNodes.FindNode('LimitCacheDirSize').Attributes['MaxSize'];
FAudoDeleteCacheFile := ReceiveFileConfigNode.ChildNodes.FindNode('AudoDeleteCacheFile').Attributes['Value'];
FAudoDeleteCacheFileDate := ReceiveFileConfigNode.ChildNodes.FindNode('AudoDeleteCacheFile').Attributes['Date'];
FScanVirus := ReceiveFileConfigNode.ChildNodes.FindNode('ScanVirus').Attributes['Value'];
FScanVirusProgram := ReceiveFileConfigNode.ChildNodes.FindNode('ScanVirus').Attributes['Program'];
FDontUseCacheFileOnBigFile := ReceiveFileConfigNode.ChildNodes.FindNode('DontUseCacheFileOnBigFile').Attributes['Value'];
FDontUseCacheFileOnBigFileSize := ReceiveFileConfigNode.ChildNodes.FindNode('DontUseCacheFileOnBigFile').Attributes['Size'];
if not DirectoryExists(FRecvFileDir) then
begin
FRecvFileDir := RealICQClient.GetUserDir + '我接收到的文件\';
if not DirectoryExists(FRecvFileDir) then
CreateDir(FRecvFileDir);
end;
if (not DirectoryExists(FCacheDir)) and FUseCacheDir then
begin
FCacheDir := RealICQClient.GetUserDir + 'CacheFiles\';
if not DirectoryExists(FCacheDir) then
CreateDir(FCacheDir);
end;
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveReceiveFileConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
ReceiveFileConfigNode: IXMLNode;
begin
XMLFile := TRealICQClient.GetUserDir + ReceiveFileConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + ReceiveFileConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
ReceiveFileConfigNode := XMLDocument.DocumentElement;
ReceiveFileConfigNode.ChildNodes.FindNode('RecvFileDir').Attributes['Value'] := FRecvFileDir;
ReceiveFileConfigNode.ChildNodes.FindNode('UseCacheDir').Attributes['Value'] := FUseCacheDir;
ReceiveFileConfigNode.ChildNodes.FindNode('CacheDir').Attributes['Value'] := FCacheDir;
ReceiveFileConfigNode.ChildNodes.FindNode('LimitCacheDirSize').Attributes['Value'] := FLimitCacheDirSize;
ReceiveFileConfigNode.ChildNodes.FindNode('LimitCacheDirSize').Attributes['MaxSize'] := FMaxCacheDirSize;
ReceiveFileConfigNode.ChildNodes.FindNode('AudoDeleteCacheFile').Attributes['Value'] := FAudoDeleteCacheFile;
ReceiveFileConfigNode.ChildNodes.FindNode('AudoDeleteCacheFile').Attributes['Date'] := FAudoDeleteCacheFileDate;
ReceiveFileConfigNode.ChildNodes.FindNode('ScanVirus').Attributes['Value'] := FScanVirus;
ReceiveFileConfigNode.ChildNodes.FindNode('ScanVirus').Attributes['Program'] := FScanVirusProgram;
ReceiveFileConfigNode.ChildNodes.FindNode('DontUseCacheFileOnBigFile').Attributes['Value'] := FDontUseCacheFileOnBigFile;
ReceiveFileConfigNode.ChildNodes.FindNode('DontUseCacheFileOnBigFile').Attributes['Size'] := FDontUseCacheFileOnBigFileSize;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.LoadOfflineAutoResponseSets;
var
XMLFile: string;
XMLDocument: TXMLDocument;
OfflineAutoResponseConfigNode, TextNode: IXMLNode;
iLoop: Integer;
begin
XMLFile := TRealICQClient.GetUserDir + OfflineAutoResponseConfigXMLFile;
SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + OfflineAutoResponseConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
OfflineAutoResponseConfigNode := XMLDocument.DocumentElement;
FOfflineAutoResponseTexts.Clear;
for iLoop := 0 to OfflineAutoResponseConfigNode.ChildNodes.Count - 1 do
begin
TextNode := OfflineAutoResponseConfigNode.ChildNodes[iLoop];
FOfflineAutoResponseTexts.Add(TextNode.Text);
end;
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveOfflineAutoResponseSets;
var
XMLFile: string;
XMLDocument: TXMLDocument;
OfflineAutoResponseConfigNode: IXMLNode;
iLoop: Integer;
begin
XMLFile := TRealICQClient.GetUserDir + OfflineAutoResponseConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + OfflineAutoResponseConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
OfflineAutoResponseConfigNode := XMLDocument.DocumentElement;
OfflineAutoResponseConfigNode.ChildNodes.Clear;
for iLoop := 0 to FOfflineAutoResponseTexts.Count - 1 do
begin
OfflineAutoResponseConfigNode.AddChild('Text').Text := FOfflineAutoResponseTexts.Strings[iLoop];
end;
finally
XMLDocument.SaveToFile();
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.LoadHintAndSoundConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
HintAndSoundConfigNode: IXMLNode;
begin
XMLFile := TRealICQClient.GetUserDir + HintAndSoundConfigXMLFile;
SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + HintAndSoundConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
HintAndSoundConfigNode := XMLDocument.DocumentElement;
FFlashCaptionOnOnline := HintAndSoundConfigNode.ChildNodes.FindNode('FlashCaptionOnOnline').Attributes['Value'];
FFlashCaptionOnOnline := False;
SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
FShowHintOnOnline := HintAndSoundConfigNode.ChildNodes.FindNode('ShowHintOnOnline').Attributes['Value'];
FShowHintOnOffline := HintAndSoundConfigNode.ChildNodes.FindNode('ShowHintOnOffline').Attributes['Value'];
FDontShowHintOnBusy := HintAndSoundConfigNode.ChildNodes.FindNode('DontShowHintOnBusy').Attributes['Value'];
FPlaySoundOnOnline := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOnline').Attributes['Value'];
FPlaySoundOnOffline := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOffline').Attributes['Value'];
FPlaySoundOnGetMessage := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetMessage').Attributes['Value'];
FPlaySoundOnGetSystemMessage := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetSystemMessage').Attributes['Value'];
FFlashImageOnGetMessage := HintAndSoundConfigNode.ChildNodes.FindNode('FlashImageOnGetMessage').Attributes['Value'];
if not Assigned(HintAndSoundConfigNode.ChildNodes.FindNode('ShowShakeWindow')) then
begin
HintAndSoundConfigNode.AddChild('ShowShakeWindow').Attributes['Value'] := True;
XMLDocument.SaveToFile();
end;
FShowShakeWindow := HintAndSoundConfigNode.ChildNodes.FindNode('ShowShakeWindow').Attributes['Value'];
if not Assigned(HintAndSoundConfigNode.ChildNodes.FindNode('ShowCustomMessage')) then
begin
HintAndSoundConfigNode.AddChild('ShowCustomMessage').Attributes['Value'] := True;
XMLDocument.SaveToFile();
end;
FShowCustomMessage := HintAndSoundConfigNode.ChildNodes.FindNode('ShowCustomMessage').Attributes['Value'];
if not Assigned(HintAndSoundConfigNode.ChildNodes.FindNode('ShowFileTransCompleted')) then
begin
HintAndSoundConfigNode.AddChild('ShowFileTransCompleted').Attributes['Value'] := True;
XMLDocument.SaveToFile();
end;
FShowFileTransCompleted := HintAndSoundConfigNode.ChildNodes.FindNode('ShowFileTransCompleted').Attributes['Value'];
FOnlineEventSound := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOnline').Attributes['File'];
FOfflineEventSound := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOffline').Attributes['File'];
FMessageEventSound := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetMessage').Attributes['File'];
FSystemMessageEventSound := HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetSystemMessage').Attributes['File'];
if AnsiSameText(Copy(FOnlineEventSound, 1, 5), 'Sound') then
FOnlineEventSound := ExtractFilePath(paramstr(0)) + FOnlineEventSound;
if AnsiSameText(Copy(FOfflineEventSound, 1, 5), 'Sound') then
FOfflineEventSound := ExtractFilePath(paramstr(0)) + FOfflineEventSound;
if AnsiSameText(Copy(FMessageEventSound, 1, 5), 'Sound') then
FMessageEventSound := ExtractFilePath(paramstr(0)) + FMessageEventSound;
if AnsiSameText(Copy(FSystemMessageEventSound, 1, 5), 'Sound') then
FSystemMessageEventSound := ExtractFilePath(paramstr(0)) + FSystemMessageEventSound;
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveHintAndSoundConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
HintAndSoundConfigNode: IXMLNode;
begin
XMLFile := TRealICQClient.GetUserDir + HintAndSoundConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + HintAndSoundConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
HintAndSoundConfigNode := XMLDocument.DocumentElement;
HintAndSoundConfigNode.ChildNodes.FindNode('FlashCaptionOnOnline').Attributes['Value'] := FFlashCaptionOnOnline;
SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
HintAndSoundConfigNode.ChildNodes.FindNode('ShowHintOnOnline').Attributes['Value'] := FShowHintOnOnline;
HintAndSoundConfigNode.ChildNodes.FindNode('ShowHintOnOffline').Attributes['Value'] := FShowHintOnOffline;
HintAndSoundConfigNode.ChildNodes.FindNode('DontShowHintOnBusy').Attributes['Value'] := FDontShowHintOnBusy;
HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOnline').Attributes['Value'] := FPlaySoundOnOnline;
HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOffline').Attributes['Value'] := FPlaySoundOnOffline;
HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetMessage').Attributes['Value'] := FPlaySoundOnGetMessage;
HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetSystemMessage').Attributes['Value'] := FPlaySoundOnGetSystemMessage;
HintAndSoundConfigNode.ChildNodes.FindNode('FlashImageOnGetMessage').Attributes['Value'] := FFlashImageOnGetMessage;
HintAndSoundConfigNode.ChildNodes.FindNode('ShowShakeWindow').Attributes['Value'] := FShowShakeWindow;
HintAndSoundConfigNode.ChildNodes.FindNode('ShowCustomMessage').Attributes['Value'] := FShowCustomMessage;
HintAndSoundConfigNode.ChildNodes.FindNode('ShowFileTransCompleted').Attributes['Value'] := FShowFileTransCompleted;
HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOnline').Attributes['File'] := FOnlineEventSound;
HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnOffline').Attributes['File'] := FOfflineEventSound;
HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetMessage').Attributes['File'] := FMessageEventSound;
HintAndSoundConfigNode.ChildNodes.FindNode('PlaySoundOnGetSystemMessage').Attributes['File'] := FSystemMessageEventSound;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.LoadHotKeyConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
HotKeyConfigNode: IXMLNode;
begin
XMLFile := TRealICQClient.GetUserDir + HotKeyConfigXMLFile;
SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + HotKeyConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
HotKeyConfigNode := XMLDocument.DocumentElement;
ReadMessageHotKey := HotKeyConfigNode.ChildNodes.FindNode('ReadMessage').Attributes['Key'];
CopyScreenHotKey := HotKeyConfigNode.ChildNodes.FindNode('CopyScreen').Attributes['Key'];
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveHotKeyConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
HotKeyConfigNode: IXMLNode;
begin
XMLFile := TRealICQClient.GetUserDir + HotKeyConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + HotKeyConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
HotKeyConfigNode := XMLDocument.DocumentElement;
HotKeyConfigNode.ChildNodes.FindNode('ReadMessage').Attributes['Key'] := FReadMessageHotKey;
HotKeyConfigNode.ChildNodes.FindNode('CopyScreen').Attributes['Key'] := FCopyScreenHotKey;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
procedure TMainForm.SetCopyScreenHotKey(Value: string);
var
HotKeyStr: string;
HotKey, ModKey: Cardinal;
begin
if FCopyScreenHotKey = Value then
Exit;
FCopyScreenHotKey := Value;
if AnsiPos('+', FCopyScreenHotKey) <= 0 then
FCopyScreenHotKey := 'CTRL+ALT+S';
HotKeyStr := CutOffString(trim(FCopyScreenHotKey), '+');
if AnsiPos('+', HotKeyStr) > 0 then
HotKeyStr := CutOffString(HotKeyStr, '+');
HotKey := Ord(PChar(UpperCase(HotKeyStr))[0]);
if HotKeyID_CopyScreen <> 0 then
begin
UnregisterHotKey(Handle, HotKeyID_CopyScreen);
DeleteAtom(HotKeyID_CopyScreen);
end;
if (FindAtom('FCopyScreenHotKey') = 0) and (HotKey > 0) then
begin
HotKeyID_CopyScreen := GlobalAddAtom(pchar('FCopyScreenHotKey')) - $C000;
ModKey := GetModKey(FCopyScreenHotKey);
if (not RegisterHotkey(Handle, HotKeyID_CopyScreen, ModKey, HotKey)) then
begin
FCanAlert := True;
ShowNotifyAlertForm('热键 ' + FCopyScreenHotKey + ' 冲突！');
FCanAlert := False;
end;
//MessageBox(Handle, PChar('热键 '+ FCopyScreenHotKey + ' 已被其它程序注册，请选择其它热键！'), '提示', MB_ICONERROR);
end;
SaveHotKeyConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetReadMessageHotKey(Value: string);
var
HotKeyStr: string;
HotKey, ModKey: Cardinal;
begin
if FReadMessageHotKey = Value then
Exit;
FReadMessageHotKey := Value;
if AnsiPos('+', FReadMessageHotKey) <= 0 then
FReadMessageHotKey := 'CTRL+ALT+X';
HotKeyStr := CutOffString(trim(FReadMessageHotKey), '+');
if AnsiPos('+', HotKeyStr) > 0 then
HotKeyStr := CutOffString(HotKeyStr, '+');
HotKey := Ord(PChar(UpperCase(HotKeyStr))[0]);
if HotKeyID_ReadMessage <> 0 then
begin
UnregisterHotKey(Handle, HotKeyID_ReadMessage);
DeleteAtom(HotKeyID_ReadMessage);
end;
if (FindAtom('FReadMessageHotKey') = 0) and (HotKey > 0) then
begin
HotKeyID_ReadMessage := GlobalAddAtom(pchar('FReadMessageHotKey')) - $C000;
ModKey := GetModKey(FReadMessageHotKey);
if (not RegisterHotkey(Handle, HotKeyID_ReadMessage, ModKey, HotKey)) then
begin
FCanAlert := True;
ShowNotifyAlertForm('热键 ' + FReadMessageHotKey + ' 冲突！');
FCanAlert := False;
end;
//MessageBox(Handle, PChar('热键 ' + FReadMessageHotKey + ' 已被其它程序注册，请选择其它热键！'), '提示', MB_ICONERROR);
end;
SaveHotKeyConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.LoadStyleConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
StyleConfigNode: IXMLNode;
iLoop: Integer;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterTreeView: TRealICQContacterTreeView;
AUIMainColor: TColor;
ALVStyle: TRealICQContacterListItemStyle;
ALVCaptionStyle: TRealICQContacterListItemCaptionStyle;
AShowTree: Boolean;
ASkinName, OldSkinName: string;
begin
XMLFile := TRealICQClient.GetUserDir + StyleConfigXMLFile;
SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + StyleConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
StyleConfigNode := XMLDocument.DocumentElement;
OldSkinName := SkinName;
try
ASkinName := StyleConfigNode.ChildNodes.FindNode('SkinName').Attributes['Value'];
if ASkinName <> SkinName then
begin
SkinName := ASkinName;
SaveDefaultConfigs;
ChangeUIColor(UIMainColor);
end;
except
SkinName := OldSkinName;
end;
AUIMainColor := StyleConfigNode.ChildNodes.FindNode('UIMainColor').Attributes['Value'];
ChangeUIColor(FUIMainColor);
FUIMainColor := AUIMainColor;
SaveDefaultConfigs;
if not Assigned(StyleConfigNode.ChildNodes.FindNode('ShowTree')) then
begin
StyleConfigNode.AddChild('ShowTree').Attributes['Value'] := True;
XMLDocument.SaveToFile();
end;
AShowTree := StyleConfigNode.ChildNodes.FindNode('ShowTree').Attributes['Value'];
FShowTree := AShowTree;
actShowTree.Checked := FShowTree;
ALVStyle := StyleConfigNode.ChildNodes.FindNode('LVStyle').Attributes['Value'];
if (RealICQClient.WorkingMode = wmCorporation) or FShowTree then
begin
if ALVStyle <> lsNoHeadImage then
ALVStyle := lsSmallHeadImage;
end;
if ALVStyle <> FLVStyle then
begin
FLVStyle := ALVStyle;
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
RealICQContacterListView.Style := FLVStyle;
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
RealICQContacterTreeView.Style := FLVStyle;
end;
end;
ALVCaptionStyle := StyleConfigNode.ChildNodes.FindNode('LVCaptionStyle').Attributes['Value'];
if ALVCaptionStyle <> FLVCaptionStyle then
begin
FLVCaptionStyle := ALVCaptionStyle;
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
RealICQContacterListView.CaptionStyle := FLVCaptionStyle;
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
RealICQContacterTreeView.CaptionStyle := FLVCaptionStyle;
end;
end;
FShowGIFInMailForm := StyleConfigNode.ChildNodes.FindNode('ShowGIFInMailForm').Attributes['Value'];
actShowGIFInMailForm.Checked := FShowGIFInMailForm;
FShowGIFInTalkingForm := StyleConfigNode.ChildNodes.FindNode('ShowGIFInTalkingForm').Attributes['Value'];
actShowGIFInTalkingForm.Checked := FShowGIFInTalkingForm;
FShowStrangers := not StyleConfigNode.ChildNodes.FindNode('ShowStrangers').Attributes['Value'];
if (RealICQClient.WorkingMode = wmCorporation) then
FShowStrangers := True;
actShowStrangers.Enabled := True;
actShowStrangers.Execute;
FShowBlacklists := not StyleConfigNode.ChildNodes.FindNode('ShowBlacklists').Attributes['Value'];
if (RealICQClient.WorkingMode = wmCorporation) then
FShowBlacklists := True;
actShowBlacklists.Enabled := True;
actShowBlacklists.Execute;
FShowTeams := not StyleConfigNode.ChildNodes.FindNode('ShowTeams').Attributes['Value'];
actShowTeams.Enabled := True;
actShowTeams.Execute;
FShowLatests := not StyleConfigNode.ChildNodes.FindNode('ShowLatests').Attributes['Value'];
actShowLatests.Enabled := True;
actShowLatests.Execute;
FTalkingFormAlwaysOnTop := StyleConfigNode.ChildNodes.FindNode('TalkingFormAlwaysOnTop').Attributes['Value'];
FCtrlEnterSendMessage := StyleConfigNode.ChildNodes.FindNode('CtrlEnterSendMessage').Attributes['Value'];
if not Assigned(StyleConfigNode.ChildNodes.FindNode('CopyScreenHideTalkForm')) then
begin
StyleConfigNode.AddChild('CopyScreenHideTalkForm').Attributes['Value'] := False;
XMLDocument.SaveToFile();
end;
FCopyScreenHideTalkForm := StyleConfigNode.ChildNodes.FindNode('CopyScreenHideTalkForm').Attributes['Value'];
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveStyleConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
StyleConfigNode: IXMLNode;
begin
XMLFile := TRealICQClient.GetUserDir + StyleConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + StyleConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
StyleConfigNode := XMLDocument.DocumentElement;
StyleConfigNode.ChildNodes.FindNode('SkinName').Attributes['Value'] := SkinName;
StyleConfigNode.ChildNodes.FindNode('UIMainColor').Attributes['Value'] := FUIMainColor;
StyleConfigNode.ChildNodes.FindNode('ShowTree').Attributes['Value'] := FShowTree;
StyleConfigNode.ChildNodes.FindNode('LVStyle').Attributes['Value'] := FLVStyle;
StyleConfigNode.ChildNodes.FindNode('LVCaptionStyle').Attributes['Value'] := FLVCaptionStyle;
StyleConfigNode.ChildNodes.FindNode('ShowStrangers').Attributes['Value'] := FShowStrangers;
StyleConfigNode.ChildNodes.FindNode('ShowBlacklists').Attributes['Value'] := FShowBlacklists;
StyleConfigNode.ChildNodes.FindNode('ShowTeams').Attributes['Value'] := FShowTeams;
StyleConfigNode.ChildNodes.FindNode('ShowLatests').Attributes['Value'] := FShowLatests;
StyleConfigNode.ChildNodes.FindNode('ShowGIFInMailForm').Attributes['Value'] := FShowGIFInMailForm;
StyleConfigNode.ChildNodes.FindNode('ShowGIFInTalkingForm').Attributes['Value'] := FShowGIFInTalkingForm;
StyleConfigNode.ChildNodes.FindNode('TalkingFormAlwaysOnTop').Attributes['Value'] := FTalkingFormAlwaysOnTop;
StyleConfigNode.ChildNodes.FindNode('CtrlEnterSendMessage').Attributes['Value'] := FCtrlEnterSendMessage;
StyleConfigNode.ChildNodes.FindNode('CopyScreenHideTalkForm').Attributes['Value'] := FCopyScreenHideTalkForm;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.LoadAutoUpdateConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
AutoUpdateConfigNode: IXMLNode;
begin
XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + AutoUpdateConfigXMLFile;
SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
XMLDocument.LoadFromFile(XMLFile);
AutoUpdateConfigNode := XMLDocument.DocumentElement;
FAutoUpdate := AutoUpdateConfigNode.ChildNodes.FindNode('AutoUpdate').Attributes['Value'];
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveAutoUpdateConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
AutoUpdateConfigNode: IXMLNode;
begin
XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + AutoUpdateConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
XMLDocument.LoadFromFile(XMLFile);
AutoUpdateConfigNode := XMLDocument.DocumentElement;
AutoUpdateConfigNode.ChildNodes.FindNode('AutoUpdate').Attributes['Value'] := FAutoUpdate;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.LoadDefaultConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
DefaultConfigNode: IXMLNode;
OldSkinName: string;
BaseTop, BaseLeft: Integer;
begin
BaseTop := (Height - ClientHeight) div 2;
BaseLeft := (Width - ClientWidth) div 2;
XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + DefaultConfigXMLFile;
SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
XMLDocument.LoadFromFile(XMLFile);
DefaultConfigNode := XMLDocument.DocumentElement;
FUIMainColor := DefaultConfigNode.ChildNodes.FindNode('UIMainColor').Attributes['Value'];
OldSkinName := SkinName;
try
SkinName := DefaultConfigNode.ChildNodes.FindNode('SkinName').Attributes['Value'];
except
SkinName := OldSkinName;
end;
FShowMainFormOnStart := DefaultConfigNode.ChildNodes.FindNode('ShowMainFormOnStart').Attributes['Value'];
FMainFormLeft := DefaultConfigNode.ChildNodes.FindNode('MainFormLeft').Attributes['Value'];
FMainFormTop := DefaultConfigNode.ChildNodes.FindNode('MainFormTop').Attributes['Value'];
FMainFormWidth := DefaultConfigNode.ChildNodes.FindNode('MainFormWidth').Attributes['Value'];
FMainFormHeight := DefaultConfigNode.ChildNodes.FindNode('MainFormHeight').Attributes['Value'];
FTalkingFormLeft := DefaultConfigNode.ChildNodes.FindNode('TalkingFormLeft').Attributes['Value'];
FTalkingFormTop := DefaultConfigNode.ChildNodes.FindNode('TalkingFormTop').Attributes['Value'];
FTalkingFormWidth := DefaultConfigNode.ChildNodes.FindNode('TalkingFormWidth').Attributes['Value'];
FTalkingFormHeight := DefaultConfigNode.ChildNodes.FindNode('TalkingFormHeight').Attributes['Value'];
if not Assigned(DefaultConfigNode.ChildNodes.FindNode('TalkingRightWidth')) then
begin
DefaultConfigNode.AddChild('TalkingRightWidth').Attributes['Value'] := 0;
XMLDocument.SaveToFile();
end;
FTalkingRightWidth := DefaultConfigNode.ChildNodes.FindNode('TalkingRightWidth').Attributes['Value'];
if not Assigned(DefaultConfigNode.ChildNodes.FindNode('SMSFormLeft')) then
begin
DefaultConfigNode.AddChild('SMSFormLeft').Attributes['Value'] := -1;
XMLDocument.SaveToFile();
end;
FSMSFormLeft := DefaultConfigNode.ChildNodes.FindNode('SMSFormLeft').Attributes['Value'];
if not Assigned(DefaultConfigNode.ChildNodes.FindNode('SMSFormTop')) then
begin
DefaultConfigNode.AddChild('SMSFormTop').Attributes['Value'] := -1;
XMLDocument.SaveToFile();
end;
FSMSFormTop := DefaultConfigNode.ChildNodes.FindNode('SMSFormTop').Attributes['Value'];
if not Assigned(DefaultConfigNode.ChildNodes.FindNode('SMSFormWidth')) then
begin
DefaultConfigNode.AddChild('SMSFormWidth').Attributes['Value'] := -1;
XMLDocument.SaveToFile();
end;
FSMSFormWidth := DefaultConfigNode.ChildNodes.FindNode('SMSFormWidth').Attributes['Value'];
if not Assigned(DefaultConfigNode.ChildNodes.FindNode('SMSFormHeight')) then
begin
DefaultConfigNode.AddChild('SMSFormHeight').Attributes['Value'] := -1;
XMLDocument.SaveToFile();
end;
FSMSFormHeight := DefaultConfigNode.ChildNodes.FindNode('SMSFormHeight').Attributes['Value'];
if FMainFormHeight <= 0 then
FMainFormHeight := Round(Screen.WorkAreaHeight * 0.8);
if FMainFormWidth <= 0 then
FMainFormWidth := 258;
if (FMainFormLeft + FMainFormWidth - BaseLeft < 2) then
FMainFormLeft := 0;
if (FMainFormLeft - BaseLeft > Screen.WorkAreaWidth - 2) then
FMainFormLeft := Screen.WorkAreaWidth - FMainFormWidth;
if (FMainFormTop + FMainFormHeight - BaseTop < 2) then
FMainFormTop := 0;
if (FMainFormTop > Screen.WorkAreaHeight) then
FMainFormTop := 0;
if FTalkingFormHeight <= 0 then
FTalkingFormHeight := Round(Screen.WorkAreaHeight * 0.6);
if FTalkingFormWidth <= 0 then
FTalkingFormWidth := Round(Screen.WorkAreaWidth * 0.6);
if (FTalkingFormLeft < 0) or (FTalkingFormLeft > Screen.WorkAreaWidth) then
FTalkingFormLeft := (Screen.WorkAreaWidth - FTalkingFormWidth) div 2;
if (FTalkingFormTop < 0) or (FTalkingFormTop > Screen.WorkAreaHeight) then
FTalkingFormTop := (Screen.WorkAreaHeight - FTalkingFormHeight) div 2;
if FSMSFormHeight <= 0 then
FSMSFormHeight := 410;
if FSMSFormWidth <= 0 then
FSMSFormWidth := 460;
if (FSMSFormLeft < 0) or (FSMSFormLeft > Screen.WorkAreaWidth) then
FSMSFormLeft := (Screen.WorkAreaWidth - FSMSFormWidth) div 2;
if (FSMSFormTop < 0) or (FSMSFormTop > Screen.WorkAreaHeight) then
FSMSFormTop := (Screen.WorkAreaHeight - FSMSFormHeight) div 2;
Left := FMainFormLeft;
Top := FMainFormTop;
Width := FMainFormWidth;
Height := FMainFormHeight;
FAlwaysOnTop := DefaultConfigNode.ChildNodes.FindNode('AlwaysOnTop').Attributes['Value'];
actAlwaysOnTop.Enabled := True;
actAlwaysOnTop.Execute;
if not Assigned(DefaultConfigNode.ChildNodes.FindNode('AutoHideMainForm')) then
begin
DefaultConfigNode.AddChild('AutoHideMainForm').Attributes['Value'] := True;
XMLDocument.SaveToFile();
end;
FAutoHide := DefaultConfigNode.ChildNodes.FindNode('AutoHideMainForm').Attributes['Value'];
CheckWindowPositon;
if not Assigned(DefaultConfigNode.ChildNodes.FindNode('AutoShowRequestMessage')) then
begin
DefaultConfigNode.AddChild('AutoShowRequestMessage').Attributes['Value'] := False;
XMLDocument.SaveToFile();
end;
FAutoShowRequestMessage := DefaultConfigNode.ChildNodes.FindNode('AutoShowRequestMessage').Attributes['Value'];
if not Assigned(DefaultConfigNode.ChildNodes.FindNode('ConfirmSendOfflineFile')) then
begin
DefaultConfigNode.AddChild('ConfirmSendOfflineFile').Attributes['Value'] := True;
XMLDocument.SaveToFile();
end;
FConfirmSendOfflineFile := DefaultConfigNode.ChildNodes.FindNode('ConfirmSendOfflineFile').Attributes['Value'];
if not Assigned(DefaultConfigNode.ChildNodes.FindNode('AppEnable')) then
begin
DefaultConfigNode.AddChild('AppEnable').Attributes['Value'] := False;
XMLDocument.SaveToFile();
end;
ImgApp.Visible := DefaultConfigNode.ChildNodes.FindNode('AppEnable').Attributes['Value'];
if not Assigned(DefaultConfigNode.ChildNodes.FindNode('NewConsole')) then
begin
DefaultConfigNode.AddChild('NewConsole').Attributes['Value'] := True;
XMLDocument.SaveToFile();
end;
FNewConsole := DefaultConfigNode.ChildNodes.FindNode('NewConsole').Attributes['Value'];
if not Assigned(DefaultConfigNode.ChildNodes.FindNode('CaEnable')) then
begin
DefaultConfigNode.AddChild('CaEnable').Attributes['Value'] := False;
XMLDocument.SaveToFile();
end;
RealICQClient.CaEnable := DefaultConfigNode.ChildNodes.FindNode('CaEnable').Attributes['Value'];
btnCALogin.Visible := RealICQClient.CaEnable;
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveDefaultConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
DefaultConfigNode: IXMLNode;
begin
XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + DefaultConfigXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
XMLDocument.LoadFromFile(XMLFile);
DefaultConfigNode := XMLDocument.DocumentElement;
DefaultConfigNode.ChildNodes.FindNode('SkinName').Attributes['Value'] := SkinName;
DefaultConfigNode.ChildNodes.FindNode('UIMainColor').Attributes['Value'] := FUIMainColor;
DefaultConfigNode.ChildNodes.FindNode('AlwaysOnTop').Attributes['Value'] := FAlwaysOnTop;
DefaultConfigNode.ChildNodes.FindNode('AutoHideMainForm').Attributes['Value'] := FAutoHide;
DefaultConfigNode.ChildNodes.FindNode('AutoShowRequestMessage').Attributes['Value'] := FAutoShowRequestMessage;
DefaultConfigNode.ChildNodes.FindNode('ShowMainFormOnStart').Attributes['Value'] := FShowMainFormOnStart;
try
DefaultConfigNode.ChildNodes.FindNode('ConfirmSendOfflineFile').Attributes['Value'] := FConfirmSendOfflineFile;
except
end;
DefaultConfigNode.ChildNodes.FindNode('MainFormLeft').Attributes['Value'] := FMainFormLeft;
DefaultConfigNode.ChildNodes.FindNode('MainFormTop').Attributes['Value'] := FMainFormTop;
DefaultConfigNode.ChildNodes.FindNode('MainFormWidth').Attributes['Value'] := FMainFormWidth;
DefaultConfigNode.ChildNodes.FindNode('MainFormHeight').Attributes['Value'] := FMainFormHeight;
DefaultConfigNode.ChildNodes.FindNode('TalkingFormLeft').Attributes['Value'] := FTalkingFormLeft;
DefaultConfigNode.ChildNodes.FindNode('TalkingFormTop').Attributes['Value'] := FTalkingFormTop;
DefaultConfigNode.ChildNodes.FindNode('TalkingFormWidth').Attributes['Value'] := FTalkingFormWidth;
DefaultConfigNode.ChildNodes.FindNode('TalkingFormHeight').Attributes['Value'] := FTalkingFormHeight;
DefaultConfigNode.ChildNodes.FindNode('TalkingRightWidth').Attributes['Value'] := FTalkingRightWidth;
DefaultConfigNode.ChildNodes.FindNode('SMSFormLeft').Attributes['Value'] := FSMSFormLeft;
DefaultConfigNode.ChildNodes.FindNode('SMSFormTop').Attributes['Value'] := FSMSFormTop;
DefaultConfigNode.ChildNodes.FindNode('SMSFormWidth').Attributes['Value'] := FSMSFormWidth;
DefaultConfigNode.ChildNodes.FindNode('SMSFormHeight').Attributes['Value'] := FSMSFormHeight;
XMLDocument.SaveToFile();
finally
XMLDocument.Free;
end;
end;
//------------------------------------------------------------------------------
//procedure TMainForm.LoadGroupConfig;
//var
// XMLDocument: TXMLDocument;
// ServerConfigNode: IXMLNode;
//begin
// XMLDocument := TXMLDocument.Create(Self);
// try
// XMLDocument.Active := True;
//
// if csDesigning in ComponentState then
// exit;
// XMLDocument.LoadFromFile(ExtractFilePath(Application.ExeName) + ConfigXMLFilePath + 'GroupServerConfig.xml');
//
// ServerConfigNode := XMLDocument.DocumentElement;
//
// FGroupAddress := ServerConfigNode.ChildNodes.FindNode('GroupServer').Attributes['Address'];
// FGroupPort := ServerConfigNode.ChildNodes.FindNode('GroupServer').Attributes['Port'];
// FGroupImagePort := ServerConfigNode.ChildNodes.FindNode('GroupServer').Attributes['ImagePort'];
// FGroupShareAddress := ServerConfigNode.ChildNodes.FindNode('GroupShareServer').Attributes['Address'];
// FGroupSharePort := ServerConfigNode.ChildNodes.FindNode('GroupShareServer').Attributes['Port'];
// except
// on E: Exception do
// begin
// Error(E.Message, 'TMainForm.LoadGroupConfig');
// XMLDocument.Free;
// end;
// end;
// XMLDocument.Free;
//end;
procedure TMainForm.LoadGroupConfigs;
var
XMLFile: string;
XMLDocument: TXMLDocument;
GroupConfigNode, GroupListNode, GroupNode: IXMLNode;
GroupMembers: TStringList;
iLoop, jLoop: Integer;
begin
XMLFile := TRealICQClient.GetUserDir + GroupConfigXMLFile;
SetFileAttributes(Pchar(XMLFile), file_attribute_normal);
XMLDocument := TXMLDocument.Create(Self);
try
XMLDocument.Active := True;
if not FileExists(XMLFile) then
begin
CopyFile(PChar(ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + GroupConfigXMLFile), PChar(XMLFile), False);
XMLDocument.Active := True;
end;
XMLDocument.LoadFromFile(XMLFile);
GroupConfigNode := XMLDocument.DocumentElement;
FShowGroup := GroupConfigNode.ChildNodes.FindNode('ShowGroup').Attributes['Value'];
actShowGroup.Checked := FShowGroup;
GroupListNode := GroupConfigNode.ChildNodes.FindNode('Groups');
FGroups.Clear;
for iLoop := 0 to GroupListNode.ChildNodes.Count - 1 do
begin
GroupNode := GroupListNode.ChildNodes[iLoop];
GroupMembers := TStringList.Create;
for jLoop := 0 to GroupNode.ChildNodes.Count - 1 do
begin
GroupMembers.Add(GroupNode.ChildNodes[jLoop].Text);
end;
FGroups.InsertObject(GroupNode.Attributes['Position'], GroupNode.Attributes['Name'], GroupMembers);
end;
except
on E: Exception do
begin
Error(E.Message, 'TMainForm.LoadGroupConfigs');
XMLDocument.Free;
end;
end;
XMLDocument.Free;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miMoveToStrangersClick(Sender: TObject);
{var
GroupIndex, iLoop: Integer;
GroupName: String;
ListView: TRealICQContacterListView;
ListItem: TRealICQContacterListItem;
ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
Employee: TRealICQEmployee; }
begin
{ if MessageBox(Handle,
'确实要将选中的用户移至陌生人中吗？',
'确认',
MB_OKCANCEL or MB_ICONQUESTION) <> IDOK then Exit;
GroupName :='陌生人';// navForContacters.Groups[navForContacters.ActiveGroupIndex];
if (GroupName = lvStrangers)then exit;
if GroupName = LVMyContacters then
begin
ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Employee := RealICQContacterTreeView.GetSelectedEmployee;
RealICQClient.MoveToStrangers(Employee.LoginName);
Exit;
end;
GroupIndex := FContacterListViews.IndexOf(GroupName);
ListView := FContacterListViews.Objects[GroupIndex] as TRealICQContacterListView;
ListView.DisableAlign;
try
for iLoop := ListView.Items.Count - 1 downto 0 do
begin
ListItem := ListView.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
RealICQClient.MoveToStrangers(ListItem.LoginName);
Sleep(15);
end;
end;
finally
ListView.EnableAlign;
end;
}
end;
procedure TMainForm.miMuteClick(Sender: TObject);
begin
FLoginState := stMute;
FLeaveMessage := '勿扰';
SetLoginStateControlState;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miOnlineClick(Sender: TObject);
begin
FLoginState := stOnline;
FLeaveMessage := '';
SetLoginStateControlState;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miOtherStateClick(Sender: TObject);
var
LeaveMessage: string;
begin
LeaveMessage := Trim(ShowMyInputBox('其它状态', '请输入离开状态说明文字', '', 16));
if Length(LeaveMessage) > 0 then
begin
FLoginState := stLeave;
FLeaveMessage := LeaveMessage;
SetLoginStateControlState;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miMoveToBlacklistsClick(Sender: TObject);
var
GroupName: string;
TreeView: TRealICQContacterTreeView;
ItemIndex: Integer;
Friend: TRealICQEmployee;
Black: TRealICQEmployee;
begin
if MessageBox(Handle, '确实要将选中的用户移至黑名单吗？', '确认', MB_OKCANCEL or MB_ICONQUESTION) <> IDOK then
Exit;
ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
TreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Friend := TreeView.GetSelectedEmployee;
if Friend = nil then
Exit;
Black := TRealICQEmployee.Create(Friend.LoginName);
Black.BranchID := LvBlackLists;
Black.DisplayName := Friend.DisplayName;
GroupName := Friend.BranchID;
if (GroupName = lvBlacklists) then
exit;
if GroupName = LvFriends then
begin
RealICQClient.DelFriend(Friend.LoginName);
RealICQClient.MoveToBlacklists(Friend.LoginName);
TreeView.AddEmployee(Black);
end;
end;
procedure TMainForm.miSkinClick(Sender: TObject);
var
OldSkin: string;
begin
OldSkin := SkinName;
try
SkinName := (Sender as TMenuItem).Caption;
ChangeAddFriendFormSkin(SkinName);
ChangeAddFriendRequestFormSkin(SkinName);
ChangeTalkingFormSkin(SkinName);
ChangeSMSFormSkin(SkinName);
ChangeSeeUserInformationFormsSkin(SkinName);
ChangeSystemMessageFormsSkin(SkinName);
ChangeTeamOptionsFormSkin(SkinName);
if VideoForm <> nil then
begin
VideoForm.SkinName := SkinName;
VideoForm.ChangeUIColor(VideoForm.TalkingForm.WindowColor);
end;
if CreateTeamForm <> nil then
begin
CreateTeamForm.SkinName := SkinName;
CreateTeamForm.ChangeUIColor(UIMainColor);
end;
if SearchForm <> nil then
begin
SearchForm.SkinName := SkinName;
SearchForm.ChangeUIColor(UIMainColor);
end;
if SearchTeamForm <> nil then
begin
SearchTeamForm.SkinName := SkinName;
SearchTeamForm.ChangeUIColor(UIMainColor);
end;
if CustomFacesManagerForm <> nil then
begin
CustomFacesManagerForm.SkinName := SkinName;
CustomFacesManagerForm.ChangeUIColor(UIMainColor);
end;
if VCardForm <> nil then
begin
VCardForm.SkinName := SkinName;
VCardForm.ChangeUIColor(UIMainColor);
end;
except
MessageBox(Handle, '加载界面时出错！', '错误', MB_ICONERROR);
SkinName := OldSkin;
end;
ChangeUIColor(UIMainColor);
PostMessage(Handle, WM_SIZE, 0, 0);
if RealICQClient.Logined and RealICQClient.Connected then
SaveStyleConfigs;
SaveDefaultConfigs;
end;
//----------------------------------------------------
procedure TMainForm.ImageButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FHintWindow.ReleaseHandle;
FHintWindow.Visible := False;
SetToolBarState(Sender);
end;
procedure TMainForm.tsContactersResize(Sender: TObject);
begin
{ TODO -olqq -c : 注释 2015/1/22 15:30:11 }
// ScrollBoxContacters.Width := pnlGroups.Width;
// PnlMoreUser.Width := pnlGroups.Width;
// ScrollBoxMyFriend.Width := pnlGroups.Width;
// ScrollBoxTeam.Width := pnlGroups.Width;
// ScrollBoxLatests.Width := pnlGroups.Width;
// ScrollBoxContacters.Height := pnlGroups.Height;
// PnlMoreUser.Height := pnlGroups.Height;
// ScrollBoxMyFriend.Height := pnlGroups.Height;
// ScrollBoxTeam.Height := pnlGroups.Height;
// ScrollBoxLatests.Height := pnlGroups.Height;
{ScrollBoxContacters.Left := 0;
PnlMoreUser.Left := ScrollBoxContacters.Left + ScrollBoxContacters.Width;
ScrollBoxMyFriend.Left := PnlMoreUser.Left + PnlMoreUser.Width;
ScrollBoxTeam.Left := ScrollBoxMyFriend.Left + ScrollBoxMyFriend.Width;
ScrollBoxLatests.Left := ScrollBoxTeam.Left + ScrollBoxTeam.Width;}
end;
procedure TMainForm.tsContactersShow(Sender: TObject);
begin
{ScrollBoxContacters.Visible := True;
PnlMoreUser.Visible := True;
ScrollBoxMyFriend.Visible := True;
ScrollBoxTeam.Visible := True;
ScrollBoxLatests.Visible := True;}
{ TODO -olqq -c : 注释 2015/1/22 15:33:36 }
// ScrollBoxContacters.Align := alNone;
// PnlMoreUser.Align := alNone;
// ScrollBoxMyFriend.Align := alNone;
// ScrollBoxTeam.Align := alNone;
// ScrollBoxLatests.Align := alNone;
// ScrollBoxContacters.Top := 0;
// PnlMoreUser.Top := 0;
// ScrollBoxMyFriend.Top := 0;
// ScrollBoxTeam.Top := 0;
// ScrollBoxLatests.Top := 0;
tsContactersResize(tsContacters);
end;
//-----------------------------------------------------
procedure TMainForm.SetToolBarState(Sender: TObject);
var
ImageButton: TRealICQHoverImage;
TmpImageButton: TRealICQHoverImage;
TmpImageButtonIcon: TRealICQHoverImage;
iLoop: Integer;
OldControl, NewControl: TWinControl;
ItemIndex, divSize: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
ImageButton := FToolBarButtonList.Objects[(Sender as TRealICQHoverImage).Tag - 1] as TRealICQHoverImage;
OldControl := nil;
if ScrollBoxContacters.Visible then
OldControl := ScrollBoxContacters;
if PnlMoreUser.Visible then
OldControl := PnlMoreUser;
if ScrollBoxMyFriend.Visible then
OldControl := ScrollBoxMyFriend;
if ScrollBoxTeam.Visible then
OldControl := ScrollBoxTeam;
if ScrollBoxLatests.Visible then
OldControl := ScrollBoxLatests;
{if ImageButton.Tag = 2 then
begin
if ScrollBoxMoreUser.Tag = 0 then
begin
ScrollBoxMoreUser.Tag := 1;
end;
end; }
NewControl := nil;
if ImageButton.Tag = 1 then
NewControl := ScrollBoxContacters;
if ImageButton.Tag = 2 then
NewControl := PnlMoreUser;
if ImageButton.Tag = 3 then
NewControl := ScrollBoxMyFriend;
if ImageButton.Tag = 4 then
NewControl := ScrollBoxTeam;
if ImageButton.Tag = 5 then
NewControl := ScrollBoxLatests;
if False and (OldControl <> nil) then
begin
ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.HideScroll;
RealICQContacterTreeView.ReDrawAll;
RealICQContacterTreeView.BeginUpdate;
ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.HideScroll;
RealICQContacterTreeView.ReDrawAll;
RealICQContacterTreeView.BeginUpdate;
Application.ProcessMessages;
//Exit;
NewControl.DisableAlign;
NewControl.Enabled := False;
OldControl.DisableAlign;
OldControl.Enabled := False;
divSize := pnlGroups.Width div 10;
try
if OldControl.Tag < NewControl.Tag then
begin
NewControl.Left := OldControl.Left + OldControl.Width;
NewControl.Visible := True;
while NewControl.Left > 0 do
begin
if NewControl.Left - divSize < 0 then
begin
NewControl.Left := 0;
end
else
begin
OldControl.Left := OldControl.Left - divSize;
NewControl.Left := NewControl.Left - divSize;
end;
Application.ProcessMessages;
Sleep(10);
end;
OldControl.Visible := False;
end
else
begin
NewControl.Left := OldControl.Left - OldControl.Width;
NewControl.Visible := True;
while NewControl.Left < 0 do
begin
if NewControl.Left + divSize > 0 then
begin
NewControl.Left := 0;
end
else
begin
OldControl.Left := OldControl.Left + divSize;
NewControl.Left := NewControl.Left + divSize;
end;
Application.ProcessMessages;
Sleep(10);
end;
OldControl.Visible := False;
end;
finally
ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.EndUpdate;
ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.EndUpdate;
NewControl.EnableAlign;
NewControl.Enabled := True;
OldControl.EnableAlign;
OldControl.Enabled := True;
end;
end
else
begin
if OldControl <> nil then
OldControl.Visible := False;
NewControl.Left := 0;
NewControl.Visible := True;
end;
pnlTeams.Visible := ImageButton.Tag = 4;
if pnlTeams.Visible then
pnlTeams.Height := 22
else
pnlTeams.Height := 0;
{ScrollBoxContacters.Visible := ImageButton.Tag = 1;
PnlMoreUser.Visible := ImageButton.Tag = 2;
ScrollBoxMyFriend.Visible := ImageButton.Tag = 3;
ScrollBoxTeam.Visible := ImageButton.Tag = 4;
pnlTeams.Visible := ImageButton.Tag = 4;
if pnlTeams.Visible then
pnlTeams.Height := 22
else
pnlTeams.Height := 0;
ScrollBoxLatests.Visible := ImageButton.Tag = 5; }
ActiveButtonTag := ImageButton.Tag;
for iLoop := 0 to FToolBarButtonList.Count - 1 do
begin
TmpImageButton := FToolBarButtonList.Objects[iLoop] as TRealICQHoverImage;
TmpImageButtonIcon := FToolBarButtonIconList.Objects[iLoop] as TRealICQHoverImage;
if TmpImageButton.Tag = ImageButton.Tag then
begin
TmpImageButton.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\menu\01_On.bmp');
TmpImageButton.OnMouseUp := nil;
TmpImageButton.OnMouseEnter := nil;
TmpImageButton.OnMouseLeave := nil;
TmpImageButtonIcon.OnMouseUp := nil;
TmpImageButtonIcon.OnMouseEnter := nil;
TmpImageButtonIcon.OnMouseLeave := nil;
end
else
begin
TmpImageButton.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\menu\01_Off.bmp');
TmpImageButton.OnMouseUp := ImageButtonMouseUp;
TmpImageButton.OnMouseEnter := ImageButtonEnter;
TmpImageButton.OnMouseLeave := ImageButtonLeave;
TmpImageButtonIcon.OnMouseUp := ImageButtonMouseUp;
TmpImageButtonIcon.OnMouseEnter := ImageButtonEnter;
TmpImageButtonIcon.OnMouseLeave := ImageButtonLeave;
end;
ConvertBitmapToColor(TmpImageButton.Picture.Bitmap, UIMainColor);
end;
end;
//----------------------------
procedure TMainForm.ImageButtonEnter(Sender: TObject);
var
ImageButton: TRealICQHoverImage;
ImagePath: string;
procedure OpenHint(HintStr: string);
var
TextWidth, TextHeight: Integer;
rect: TRect;
begin
TextWidth := FHintWindow.Canvas.TextWidth(HintStr);
TextHeight := FHintWindow.Canvas.TextHeight(HintStr);
rect.Left := Mouse.CursorPos.X;
rect.Top := Mouse.CursorPos.Y + 20;
rect.Right := rect.Left + TextWidth + 5;
rect.Bottom := rect.Top + TextHeight;
FHintWindow.Color := clInfoBk;
FHintWindow.ActivateHint(Rect, HintStr);
FHintWindow.Visible := True;
end;
begin
ImageButton := FToolBarButtonList.Objects[(Sender as TRealICQHoverImage).Tag - 1] as TRealICQHoverImage;
ImagePath := ExtractFilePath(Application.ExeName) + 'Images\menu\01_Over.bmp';
ImageButton.Picture.LoadFromFile(ImagePath);
ConvertBitmapToColor(ImageButton.Picture.Bitmap, UIMainColor);
OpenHint(FToolBarButtonList[ImageButton.Tag - 1]);
end;
//-----------------------------
procedure TMainForm.ImageButtonLeave(Sender: TObject);
var
ImageButton: TRealICQHoverImage;
ImagePath: string;
begin
ImageButton := FToolBarButtonList.Objects[(Sender as TRealICQHoverImage).Tag - 1] as TRealICQHoverImage;
ImagePath := ExtractFilePath(Application.ExeName) + 'Images\menu\01_Off.bmp';
ImageButton.Picture.LoadFromFile(ImagePath);
ConvertBitmapToColor(ImageButton.Picture.Bitmap, UIMainColor);
FHintWindow.ReleaseHandle;
FHintWindow.Visible := False;
end;
procedure TMainForm.miChangeLoginNameClick(Sender: TObject);
var
LoginUser: TLoginUser;
begin
try
LoginUser := RealICQClient.LoginedUsers.Objects[(Sender as TMenuItem).Tag] as TLoginUser;
edPassword.Text := '';
edLoginName.Text := LoginUser.LoginName;
if (LoginUser.Password <> '') and (LoginUser.LoginName <> '') then
begin
edPassword.Text := RealICQClient.DecyptPassword(LoginUser.Password);
FSavePassword := True;
self.ImgLstCheckStates.GetIcon(1, spbSavePassword.Icon);
end;
self.lblRemoveMyLoginInfo.Visible := True;
except
edLoginName.Text := '';
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miClearLoginHistoryClick(Sender: TObject);
var
ClearAll: Boolean;
begin
ClearAll := True;
if UpperCase(Sender.ClassName) = UpperCase('TLabel') then
ClearAll := False;
MainForm.RealICQClient.ClearLoginHistory(ClearAll, edLoginName.Text);
edLoginName.Text := '';
edPassword.Text := '';
actLoginAs.Visible := False;
SetLoginControlsVisible(True);
end;
//------------------------------------------------------------------------------
procedure TMainForm.miColorClick(Sender: TObject);
begin
FUIMainColor := (Sender as TMenuItem).Tag;
ChangeUIColor((Sender as TMenuItem).Tag);
if RealICQClient.Logined and RealICQClient.Connected then
SaveStyleConfigs;
SaveDefaultConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miHiddenClick(Sender: TObject);
begin
FLoginState := stHidden;
FLeaveMessage := '';
SetLoginStateControlState;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miMeetingClick(Sender: TObject);
begin
FLoginState := stLeave;
FLeaveMessage := (Sender as TMenuItem).Caption;
SetLoginStateControlState;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miMoreColorsClick(Sender: TObject);
begin
ColorDialog.Color := FUIMainColor;
if ColorDialog.Execute then
begin
ChangeUIColor(ColorDialog.Color);
FUIMainColor := ColorDialog.Color;
if RealICQClient.Logined and RealICQClient.Connected then
SaveStyleConfigs;
SaveDefaultConfigs;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miMoveGroupClick(Sender: TObject);
var
GroupName, TargetGroupName: string;
MenuItem: TMenuItem;
GroupIndex, itemIndex: Integer;
TreeView: TRealICQContacterTreeView;
Friend: TRealICQEmployee;
GroupMembers, TargetGroupMembers: TStringList;
RealICQUser: TRealICQUser;
OldScrollBarTop: Integer;
begin
MenuItem := Sender as TMenuItem;
if MenuItem <> nil then
TargetGroupName := MenuItem.Caption
else
TargetGroupName := LVFriends;
ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
TreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Friend := TreeView.GetSelectedEmployee;
if Friend = nil then
Exit;
GroupName := Friend.BranchID;
OldScrollBarTop := TreeView.ScrollBarTop;
SetFlashCaptionOnOnlineValue(False);
LockWindowUpdate(GetDesktopWindow);
try
if FGroups.IndexOf(GroupName) >= 0 then
begin
GroupIndex := FGroups.IndexOf(GroupName);
GroupMembers := FGroups.Objects[GroupIndex] as TStringList;
GroupMembers.Delete(GroupMembers.IndexOf(Friend.LoginName));
end;
RealICQUser := Friend.Data;
TreeView.EmployeeItems.Delete(TreeView.EmployeeItems.IndexOf(Friend.LoginName));
//在树节点之间移动（）
Friend := TRealICQEmployee.Create(RealICQUser.LoginName);
Friend.BranchID := TargetGroupName;
TreeView.AddEmployee(Friend);
//UpdateFriendNode(Friend, RealICQUser, True);
TUsersService.GetUsersService.UpdateTreeNode(TreeView, Friend, RealICQUser);
if FGroups.IndexOf(TargetGroupName) >= 0 then
begin
GroupIndex := FGroups.IndexOf(TargetGroupName);
TargetGroupMembers := FGroups.Objects[GroupIndex] as TStringList;
TargetGroupMembers.Add(Friend.LoginName);
end;
finally
TreeView.ScrollBarTop := OldScrollBarTop;
LockWindowUpdate(0);
SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
SaveGroupConfigs;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.NodeDoubleClick(Employee: TRealICQEmployee);
var
SMSForm: TSMSForm;
begin
if (pgcMainWorkArea.ActivePage = tsAddrBook) then
begin
SMSForm := OpenSMSForm('', True);
SMSForm.edMobiles.Text := Employee.Mobile;
Exit;
end;
if Employee.Data <> nil then
begin
if AnsiSameText(Employee.LoginName, RealICQClient.Me.LoginName) then
begin
MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
Exit;
end;
{if GetActiveTabSheetName=MoreUser then
begin
RealICQClient.GetUserInformation(Employee.LoginName,True);
end; }
OpenTalkingForm(Employee.LoginName);
end;
end;
//小图标单击事件处理
//------------------------------------------------------------------------------
procedure TMainForm.NodeIconButtonClick(Sender: TObject; Employee: TRealICQEmployee; IconButtonType: TRealICQContacterTreeNodeIconButtonType);
var
RealICQUser: TRealICQUser;
begin
if IconButtonType = itHeadImage then
begin
HideUserCardForm;
end;
if IconButtonType = itSNS then
begin
RealICQUser := Employee.Data;
RealICQUser.ClickedSNSIcon;
try
RealICQClientUserInformationReady(RealICQClient, RealICQUser);
//UpdateEmployeeNode(Employee, RealICQUser, True);
//TUsersService.GetUsersService.UpdateTreeNode(Employee, RealICQUser, True);
finally
ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + SNSHomePage, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(RealICQUser.LoginName)])), '', SW_SHOWDEFAULT);
end;
end;
end;
//小图标双击事件处理
//------------------------------------------------------------------------------
procedure TMainForm.NodeIconButtonDblClick(Sender: TObject; Employee: TRealICQEmployee; IconButtonType: TRealICQContacterTreeNodeIconButtonType);
var
TalkingForm: TTalkingForm;
iWaitTimes: Integer;
RealICQUser: TRealICQUser;
SMSForm: TSMSForm;
begin
HideUserCardForm;
if (pgcMainWorkArea.ActivePage = tsAddrBook) then
begin
SMSForm := OpenSMSForm('', True);
SMSForm.edMobiles.Text := Employee.Mobile;
Exit;
end;
if IconButtonType = itCamera then
begin
if AnsiSameText(Employee.LoginName, RealICQClient.Me.LoginName) then
begin
MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
Exit;
end;
TalkingForm := GetTalkingForm(Employee.LoginName);
if TalkingForm = nil then
begin
TalkingForm := OpenTalkingForm(Employee.LoginName, True);
end;
iWaitTimes := 0;
while not TalkingForm.CanWriteMessage do
begin
Application.ProcessMessages;
Inc(iWaitTimes);
if iWaitTimes > 1000 then
break;
Sleep(10);
end;
TalkingForm.actVideo.Execute;
end;
if IconButtonType = itHeadImage then
begin
if pgcMainWorkArea.ActivePage = tsAddrBook then
Exit;
if AnsiSameText(Employee.LoginName, RealICQClient.Me.LoginName) then
begin
MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
Exit;
end;
//Employee.UserType
OpenTalkingForm(Employee.LoginName, True);
//Employee.UserType
end;
if IconButtonType = itSMS then
begin
OpenSMSForm(Employee.LoginName, True);
end;
if IconButtonType = itEmail then
begin
ShellExecute(Handle, 'open', PChar('"mailto:' + Employee.Email +'"'), nil, nil, SW_SHOWNORMAL);
//AddWebBrowserToPageControl(Format('http://mail.lishui.gov.cn/web_email/module.phtml?module=mcomposef&to=%s', [RealICQUser.Email]), 999);
//AddWebBrowserToPageControl(Format('http://www.lxtalk.com/rd/', [RealICQUser.Email]), 999);
end;
if IconButtonType = itAddFriend then
begin
//MessageBox(Handle, '添加好友', '提示', MB_ICONINFORMATION);
if AnsiSameText(MainForm.RealICQClient.LoginName, Employee.LoginName) then
begin
MessageBox(Handle, '不能添加自己为好友', '提示', MB_ICONINFORMATION);
Exit;
end;
ShowAddFriendWindow(Self, Employee.LoginName, Employee.DisplayName);
end;
if IconButtonType = itTel then
begin
MessageBox(Handle, '电话', '提示', MB_ICONINFORMATION);
{ if not FPCAMessage.GetPCALoginStatus then Exit;
if (Employee.Mobile<>'') and (Employee.Tel<>'') then
begin
MenuItem:=ppSelCallTel.Items[0];
MenuItem.Hint:=Employee.Mobile+char(10)+Employee.DisplayName;
MenuItem:=ppSelCallTel.Items[1];
MenuItem.Hint:=Employee.Tel+char(10)+Employee.DisplayName;
ppSelCallTel.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y - 50);
Exit;
end;
if Employee.Mobile<>'' then CallNumber:=Employee.Mobile;
if Employee.Tel<>'' then CallNumber:=Employee.Tel;
FPCAMessage.SendCallTelOutPCAMessage(CallNumber,Employee.DisplayName);
}
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miGoSpaceClick(Sender: TObject);
var
LoginName: string;
RealICQUser: TRealICQUser;
begin
LoginName := GetSelectedLoginName;
if LoginName <> '' then
begin
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(LoginName);
RealICQUser.ClickedSNSIcon;
try
RealICQClientUserInformationReady(RealICQClient, RealICQUser);
finally
ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + SNSHomePage, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(RealICQUser.LoginName)])), '', SW_SHOWDEFAULT);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.NodeOnline(Employee: TRealICQEmployee);
var
ARealICQUser: TRealICQUser;
begin
//MessageBox(Handle, '4', '4', MB_OK);
if RealICQClient.Me = nil then
Exit;
if (DontShowHintOnBusy = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌') then
Exit;
//MessageBox(Handle, '5', '5', MB_OK);
if Employee.Data <> nil then
begin
ARealICQUser := TRealICQUser(Employee.Data);
if ARealICQUser = RealICQClient.Me then
Exit;
if PlaySoundOnOnline then
PlayEventSound(OnlineEventSound);
if ShowHintOnOnline then
ShowOnOffAlertForm(ARealICQUser);
end;
//MessageBox(Handle, '6', '6', MB_OK);
end;
//------------------------------------------------------------------------------
procedure TMainForm.NodeOffline(Employee: TRealICQEmployee);
var
ARealICQUser: TRealICQUser;
begin
if RealICQClient.Me = nil then
Exit;
if (DontShowHintOnBusy = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌') then
Exit;
if Employee.Data <> nil then
begin
ARealICQUser := TRealICQUser(Employee.Data);
if ARealICQUser = RealICQClient.Me then
Exit;
if PlaySoundOnOffline then
PlayEventSound(OfflineEventSound);
if ShowHintOnOffline then
ShowOnOffAlertForm(ARealICQUser);
end;
end;
procedure TMainForm.TimerForShowUserCardTimer(Sender: TObject);
begin
TimerForShowUserCard.Enabled := False;
TimerForHideUserCard.Enabled := False;
if not Assigned(UserCardForm) then
UserCardForm := TUserCardForm.Create(Self);
UserCardForm.TargetTop := FShowUserCardTargetTop;
UserCardForm.LoginName := FNeedShowUserCardLoginName;
// if not Assigned(UserCardViewForm) then
// UserCardViewForm := TUserCardViewForm.Create(Self);
// UserCardViewForm.TargetTop := FShowUserCardTargetTop;
// UserCardViewForm.Update(FNeedShowUserCardLoginName);
end;
//------------------------------------------------------------------------------
procedure TMainForm.TimerForHideUserCardTimer(Sender: TObject);
var
Rect: TRect;
begin
TimerForHideUserCard.Enabled := False;
if Assigned(UserCardForm) then
begin
Rect.Left := UserCardForm.Left;
Rect.Top := UserCardForm.Top;
Rect.Right := UserCardForm.Left + UserCardForm.Width;
Rect.Bottom := UserCardForm.Top + UserCardForm.Height;
if PtInRect(Rect, Mouse.CursorPos) then
begin
UserCardForm.TimerForClose.Enabled := True;
Exit;
end;
end;
if not TimerForShowUserCard.Enabled then
FreeAndNil(UserCardForm);
// TimerForHideUserCard.Enabled := False;
// if Assigned(UserCardViewForm) then
// begin
// Rect.Left := UserCardViewForm.Left;
// Rect.Top := UserCardViewForm.Top;
// Rect.Right := UserCardViewForm.Left + UserCardViewForm.Width;
// Rect.Bottom := UserCardViewForm.Top + UserCardViewForm.Height;
// if PtInRect(Rect, Mouse.CursorPos) then
// begin
// UserCardViewForm.tmrForClose.Enabled := True;
// Exit;
// end;
// end;
// if not TimerForShowUserCard.Enabled then
// FreeAndNil(UserCardViewForm);
end;
//------------------------------------------------------------------------------
procedure TMainForm.NodeOnHeadImageMouseEnter(Employee: TRealICQEmployee);
var
Rect: TRect;
P: TPoint;
begin
Rect := Employee.Node.DisplayRect(False);
P.X := Rect.Left;
P.Y := Rect.Top;
P := Employee.Node.TreeView.ClientToScreen(P);
if UserCardForm <> nil then
begin
FNeedShowUserCardLoginName := Employee.LoginName;
FShowUserCardTargetTop := P.Y;
TimerForShowUserCardTimer(nil);
end
else
begin
ShowUserCardForm(Employee.LoginName, P.Y);
end;
end;
procedure TMainForm.NodeOnHeadImageMouseLeave(Employee: TRealICQEmployee);
begin
HideUserCardForm;
end;
procedure TMainForm.ItemOnHeadImageEnter(Item: TRealICQContacterListItem);
var
Rect: TRect;
P: TPoint;
begin
Rect := Item.ListView.ListBox.ItemRect(Item.ItemIndex);
P.X := Rect.Left;
P.Y := Rect.Top;
P := Item.ListView.ListBox.ClientToScreen(P);
if UserCardForm <> nil then
begin
FNeedShowUserCardLoginName := Item.LoginName;
FShowUserCardTargetTop := P.Y;
TimerForShowUserCardTimer(nil);
end
else
begin
ShowUserCardForm(Item.LoginName, P.Y);
end;
end;
procedure TMainForm.ItemOnHeadImageLeave(Item: TRealICQContacterListItem);
begin
HideUserCardForm;
end;
procedure TMainForm.imgHeadImageBorderMouseEnter(Sender: TObject);
var
P: TPoint;
begin
P.X := 0;
P.Y := 0;
P := imgHeadImageBorder.ClientToScreen(P);
if UserCardForm <> nil then
begin
FNeedShowUserCardLoginName := RealICQClient.LoginName;
FShowUserCardTargetTop := P.Y;
TimerForShowUserCardTimer(nil);
end
else
begin
ShowUserCardForm(RealICQClient.LoginName, P.Y);
end;
end;
procedure TMainForm.imgHeadImageBorderMouseLeave(Sender: TObject);
begin
HideUserCardForm;
end;
procedure TMainForm.ShowUserCardForm(ALoginName: string; ATargetTop: Integer);
begin
FNeedShowUserCardLoginName := ALoginName;
FShowUserCardTargetTop := ATargetTop;
TimerForShowUserCard.Enabled := False;
TimerForShowUserCard.Enabled := True;
TimerForHideUserCard.Enabled := False;
end;
procedure TMainForm.HideUserCardForm;
begin
if TimerForHideUserCard <> nil then
begin
TimerForHideUserCard.Enabled := False;
TimerForHideUserCard.Enabled := True;
TimerForShowUserCard.Enabled := False;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.NodeOnMouseEnter(Employee: TRealICQEmployee);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.NodeOnMouseLeave(Employee: TRealICQEmployee);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.ItemOnMouseEnter(Item: TRealICQContacterListItem);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.ItemOnMouseLeave(Item: TRealICQContacterListItem);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.ItemIconButtonClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
begin
if IconButtonType = ltHeadImage then
begin
if UserCardForm = nil then
UserCardForm := TUserCardForm.Create(Self);
if UserCardForm.Width - 10 >= Left then
UserCardForm.Left := Left + pnlWorkArea.Width + 20
else
UserCardForm.Left := Left - UserCardForm.Width + 10;
UserCardForm.Top := Mouse.CursorPos.Y - 50;
UserCardForm.LoginName := Item.LoginName;
Application.ProcessMessages;
UserCardForm.Show;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ItemIconButtonDblClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
var
TalkingForm: TTalkingForm;
iWaitTimes: Integer;
RealICQUser: TRealICQUser;
// CallNumber:String;
// MenuItem:TMenuItem;
begin
if FSearchListViewInVisible then //设置查找输入框为初始状态
begin
edFilterKeyword.Text := '查找联系人...';
edFilterKeyword.Font.Color := clGray;
end;
if pnlSearchMoreUser.Visible then
begin
edtSearchMoreUser.Text := '查找联系人...';
edtSearchMoreUser.Font.Color := clGray;
end;
if IconButtonType = ltCamera then
begin
TalkingForm := GetTalkingForm(Item.LoginName);
if TalkingForm = nil then
begin
TalkingForm := OpenTalkingForm(Item.LoginName, True);
end;
iWaitTimes := 0;
while not TalkingForm.CanWriteMessage do
begin
Application.ProcessMessages;
Inc(iWaitTimes);
if iWaitTimes > 1000 then
break;
Sleep(10);
end;
TalkingForm.actVideo.Execute;
end;
if IconButtonType = ltHeadImage then
begin
if AnsiSameText(Item.LoginName, RealICQClient.Me.LoginName) then
begin
MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
Exit;
end;
OpenTalkingForm(Item.LoginName, True);
end;
if IconButtonType = ltSMS then
begin
OpenSMSForm(Item.LoginName, True);
end;
if IconButtonType = ltEmail then
begin
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(Item.LoginName);
if RealICQUser <> nil then
//AddWebBrowserToPageControl(Format('http://mail.lishui.gov.cn/web_email/module.phtml?module=mcomposef&to=%s', [RealICQUser.Email]), 999);
end;
if IconButtonType = ltAddFriend then
begin
if AnsiSameText(MainForm.RealICQClient.LoginName, Item.LoginName) then
begin
MessageBox(Handle, '不能添加自己为好友', '提示', MB_ICONINFORMATION);
Exit;
end;
ShowAddFriendWindow(Self, Item.LoginName, Item.DisplayName);
end;
if IconButtonType = ltTel then
begin
{ if not FPCAMessage.GetPCALoginStatus then Exit;
if (Item.Mobile<>'') and (Item.Tel<>'') then
begin
MenuItem:=ppSelCallTel.Items[0];
MenuItem.Hint:=Item.Mobile+char(10)+Item.DisplayName;
MenuItem:=ppSelCallTel.Items[1];
MenuItem.Hint:=Item.Tel+char(10)+Item.DisplayName;
ppSelCallTel.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y - 50);
Exit;
end;
if Item.Mobile<>'' then CallNumber:=Item.Mobile;
if Item.Tel<>'' then CallNumber:=Item.Tel;
FPCAMessage.SendCallTelOutPCAMessage(CallNumber,Item.DisplayName);
}
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ItemDoubleClick(Item: TRealICQContacterListItem);
var
ATeam: TRealICQTeam;
Branch: TRealICQBranch;
begin
if FSearchListViewInVisible then //设置查找输入框为初始状态
begin
edFilterKeyword.Text := '查找联系人...';
edFilterKeyword.Font.Color := clGray;
end;
if IsChild(Handle, Item.ListView.Handle) then
begin
if GetActiveTabSheetName = LVTeams then
begin
ATeam := TRealICQTeam(Item.Data);
OpenTeamTalkingForm(ATeam.TeamID);
Exit;
end;
end;
if (Item.StateIndex = 0) and (Item.Data <> nil) then //双击的是部门
begin
Branch := Item.Data;
Branch.Node.Selected := True;
end
else if (Item.Data <> nil) then
begin
if AnsiSameText(Item.LoginName, RealICQClient.Me.LoginName) then
begin
MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
Exit;
end;
OpenTalkingForm(Item.LoginName);
end;
if pnlSearchMoreUser.Visible then
begin
edtSearchMoreUser.Text := '查找联系人...';
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ItemOnline(Item: TRealICQContacterListItem);
var
iIndex: Integer;
ARealICQUser: TRealICQUser;
begin
//MessageBox(Handle, '1', '1', MB_OK);
if RealICQClient.Me = nil then
Exit;
if (DontShowHintOnBusy = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌') then
Exit;
iIndex := FContacterListViews.IndexOfObject(Item.ListView);
if FContacterListViews[iIndex] = LVLatests then
exit;
//MessageBox(Handle, '2', '2', MB_OK);
if Item.Data <> nil then
begin
ARealICQUser := TRealICQUser(Item.Data);
if (TFriendsService.GetService.IsFriend(ARealICQUser.LoginName)) and (TWorkmatesService.GetService.IsWorkmate(ARealICQUser.LoginName)) then
begin
if PlaySoundOnOnline then
PlayEventSound(OnlineEventSound);
if ShowHintOnOnline then
ShowOnOffAlertForm(ARealICQUser);
end;
end;
//MessageBox(Handle, '3', '3', MB_OK);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ItemOffline(Item: TRealICQContacterListItem);
var
iIndex: Integer;
ARealICQUser: TRealICQUser;
begin
if RealICQClient.Me = nil then
Exit;
if (DontShowHintOnBusy = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌') then
Exit;
iIndex := FContacterListViews.IndexOfObject(Item.ListView);
if FContacterListViews[iIndex] = LVLatests then
exit;
if Item.Data <> nil then
begin
ARealICQUser := TRealICQUser(Item.Data);
if (TFriendsService.GetService.IsFriend(ARealICQUser.LoginName)) and (TWorkmatesService.GetService.IsWorkmate(ARealICQUser.LoginName)) then
begin
if PlaySoundOnOffline then
PlayEventSound(OfflineEventSound);
if ShowHintOnOffline then
ShowOnOffAlertForm(ARealICQUser);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.lblLogsClick(Sender: TObject);
var
ANoticesRecord: TSystemNotices;
begin
ANoticesRecord := FSystemNotices[FSystemNoticeIndex];
ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + LoginURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(ReadMessageURL + ANoticesRecord.URL)])), '', SW_SHOWDEFAULT);
end;
procedure TMainForm.lblLogsMouseEnter(Sender: TObject);
begin
lblLogs.Font.Style := [fsUnderline];
TimerForShowSystemNotices.Enabled := False;
end;
procedure TMainForm.lblLogsMouseLeave(Sender: TObject);
begin
lblLogs.Font.Style := [];
TimerForShowSystemNotices.Enabled := FSystemNotices.Count > 0;
end;
procedure TMainForm.lblReConnectClick(Sender: TObject);
begin
RealICQClient.ReConnectAndLogin;
end;
//------------------------------------------------------------------------------
procedure TMainForm.lblRegisterMouseEnter(Sender: TObject);
begin
(Sender as TLabel).Font.Style := [fsUnderline];
end;
//------------------------------------------------------------------------------
procedure TMainForm.lblRegisterMouseLeave(Sender: TObject);
begin
(Sender as TLabel).Font.Style := [];
end;
//------------------------------------------------------------------------------
procedure TMainForm.ChangeUIColor(AColor: TColor);
var
iLoop: Integer;
IUIColor: IRealICQUIColor;
begin
inherited ChangeUIColor(AColor);
//spb360SD.ChangeUIColor(AColor);
//spb360Safe.ChangeUIColor(AColor);
spbNetworkBackup.ChangeUIColor(AColor);
spbRefreshBranchUsers.ChangeUIColor(AColor);
btShowMiniPage.ChangeUIColor(AColor);
spbDisplayName.ChangeUIColor(AColor);
spbWatchword.ChangeUIColor(AColor);
shpWatchwordBorder.Pen.Color := ConvertColorToColor(shpWatchwordBorder.Pen.Color, AColor);
spbSelUIColor.ChangeUIColor(AColor);
spbHistroyMessage.ChangeUIColor(AColor);
spbAddFriend.ChangeUIColor(AColor);
spblock.ChangeUIColor(AColor);
btMainMenu.ChangeUIColor(AColor);
//btOA.ChangeUIColor(AColor);
//btSwap.ChangeUIColor(AColor);
spbShowNotReadMessage.ChangeUIColor(AColor);
spbWinMeet.ChangeUIColor(AColor);
spbAddFriend.Font.Color := ConvertColorToColor(spbAddFriend.Font.Color, AColor);
spbHistroyMessage.Font.Color := ConvertColorToColor(spbHistroyMessage.Font.Color, AColor);
spblock.Font.Color := ConvertColorToColor(spblock.Font.Color, AColor);
ConvertBitmapToColor(MyContacters.Picture.Bitmap, AColor);
ConvertBitmapToColor(SysMsg.Picture.Bitmap, AColor);
ConvertBitmapToColor(MyFriend.Picture.Bitmap, AColor);
ConvertBitmapToColor(MyTeam.Picture.Bitmap, AColor);
ConvertBitmapToColor(Latests.Picture.Bitmap, AColor);
ConvertBitmapToColor(MyContactersIcon.Picture.Bitmap, AColor);
ConvertBitmapToColor(SysMsgIcon.Picture.Bitmap, AColor);
ConvertBitmapToColor(MyFriendIcon.Picture.Bitmap, AColor);
ConvertBitmapToColor(MyTeamIcon.Picture.Bitmap, AColor);
ConvertBitmapToColor(LatestsIcon.Picture.Bitmap, AColor);
ConvertBitmapToColor(RealICQHoverImage1.Picture.Bitmap, AColor);
{通讯录}
ConvertBitmapToColor(imgAddrBookToolbarBack.Picture.Bitmap, AColor);
imgAddrBookToolbarBack.Invalidate;
spbAddGroupUser.ChangeUIColor(AColor);
spbAddGroup.ChangeUIColor(AColor);
spbImportGroupUser.ChangeUIColor(AColor);
{通讯录}
ShpHint.Pen.Color := ConvertColorToColor(ShpHint.Pen.Color, AColor);
btPrevLog.ChangeUIColor(AColor);
btNextLog.ChangeUIColor(AColor);
ConvertBitmapToColor(ImageForCustomerTop.Picture.Bitmap, AColor);
ImageForCustomerTop.Invalidate;
btCustomerLogin.ChangeUIColor(AColor);
btCustomerLogout.ChangeUIColor(AColor);
btCustomerDisplayName.ChangeUIColor(AColor);
ShpLeft.Pen.Color := ConvertColorToColor(ShpLeft.Pen.Color, AColor);
ShpBottom.Pen.Color := ConvertColorToColor(ShpBottom.Pen.Color, AColor);
ShpRight.Pen.Color := ConvertColorToColor(ShpRight.Pen.Color, AColor);
ShpSearchLeft.Pen.Color := ConvertColorToColor(ShpSearchLeft.Pen.Color, AColor);
ShpSearchBottom.Pen.Color := ConvertColorToColor(ShpSearchBottom.Pen.Color, AColor);
ShpSearchRight.Pen.Color := ConvertColorToColor(ShpSearchRight.Pen.Color, AColor);
spbEmail.ChangeUIColor(AColor);
sbpSMS.ChangeUIColor(AColor);
spbPersonManage.ChangeUIColor(AColor);
spbTelMeeting.ChangeUIColor(AColor);
pnlToolBar.Color := FormColor;
PnlTop.Color := FormColor;
pnlWorkArea.Color := FormColor;
pnlLogout.Color := FormColor;
pgcMainWorkArea.BackColor := FormColor;
pnlLocked.Color := FormColor;
btn_lock_DisplayName.ChangeUIColor(AColor);
btn_unlock.ChangeUIColor(AColor);
ConvertBitmapToColor(img_lockback_top.Picture.Bitmap, AColor);
//ConvertBitmapToColor(shp_lock_client.Picture.Bitmap, AColor);
//txt_locked.color:= FormColor;
pnlClient.Color := FormColor;
pnlNDToolBar.Color := FormColor;
pnlNDStateBar.Color := FormColor;
pnlMiddleClient.Color := FormColor;
pnlAddrBkStateBar.Color := FormColor;
pnlCustomerServiceStatus.Color := FormColor;
ConvertBitmapToColor(imgWebToolBack.Picture.Bitmap, AColor);
imgWebToolBack.Invalidate;
spbPrev.ChangeUIColor(AColor);
spbNext.ChangeUIColor(AColor);
spbStop.ChangeUIColor(AColor);
spbRefresh.ChangeUIColor(AColor);
spbAddToNA.ChangeUIColor(AColor);
spbGo.ChangeUIColor(AColor);
spbWebClose.ChangeUIColor(AColor);
sbpNewWebTab.ChangeUIColor(AColor);
TabSetMuiltWeb.BackgroundColor := ConvertColorToColor(TabSetMuiltWeb.BackgroundColor, AColor);
TabSetMuiltWeb.SelectedColor := ConvertColorToColor(TabSetMuiltWeb.SelectedColor, AColor);
shpWebStatus.Pen.Color := ConvertColorToColor(shpWebStatus.Pen.Color, AColor);
shpWebLeftBorder.Pen.Color := ConvertColorToColor(shpWebLeftBorder.Pen.Color, AColor);
ConvertBitmapToColor(imgNDToolbarBack.Picture.Bitmap, AColor);
imgNDToolbarBack.Invalidate;
ConvertBitmapToColor(imgLogoutBKTop.Picture.Bitmap, AColor);
imgLogoutBKTop.Invalidate;
ConvertBitmapToColor(imgLogoutBK.Picture.Bitmap, AColor);
imgLogoutBK.Invalidate;
spLoginNameBorder.Pen.Color := ConvertColorToColor(spLoginNameBorder.Pen.Color, AColor);
spbChangeLoginName.ChangeUIColor(AColor);
spPasswordBorder.Pen.Color := ConvertColorToColor(spPasswordBorder.Pen.Color, AColor);
pnlSelectServer.Color := FormColor;
spServerListBorder.Pen.Color := ConvertColorToColor(spServerListBorder.Pen.Color, AColor);
spbSelectServer.ChangeUIColor(AColor);
shpSearchMoreUser.Pen.Color := ConvertColorToColor(shpSearchMoreUser.Pen.Color, AColor);
spbCancelFilter.ChangeUIColor(AColor);
shpFilterBorder.Pen.Color := ConvertColorToColor(shpFilterBorder.Pen.Color, AColor);
spbLoginState.ChangeUIColor(AColor);
spbSavePassword.ChangeUIColor(AColor);
spbAutoLogin.ChangeUIColor(AColor);
btLogin.ChangeUIColor(AColor);
spbNDMoveUp.ChangeUIColor(AColor);
spbNDNewDir.ChangeUIColor(AColor);
spbNDDelete.ChangeUIColor(AColor);
shpNDDirBorder.Pen.Color := ConvertColorToColor(shpNDDirBorder.Pen.Color, AColor);
spbNDUpload.ChangeUIColor(AColor);
spbNDDownload.ChangeUIColor(AColor);
spbNDConnect.ChangeUIColor(AColor);
spbNDDisconnect.ChangeUIColor(AColor);
spbNDRefresh.ChangeUIColor(AColor);
spbNDCancelAll.ChangeUIColor(AColor);
TabSetNDMissions.SelectedColor := clWhite;
TabSetNDMissions.BackgroundColor := clWhite;
pnlNDMissions.Color := clWhite;
ConvertBitmapToColor(imgHeadImageBorder.Picture.Bitmap, AColor);
imgHeadImageBorder.Invalidate;
ConvertBitmapToColor(imgBottomMenu.Picture.Bitmap, AColor);
imgBottomMenu.Invalidate;
ConvertBitmapToColor(imgTitleBackMiddle.Picture.Bitmap, AColor);
imgTitleBackMiddle.Invalidate;
IUIColor := pgcMainWorkArea;
IUIColor.ChangeUIColor(AColor);
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
IUIColor := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
IUIColor.ChangeUIColor(AColor);
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
IUIColor := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
IUIColor.ChangeUIColor(AColor);
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
IUIColor := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
IUIColor.ChangeUIColor(AColor);
end;
if Assigned(FTVCustomerLatests) then
FTVCustomerLatests.ChangeUIColor(AColor);
// if Assigned(FLVCustomers) then FLVCustomers.ChangeUIColor(AColor);
if Assigned(FLVSystemMessage) then
FLVSystemMessage.ChangeUIColor(AColor);
if Assigned(FLVTeams) then
FLVTeams.ChangeUIColor(AColor);
if tsNetWorkDisk.Parent <> nil then
begin
FLVNetWorkDisk.ChangeUIColor(AColor);
FLVNetWorkDiskUploadingFiles.ChangeUIColor(AColor);
FLVNetWorkDiskDownloadingFiles.ChangeUIColor(AColor);
end;
btLogin.ChangeUIColor(AColor);
btLogin.Invalidate;
spbContacterViewStyle.ChangeUIColor(AColor);
spbCreateTeam.ChangeUIColor(AColor);
spbFindTeam.ChangeUIColor(AColor);
pnlTeams.Color := ConvertColorToColor(pnlTeams.Color, AColor);
if CreateTeamForm <> nil then
CreateTeamForm.ChangeUIColor(AColor);
if SearchForm <> nil then
SearchForm.ChangeUIColor(AColor);
if SearchTeamForm <> nil then
SearchTeamForm.ChangeUIColor(AColor);
if SelFaceForm <> nil then
SelFaceForm.ChangeUIColor(AColor);
if CustomFacesManagerForm <> nil then
CustomFacesManagerForm.ChangeUIColor(AColor);
if NotReadMessageBoxForm <> nil then
NotReadMessageBoxForm.ChangeUIColor(AColor);
if VCardForm <> nil then
VCardForm.ChangeUIColor(UIMainColor);
ChangeAddFriendFormColor(AColor);
ChangeAddFriendRequestFormColor(AColor);
ChangeSeeUserInformationFormColor(AColor);
ChangeTalkingFormColor(AColor);
ChangeSMSFormColor(AColor);
ChangeTeamOptionsFormColor(AColor);
ChangeSystemMessageFormsColor(AColor);
TMainFormController.GetController.ChangeUIColor(AColor);
end;
//------------------------------------------------------------------------------
function TMainForm.GetListViewByLoginName(ALoginName: string; AOnlyInGroups: Boolean = False): TRealICQContacterListView;
var
GroupName: string;
iLoop, jLoop, iIndex, ContacterIndex: Integer;
GroupMembers: TStringList;
ListView: TRealICQContacterListView;
begin
Result := nil;
if not AOnlyInGroups then
begin
if (TFriendsService.GetService.IsFriend(ALoginName)) and (TWorkmatesService.GetService.IsWorkmate(ALoginName)) then
begin
ContacterIndex := FContacterListViews.IndexOf(LVFriends);
ListView := FContacterListViews.Objects[ContacterIndex] as TRealICQContacterListView;
Result := ListView;
end
else if RealICQClient.Blacklists.IndexOf(ALoginName) >= 0 then
begin
ContacterIndex := FContacterListViews.IndexOf(LVBlacklists);
ListView := FContacterListViews.Objects[ContacterIndex] as TRealICQContacterListView;
if ListView.Items.IndexOf(ALoginName) = -1 then
ListView.Items.Add(ALoginName);
Result := ListView;
exit;
end
else if RealICQClient.Strangers.IndexOf(ALoginName) >= 0 then
begin
ContacterIndex := FContacterListViews.IndexOf(LVStrangers);
ListView := FContacterListViews.Objects[ContacterIndex] as TRealICQContacterListView;
if ListView.Items.IndexOf(ALoginName) = -1 then
ListView.Items.Add(ALoginName);
Result := ListView;
exit;
end;
end;
if FShowGroup then
begin
for iLoop := 0 to FGroups.Count - 1 do
begin
GroupName := FGroups[iLoop];
GroupMembers := FGroups.Objects[iLoop] as TStringList;
for jLoop := 0 to GroupMembers.Count - 1 do
begin
if AnsiSameText(GroupMembers[jLoop], ALoginName) then
begin
iIndex := FContacterListViews.IndexOf(GroupName);
if iIndex >= 0 then
begin
ListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
if ListView.Items.IndexOf(ALoginName) = -1 then
ListView.Items.Add(ALoginName);
Result := ListView;
end;
exit;
end;
end;
end;
end;
if Result <> nil then
if Result.Items.IndexOf(ALoginName) = -1 then
Result.Items.Add(ALoginName);
end;
//-------------------显示好友列表---------------
procedure TMainForm.ShowFriendLists;
var
iLoop, itemIndex: Integer;
RealICQUser: TRealICQUser;
RealICQFriendTreeView: TRealICQContacterTreeView;
Friend: TRealICQEmployee;
begin
itemIndex := FContacterTreeViews.IndexOf(LvFriends);
RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
for iLoop := FNotAddedEmployeeList.Count - 1 downto 0 do
begin
RealICQUser := FNotAddedEmployeeList.Objects[iLoop] as TRealICQUser;
if AnsiSameText(RealICQUser.LoginName, RealICQClient.LoginName) then
Continue;
if (RealICQFriendTreeView.EmployeeItems.IndexOf(RealICQUser.LoginName)) >= 0 then
Continue;
Friend := TRealICQEmployee.Create(RealICQUser.LoginName);
Friend.BranchID := LVFriends;
RealICQFriendTreeView.AddEmployee(Friend);
//UpdateFriendNode(Friend, RealICQUser, False);
TUsersService.GetUsersService.UpdateTreeNode(RealICQFriendTreeView, Friend, RealICQUser);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ShowGroupInterface;
var
GroupName, LoginName: string;
iLoop, jLoop, itemIndex: Integer;
RealICQUser: TRealICQUser;
RealICQFriendTreeView: TRealICQContacterTreeView;
Friend: TRealICQEmployee;
FriendGroup: TRealICQBranch;
GroupMembers: TStringList;
begin
ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
if ItemIndex >= 0 then
begin
RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
try
RealICQFriendTreeView.Clear;
FreeAndNil(RealICQFriendTreeView);
FContacterTreeViews.Delete(ItemIndex);
except
end;
end;
ItemIndex := AddFriendTreeView(scrollBoxMyFriend, LVFriends);
RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQFriendTreeView.AdjustPosition := False;
RealICQFriendTreeView.HideSystemScrollBar;
RealICQFriendTreeView.BeginUpdate;
SetFlashCaptionOnOnlineValue(False);
Screen.Cursor := crHourGlass;
try
//显示好友
ShowFriendLists;
//显示黑名单
//ShowBlacklists;
{$region '添加自定义分组'}
if FShowGroup then
begin
for iLoop := 0 to FGroups.Count - 1 do
begin
GroupName := FGroups[iLoop];
GroupMembers := FGroups.Objects[iLoop] as TStringList;
FriendGroup := TRealICQBranch.Create(GroupName);
FriendGroup.BranchID := GroupName;
FriendGroup.ParentID := '';
FriendGroup.BranchName := GroupName;
RealICQFriendTreeView.AddBranch(FriendGroup);
RealICQFriendTreeView.MoveBranch(GroupName, LvFriends);
for jLoop := 0 to GroupMembers.Count - 1 do
begin
LoginName := GroupMembers[jLoop];
if (not TFriendsService.GetService.IsFriend(LoginName)) and (not TWorkmatesService.GetService.IsWorkmate(LoginName)) then
continue;
if AnsiSameText(LoginName, RealICQClient.LoginName) then
continue;
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(LoginName);
ItemIndex := RealICQFriendTreeView.EmployeeItems.IndexOf(LoginName);
if ItemIndex >= 0 then
RealICQFriendTreeView.EmployeeItems.Delete(ItemIndex);
Friend := TRealICQEmployee.Create(LoginName);
Friend.BranchID := FriendGroup.BranchName;
RealICQFriendTreeView.AddEmployee(Friend);
//UpdateFriendNode(Friend, RealICQUser, False);
TUsersService.GetUsersService.UpdateTreeNode(RealICQFriendTreeView, Friend, RealICQUser);
end;
end;
end;
{$endregion}
//展开好友列表
ItemIndex := RealICQFriendTreeView.BranchItems.IndexOf(LvFriends);
FriendGroup := RealICQFriendTreeView.BranchItems.Objects[itemIndex] as TRealICQBranch;
FriendGroup.Node.Expanded := True;
finally
//RealICQFriendTreeView.MoveFriendGroup(LvBlackLists,LvFriends);
PostMessage(RealICQFriendTreeView.Handle, WM_SIZE, 0, 0);
RealICQFriendTreeView.EndUpdate;
Screen.Cursor := crDefault;
SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
end;
end;
//------------------------------------------------------------------------------
function TMainForm.AddFriendTreeView(AOwner: TWinControl; GroupName: string): Integer;
var
RealICQFriendTreeView: TRealICQContacterTreeView;
Group: TRealICQBranch;
begin
//log(AOwner.Name,'TMainForm.AddFriendTreeView');
RealICQFriendTreeView := TRealICQContacterTreeView.Create(AOwner);
RealICQFriendTreeView.Parent := AOwner;
RealICQFriendTreeView.Align := alClient;
RealICQFriendTreeView.Caption := '';
RealICQFriendTreeView.Color := clWhite;
RealICQFriendTreeView.ShowHint := True;
RealICQFriendTreeView.ParentFont := True;
RealICQFriendTreeView.ShowLine := False;
RealICQFriendTreeView.ShowBranchImage := False;
RealICQFriendTreeView.MustDrawButton := True;
RealICQFriendTreeView.ScrollTopButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonPicture);
RealICQFriendTreeView.ScrollTopButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonHoverPicture);
RealICQFriendTreeView.ScrollTopButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonDownPicture);
RealICQFriendTreeView.ScrollBottomButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonPicture);
RealICQFriendTreeView.ScrollBottomButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonHoverPicture);
RealICQFriendTreeView.ScrollBottomButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonDownPicture);
RealICQFriendTreeView.ScrollBarButtonTopPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopPicture);
RealICQFriendTreeView.ScrollBarButtonTopPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopHoverPicture);
RealICQFriendTreeView.ScrollBarButtonTopPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopDownPicture);
RealICQFriendTreeView.ScrollBarButtonMiddlePictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddlePicture);
RealICQFriendTreeView.ScrollBarButtonMiddlePictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleHoverPicture);
RealICQFriendTreeView.ScrollBarButtonMiddlePictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleDownPicture);
RealICQFriendTreeView.ScrollBarButtonBottomPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomPicture);
RealICQFriendTreeView.ScrollBarButtonBottomPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomHoverPicture);
RealICQFriendTreeView.ScrollBarButtonBottomPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomDownPicture);
RealICQFriendTreeView.ScrollBackgroundPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
RealICQFriendTreeView.ScrollBackgroundPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
RealICQFriendTreeView.ScrollBackgroundPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
RealICQFriendTreeView.ScrollBarButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarButtonPicture);
RealICQFriendTreeView.SelectedItemBorderColor := FLVSelectedItemBorderColor;
RealICQFriendTreeView.SelectedItemBorderInnerColor := FLVSelectedItemBorderInnerColor;
RealICQFriendTreeView.SelectedItemBackColor := FLVSelectedItemBackColor;
RealICQFriendTreeView.HeadImageBorderColor := FLVHeadImageBorderColor;
RealICQFriendTreeView.HeadImageBackColor := FLVHeadImageBackColor;
RealICQFriendTreeView.SelectedItemBackgroud.LoadFromFile(ExtractFilePath(Application.ExeName) + SelectedItemBackgroud);
RealICQFriendTreeView.DefaultPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
RealICQFriendTreeView.DefaultPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBig44);
RealICQFriendTreeView.BranchClosedButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + GroupClosedButtonPicture);
RealICQFriendTreeView.BranchOpenedButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + GroupOpenedButtonPicture);
RealICQFriendTreeView.LeavePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\away.ico');
RealICQFriendTreeView.BusyPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\busy.ico');
RealICQFriendTreeView.MutePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\mute.ico');
RealICQFriendTreeView.LeavePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\away.ico');
RealICQFriendTreeView.BusyPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\busy.ico');
RealICQFriendTreeView.MutePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\mute.ico');
RealICQFriendTreeView.CameraIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + CameraIcon);
RealICQFriendTreeView.TelephoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + TelephoneIcon);
RealICQFriendTreeView.MobilePhoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + MobilePhoneIcon);
RealICQFriendTreeView.EmailIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + EmailIcon);
RealICQFriendTreeView.SMSIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + SMSIcon);
RealICQFriendTreeView.ShowCameraButton := True;
RealICQFriendTreeView.ShowMobileButton := False;
RealICQFriendTreeView.ShowTelButton := True;
RealICQFriendTreeView.ShowHeadImageButton := True;
RealICQFriendTreeView.ShowEmailButton := True;
RealICQFriendTreeView.ShowSMSButton := True;
RealICQFriendTreeView.ShowAddFriendButton := False;
RealICQFriendTreeView.Style := FLVStyle;
RealICQFriendTreeView.CaptionStyle := FLVCaptionStyle;
RealICQFriendTreeView.ChangeUIColor(FUIMainColor);
RealICQFriendTreeView.PopupMenu := ppUserItemRightMenu;
RealICQFriendTreeView.OnItemOnline := NodeOnline;
RealICQFriendTreeView.OnItemOffline := NodeOffline;
RealICQFriendTreeView.OnItemDoubleClick := NodeDoubleClick;
RealICQFriendTreeView.OnItemIconButtonClick := NodeIconButtonClick;
RealICQFriendTreeView.OnItemIconButtonDblClick := NodeIconButtonDblClick;
RealICQFriendTreeView.OnItemMouseEnter := NodeOnMouseEnter;
RealICQFriendTreeView.OnItemMouseLeave := NodeOnMouseLeave;
Result := FContacterTreeViews.AddObject(GroupName, RealICQFriendTreeView);
RealICQFriendTreeView.AdjustPosition := False;
RealICQFriendTreeView.HideSystemScrollBar;
RealICQFriendTreeView.BeginUpdate;
try
Group := TRealICQBranch.Create(LVFriends);
Group.BranchID := LvFriends;
Group.ParentID := '0';
Group.BranchName := LvFriends;
RealICQFriendTreeView.AddBranch(Group);
finally
RealICQFriendTreeView.EndUpdate;
end;
end;
function TMainForm.AddContacterTreeView(AOwner: TWinControl; GroupName: string): Integer;
var
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
//log(AOwner.Name,'TMainForm.AddContacterTreeView');
RealICQContacterTreeView := TRealICQContacterTreeView.Create(AOwner);
RealICQContacterTreeView.Parent := AOwner;
RealICQContacterTreeView.Align := alClient;
RealICQContacterTreeView.Caption := '';
RealICQContacterTreeView.Color := clWhite;
RealICQContacterTreeView.ShowHint := True;
RealICQContacterTreeView.ParentFont := True;
RealICQContacterTreeView.AutoCalculate := True;
RealICQContacterTreeView.AutoChangeOnlineNumeric := True;
RealICQContacterTreeView.ShowOnlineNumber := True;
RealICQContacterTreeView.ScrollTopButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonPicture);
RealICQContacterTreeView.ScrollTopButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonHoverPicture);
RealICQContacterTreeView.ScrollTopButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonDownPicture);
RealICQContacterTreeView.ScrollBottomButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonPicture);
RealICQContacterTreeView.ScrollBottomButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonHoverPicture);
RealICQContacterTreeView.ScrollBottomButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonDownPicture);
RealICQContacterTreeView.ScrollBarButtonTopPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopPicture);
RealICQContacterTreeView.ScrollBarButtonTopPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopHoverPicture);
RealICQContacterTreeView.ScrollBarButtonTopPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopDownPicture);
RealICQContacterTreeView.ScrollBarButtonMiddlePictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddlePicture);
RealICQContacterTreeView.ScrollBarButtonMiddlePictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleHoverPicture);
RealICQContacterTreeView.ScrollBarButtonMiddlePictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleDownPicture);
RealICQContacterTreeView.ScrollBarButtonBottomPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomPicture);
RealICQContacterTreeView.ScrollBarButtonBottomPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomHoverPicture);
RealICQContacterTreeView.ScrollBarButtonBottomPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomDownPicture);
RealICQContacterTreeView.ScrollBackgroundPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
RealICQContacterTreeView.ScrollBackgroundPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
RealICQContacterTreeView.ScrollBackgroundPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
RealICQContacterTreeView.ScrollBarButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarButtonPicture);
RealICQContacterTreeView.SelectedItemBorderColor := FLVSelectedItemBorderColor;
RealICQContacterTreeView.SelectedItemBorderInnerColor := FLVSelectedItemBorderInnerColor;
RealICQContacterTreeView.SelectedItemBackColor := FLVSelectedItemBackColor;
RealICQContacterTreeView.HeadImageBorderColor := FLVHeadImageBorderColor;
RealICQContacterTreeView.HeadImageBackColor := FLVHeadImageBackColor;
RealICQContacterTreeView.SelectedItemBackgroud.LoadFromFile(ExtractFilePath(Application.ExeName) + SelectedItemBackgroud);
RealICQContacterTreeView.DefaultPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
RealICQContacterTreeView.DefaultPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBig44);
RealICQContacterTreeView.BranchExpandedPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchExpandedPicture);
RealICQContacterTreeView.BranchCollapsedPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchCollapsedPicture);
RealICQContacterTreeView.BranchClosedButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchClosedButtonPicture);
RealICQContacterTreeView.BranchOpenedButtonPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchOpenedButtonPicture);
RealICQContacterTreeView.LeavePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\away.ico');
RealICQContacterTreeView.BusyPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\busy.ico');
RealICQContacterTreeView.MutePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\mute.ico');
RealICQContacterTreeView.LeavePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\away.ico');
RealICQContacterTreeView.BusyPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\busy.ico');
RealICQContacterTreeView.MutePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\mute.ico');
RealICQContacterTreeView.CameraIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + CameraIcon);
RealICQContacterTreeView.TelephoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + TelephoneIcon);
RealICQContacterTreeView.MobilePhoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + MobilePhoneIcon);
RealICQContacterTreeView.EmailIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + EmailIcon);
RealICQContacterTreeView.SMSIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + SMSIcon);
RealICQContacterTreeView.AddFriendIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + AddFriendIcon);
RealICQContacterTreeView.NewSNSUpdateIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + SNSIcon);
RealICQContacterTreeView.CheckFalsePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\CheckFalse.bmp');
RealICQContacterTreeView.CheckTruePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\CheckTrue.bmp');
RealICQContacterTreeView.ShowMobileButton := False;
RealICQContacterTreeView.ShowTelButton := True;
RealICQContacterTreeView.ShowCameraButton := True;
RealICQContacterTreeView.ShowHeadImageButton := True;
RealICQContacterTreeView.ShowEmailButton := True;
RealICQContacterTreeView.ShowSMSButton := True;
RealICQContacterTreeView.ShowNewSNSButton := False;
RealICQContacterTreeView.ShowAddFriendButton := True;
// if RealICQClient.EnableSecretLevel AND (FProductType <> ptBGZS) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
// RealICQContacterTreeView.ShowAddFriendButton := True
// else
// RealICQContacterTreeView.ShowAddFriendButton := False;
RealICQContacterTreeView.Style := FLVStyle;
RealICQContacterTreeView.CaptionStyle := FLVCaptionStyle;
RealICQContacterTreeView.ChangeUIColor(FUIMainColor);
RealICQContacterTreeView.PopupMenu := ppUserItemRightMenu;
if GroupName = LVMoreUsers then
begin
RealICQContacterTreeView.OnBranchClick := NodeBranchClick;
end;
if GroupName = LVAddrbook then
begin
RealICQContacterTreeView.OnBranchClick := NodeGroupClick;
end;
RealICQContacterTreeView.OnItemOnline := NodeOnline;
RealICQContacterTreeView.OnItemOffline := NodeOffline;
RealICQContacterTreeView.OnItemDoubleClick := NodeDoubleClick;
RealICQContacterTreeView.OnItemIconButtonClick := NodeIconButtonClick;
RealICQContacterTreeView.OnItemIconButtonDblClick := NodeIconButtonDblClick;
RealICQContacterTreeView.OnItemMouseEnter := NodeOnMouseEnter;
RealICQContacterTreeView.OnItemMouseLeave := NodeOnMouseLeave;
Result := FContacterTreeViews.AddObject(GroupName, RealICQContacterTreeView);
end;
procedure TMainForm.UpdateContacterListView(RealICQContacterListView: TRealICQContacterListView);
begin
RealICQContacterListView.Align := alClient;
RealICQContacterListView.Caption := '';
RealICQContacterListView.ShowHint := True;
RealICQContacterListView.Color := clWhite;
RealICQContacterListView.ParentFont := True;
RealICQContacterListView.ScrollTopButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonPicture);
RealICQContacterListView.ScrollTopButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonHoverPicture);
RealICQContacterListView.ScrollTopButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTopButtonDownPicture);
RealICQContacterListView.ScrollBottomButtonPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonPicture);
RealICQContacterListView.ScrollBottomButtonPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonHoverPicture);
RealICQContacterListView.ScrollBottomButtonPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarBottomButtonDownPicture);
RealICQContacterListView.ScrollBarButtonTopPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopPicture);
RealICQContacterListView.ScrollBarButtonTopPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopHoverPicture);
RealICQContacterListView.ScrollBarButtonTopPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonTopDownPicture);
RealICQContacterListView.ScrollBarButtonMiddlePictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddlePicture);
RealICQContacterListView.ScrollBarButtonMiddlePictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleHoverPicture);
RealICQContacterListView.ScrollBarButtonMiddlePictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonMiddleDownPicture);
RealICQContacterListView.ScrollBarButtonBottomPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomPicture);
RealICQContacterListView.ScrollBarButtonBottomPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomHoverPicture);
RealICQContacterListView.ScrollBarButtonBottomPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBarTrackButtonBottomDownPicture);
RealICQContacterListView.ScrollBackgroundPictureNormal.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
RealICQContacterListView.ScrollBackgroundPictureHover.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
RealICQContacterListView.ScrollBackgroundPictureDown.LoadFromFile(ExtractFilePath(Application.ExeName) + ScrollBackgroundPicture);
RealICQContacterListView.SelectedItemBorderColor := FLVSelectedItemBorderColor;
RealICQContacterListView.SelectedItemBorderInnerColor := FLVSelectedItemBorderInnerColor;
RealICQContacterListView.SelectedItemBackColor := FLVSelectedItemBackColor;
RealICQContacterListView.HeadImageBorderColor := FLVHeadImageBorderColor;
RealICQContacterListView.HeadImageBackColor := FLVHeadImageBackColor;
RealICQContacterListView.SelectedItemBackgroud.LoadFromFile(ExtractFilePath(Application.ExeName) + SelectedItemBackgroud);
RealICQContacterListView.DefaultPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBig);
RealICQContacterListView.DefaultPictureMiddle.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureMiddle);
RealICQContacterListView.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmall);
//RealICQContacterListView.DefaultPictureBigOffline.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBigOffline);
//RealICQContacterListView.DefaultPictureMiddleOffline.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureMiddleOffline);
//RealICQContacterListView.DefaultPictureSmallOffline.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureSmallOffline);
RealICQContacterListView.LeavePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\away.ico');
RealICQContacterListView.BusyPicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\busy.ico');
RealICQContacterListView.MutePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\small\mute.ico');
RealICQContacterListView.LeavePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\away.ico');
RealICQContacterListView.BusyPictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\busy.ico');
RealICQContacterListView.MutePictureBig.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\mute.ico');
RealICQContacterListView.CameraIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + CameraIcon);
RealICQContacterListView.TelephoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + TelephoneIcon);
RealICQContacterListView.MobilePhoneIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + MobilePhoneIcon);
RealICQContacterListView.EmailIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + EmailIcon);
RealICQContacterListView.SMSIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + SMSIcon);
RealICQContacterListView.AddFriendIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + AddFriendIcon);
RealICQContacterListView.ShowHeadImageButton := False;
RealICQContacterListView.ShowAddFriendButton := False;
RealICQContacterListView.ShowMobileButton := True;
RealICQContacterListView.ShowTelButton := True;
RealICQContacterListView.ShowCameraButton := True;
RealICQContacterListView.ShowEmailButton := True;
RealICQContacterListView.ShowSMSButton := True;
RealICQContacterListView.Style := FLVStyle;
RealICQContacterListView.CaptionStyle := FLVCaptionStyle;
RealICQContacterListView.ChangeUIColor(FUIMainColor);
RealICQContacterListView.PopupMenu := ppUserItemRightMenu;
RealICQContacterListView.OnItemDoubleClick := ItemDoubleClick;
RealICQContacterListView.OnItemIconButtonClick := ItemIconButtonClick;
RealICQContacterListView.OnItemIconButtonDblClick := ItemIconButtonDblClick;
RealICQContacterListView.OnItemMouseEnter := nil; // ItemOnMouseEnter;
RealICQContacterListView.OnItemMouseLeave := nil; // ItemOnMouseLeave;
end;
//------------------------------------------------------------------------------
function TMainForm.AddContacterListView(AOwner: TWinControl; GroupName: string): Integer;
var
RealICQContacterListView: TRealICQContacterListView;
begin
//log(AOwner.Name,'TMainForm.AddContacterListView');
RealICQContacterListView := TRealICQContacterListView.Create(AOwner);
RealICQContacterListView.Parent := AOwner;
UpdateContacterListView(RealICQContacterListView);
RealICQContacterListView.ShowMobileButton := not (GroupName = LVMoreUsers);
RealICQContacterListView.ShowTelButton := not (GroupName = LVMoreUsers);
RealICQContacterListView.ShowCameraButton := not (GroupName = LVMoreUsers);
RealICQContacterListView.ShowHeadImageButton := False; //not (GroupName=LVMoreUsers);
RealICQContacterListView.ShowEmailButton := False; // not (GroupName=LVMoreUsers);
RealICQContacterListView.ShowSMSButton := not (GroupName = LVMoreUsers);
// if RealICQClient.EnableSecretLevel AND (FProductType <> ptBGZS) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
// RealICQContacterListView.ShowAddFriendButton := True
// else
RealICQContacterListView.ShowAddFriendButton := False;
if GroupName = LVMoreUsers then
begin
RealICQContacterListView.OnItemOnline := nil;
RealICQContacterListView.OnItemOffline := nil;
end
else
begin
RealICQContacterListView.OnItemOnline := ItemOnline;
RealICQContacterListView.OnItemOffline := ItemOffline;
end;
Result := FContacterListViews.AddObject(GroupName, RealICQContacterListView);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ApplicationEventsDeactivate(Sender: TObject);
begin
if edWatchword.Visible then
edWatchwordExit(edWatchword);
//FDblClickedTrayIcon := False;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ApplicationEventsException(Sender: TObject; E: Exception);
var
LogFile: TextFile;
Log: string;
begin
Exit;
try
Log := DateTimeToStr(Now) + '：' + E.Message;
AssignFile(LogFile, ExtractFilePath(Application.ExeName) + 'Logs.txt');
try
try
Append(LogFile);
except
ReWrite(LogFile);
end;
Writeln(LogFile, Log);
finally
CloseFile(LogFile);
end;
except
end;
end;
procedure TMainForm.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
var
classname: array[0..254] of char;
begin
if (Msg.message = WM_CLOSE) then
begin
getclassname(msg.hwnd, @classname, sizeof(classname)); //取类名
if classname = 'Shell Embedding' then
begin
PeekMessage(Msg, Msg.Hwnd, 0, 0, PM_REMOVE);
Handled := True; //该消息已处理，不再需要后续处理
end;
end;
if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_NCLBUTTONDOWN) then
begin
if IsChild(Handle, Msg.hwnd) then
begin
HideUserCardForm;
end;
end;
end;
procedure TMainForm.ppAddrBookListGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppAddrBookList.PopupMenu);
end;
procedure TMainForm.ppAddrBookListPopup(Sender: TObject);
var
ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
ItemIndex := FContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
miUpdateGroup.Enabled := (RealICQContacterTreeView.GetSelectedBranch <> nil);
miDelGroup.Enabled := (RealICQContacterTreeView.GetSelectedBranch <> nil);
miImportGroupUser.Enabled := (RealICQContacterTreeView.GetSelectedBranch <> nil);
miDelGroupUser.Enabled := (RealICQContacterTreeView.GetSelectedEmployee <> nil);
miUpdateGroupUser.Enabled := (RealICQContacterTreeView.GetSelectedEmployee <> nil);
miCut.Enabled := (RealICQContacterTreeView.GetSelectedBranch <> nil) or (RealICQContacterTreeView.GetSelectedEmployee <> nil);
miPaste.Enabled := (FCutNode <> nil);
miSetRemark.Enabled := (RealICQContacterTreeView.GetSelectedEmployee <> nil);
end;
procedure TMainForm.ppChangeCustomerStateGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppChangeCustomerState.PopupMenu);
end;
procedure TMainForm.ppChangeStatesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppChangeStates.PopupMenu);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppChangeStatesPopup(Sender: TObject);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppColorsGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppColors.PopupMenu);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppColorsPopup(Sender: TObject);
var
iLoop: Integer;
ColorStr: string;
MenuItem: TMenuItem;
Bitmap: TBitmap;
procedure FindSkins(APath: string);
var
DSearchRec: TSearchRec;
FindResult: Integer;
begin
FindResult := FindFirst(APath + '*.*', faDirectory, DSearchRec);
while FindResult = 0 do
begin
if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
if (DSearchRec.Attr and faDirectory) = faDirectory then
begin
MenuItem := TMenuItem.Create(miSkins);
MenuItem.Caption := DSearchRec.Name;
MenuItem.OnClick := miSkinClick;
MenuItem.Enabled := SkinName <> DSearchRec.Name;
MenuItem.Checked := SkinName = DSearchRec.Name;
miSkins.Insert(0, MenuItem);
end;
FindResult := FindNext(DSearchRec);
end;
end;
begin
ImgLstColors.Clear;
while ppColors.Items.Count > 4 do
ppColors.Items.Delete(0);
Bitmap := TBitmap.Create;
Bitmap.SetSize(16, 16);
try
for iLoop := ColorDialog.CustomColors.Count - 1 downto 0 do
begin
ColorStr := Copy(ColorDialog.CustomColors[iLoop], 8, 6);
if ColorStr = 'FFFFFF' then
continue;
ColorStr := '$00' + ColorStr;
Bitmap.Canvas.Pen.Color := clGray;
Bitmap.Canvas.Pen.Style := psSolid;
Bitmap.Canvas.Brush.Color := StrToInt(ColorStr);
Bitmap.Canvas.Brush.Style := bsSolid;
Bitmap.Canvas.Rectangle(0, 0, Width, Height);
ImgLstColors.Add(Bitmap, nil);
MenuItem := TMenuItem.Create(ppColors);
MenuItem.Caption := '颜色' + IntToStr(iLoop);
MenuItem.Tag := StrToInt(ColorStr);
MenuItem.ImageIndex := ImgLstColors.Count - 1;
MenuItem.OnClick := miColorClick;
MenuItem.Enabled := MenuItem.Tag <> UIMainColor;
MenuItem.Checked := MenuItem.Tag = UIMainColor;
if MenuItem.Checked then
MenuItem.ImageIndex := -1;
ppColors.Items.Insert(0, MenuItem);
end;
finally
Bitmap.Free;
end;
miSkins.Clear;
//FindSkins(ExtractFilePath(Application.ExeName) + 'Skins\');
FindSkins(ExtractFilePath(Application.ExeName) + SkinPath);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ChangePPMenuColorMap(PopupMenuEx: TCustomActionPopupMenuEx);
begin
HideUserCardForm;
PopupMenuEx.ColorMap.Color := FormColor;
PopupMenuEx.ColorMap.SelectedColor := ConvertColorToColor(PopupMenuEx.ColorMap.SelectedColor, UIMainColor);
PopupMenuEx.ColorMap.BtnFrameColor := ConvertColorToColor(PopupMenuEx.ColorMap.BtnFrameColor, UIMainColor);
PopupMenuEx.Font.Name := '宋体';
PopupMenuEx.Font.Size := 9;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppContacterViewStyleGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppContacterViewStyle.PopupMenu);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppLoginedUsersGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppLoginedUsers.PopupMenu);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppLoginedUsersPopup(Sender: TObject);
var
iLoop: Integer;
MenuItem: TMenuItem;
begin
while ppLoginedUsers.Items.Count > 2 do
ppLoginedUsers.Items.Delete(0);
for iLoop := 0 to RealICQClient.LoginedUsers.Count - 1 do
begin
if iLoop >= 20 then
Break;
MenuItem := TMenuItem.Create(ppLoginedUsers);
MenuItem.AutoHotkeys := maManual;
MenuItem.AutoLineReduction := maManual;
MenuItem.Caption := RealICQClient.LoginedUsers[iLoop];
MenuItem.OnClick := miChangeLoginNameClick;
MenuItem.Tag := iLoop;
ppLoginedUsers.Items.Insert(0, MenuItem);
end;
end;
procedure TMainForm.ppLoginStatesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppLoginStates.PopupMenu);
end;
procedure TMainForm.ppMainMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppMainMenu.PopupMenu);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppNetWorkFileGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppNetWorkFile.PopupMenu);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppNetWorkFilePopup(Sender: TObject);
begin
NDSelectItemChanged(nil);
miNDNewDir.Enabled := spbNDNewDir.Enabled;
miNDDelete.Enabled := spbNDDelete.Enabled;
miNDDownload.Enabled := spbNDDownload.Enabled;
miNDRename.Enabled := (FLVNetWorkDisk.SelCount = 1) and (not pnlNDMissions.Visible);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppNetWorkMissonGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppNetWorkMisson.PopupMenu);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppNetWorkMissonPopup(Sender: TObject);
begin
if PageControlNDMission.ActivePageIndex = 0 then
miNDCancel.Enabled := FLVNetWorkDiskUploadingFiles.SelCount > 0
else
miNDCancel.Enabled := FLVNetWorkDiskDownloadingFiles.SelCount > 0;
end;
procedure TMainForm.ppSelCallTelGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppSelCallTel.PopupMenu);
end;
procedure TMainForm.ppServerListGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppServerList.PopupMenu);
end;
procedure TMainForm.MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
//在OnMeasureItem事件中改变菜单的宽度和高度
//改变菜单的宽度和高度以容纳文本
Width := edServerList.Width;
end;
procedure TMainForm.miChangeServerClick(Sender: TObject);
var
ServerInfo: TServerInfo;
ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
try
SetGetMoreUserEvent;
if Sender = nil then
begin
//RealICQClient.SendGetMoreBranch(FCurrentServerID);
RealICQClient.SendGetBranchs(FCurrentServerID, 0);
end
else
begin
ServerInfo := FServerInfoList.Objects[FServerInfoList.IndexOf((Sender as TMenuItem).Hint)] as TServerInfo;
if ServerInfo.ServerName = edServerList.Text then
Exit;
ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
if ItemIndex >= 0 then
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
try
RealICQContacterTreeView.Clear;
FreeAndNil(RealICQContacterTreeView);
FContacterTreeViews.Delete(ItemIndex);
except
//Exit;
end;
end;
ImgLoadingMoreBranchs.Visible := True;
ScrollBoxMoreUser.Visible := False;
edServerList.Text := ServerInfo.ServerName;
//RealICQClient.SendGetMoreBranch(ServerInfo.ServerId);
RealICQClient.SendGetBranchs(ServerInfo.ServerId, 0);
FCurrentServerID := ServerInfo.ServerId;
end;
except
edServerList.Text := '';
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppTeamListViewGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppTeamListView.PopupMenu);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppTeamListViewPopup(Sender: TObject);
var
iLoop: Integer;
RealICQTeam: TRealICQTeam;
ListItem: TRealICQContacterListItem;
begin
actSendTeamMessage.Visible := FLVTeams.SelCount = 1;
actSeeTeamInformation.Visible := FLVTeams.SelCount = 1;
actShowTeamHistory.Visible := FLVTeams.SelCount = 1;
actQuitTeam.Visible := FLVTeams.SelCount = 1;
actDisbandTeam.Visible := FLVTeams.SelCount = 1;
actQuitOrDisbandTeams.Visible := FLVTeams.SelCount > 1;
self.miSendTeamSMS.Visible := FLVTeams.SelCount = 1;
if FLVTeams.SelCount = 1 then
begin
for iLoop := 0 to FLVTeams.Items.Count - 1 do
begin
ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
RealICQTeam := ListItem.Data;
actDisbandTeam.Visible := AnsiSameText(RealICQTeam.TeamCreater, RealICQClient.LoginName);
actQuitTeam.Visible := not actDisbandTeam.Visible;
if actDisbandTeam.Visible then
actSeeTeamInformation.Caption := '修改群组详细资料(&D)...'
else
actSeeTeamInformation.Caption := '查看群组详细资料(&D)...';
Break;
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppTrayIconGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppTrayIcon.PopupMenu);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppUserItemRightMenuGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppUserItemRightMenu.PopupMenu);
end;
//------------------
function TMainForm.GetActiveTabSheetName: string;
//var ImageButton:TRealICQHoverImage;
begin
if ActiveButtonTag < 1 then
ActiveButtonTag := 1;
// ImageButton:=FToolBarButtonIconList.Objects[ActiveButtonTag-1] as TRealICQHoverImage;
Result := FToolBarButtonIconList[ActiveButtonTag - 1];
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppUserItemRightMenuPopup(Sender: TObject);
var
iLoop, ItemIndex: Integer;
GroupName, TabSheetName: string;
Friend: TRealICQEmployee;
MenuItem: TMenuItem;
RealICQContacterTreeView: TRealICQContacterTreeView;
RealICQFriendTreeView: TRealICQContacterTreeView;
procedure SetMenuItemVisible;
begin
actSendMessage.Visible := actSendMessage.Enabled;
actSeeInformation.Visible := actSeeInformation.Enabled;
actShowHistory.Visible := actShowHistory.Enabled;
actChangeRemark.Visible := actChangeRemark.Enabled;
actDelFriend.Visible := actDelFriend.Enabled;
actRemoveUser.Visible := actRemoveUser.Enabled;
miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
// miGroup.Visible := miGroup.Enabled;
end;
begin
miGoSpace.Visible := ShowSNS;
RealICQContacterTreeView := nil;
RealICQFriendTreeView := nil;
TabSheetName := GetActiveTabSheetName;
//如果是在“最近联系人”中弹出右键菜单
if TabSheetName = LVLatests then
begin
actSendMessage.Enabled := FLVLatests.SelCount = 1;
actSeeInformation.Enabled := FLVLatests.SelCount = 1;
actShowHistory.Enabled := FLVLatests.SelCount = 1;
actChangeRemark.Enabled := False;
actDelFriend.Enabled := False;
actRemoveUser.Enabled := False;
// miGroup.Enabled := False;
// miManageGroup.Enabled := False;
// miManageGroup.Visible := False;
// menuItemShowGroup.Visible := False;
miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
SetMenuItemVisible;
Exit;
end;
actSendMessage.Enabled := False;
miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
actSeeInformation.Enabled := False;
;
actShowHistory.Enabled := False;
actChangeRemark.Enabled := False;
actRemoveUser.Enabled := False;
actDelFriend.Enabled := False;
// miGroup.Enabled := False;
// miManageGroup.Enabled := False;
// miManageGroup.Visible := False;
// menuItemShowGroup.Visible := False;
if TabSheetName = LVMyContacters then
begin
ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
if (RealICQContacterTreeView.GetSelectedEmployee <> nil) then
begin
actSendMessage.Enabled := True;
miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
actSeeInformation.Enabled := True;
actShowHistory.Enabled := True;
actChangeRemark.Enabled := True;
// miGroup.Enabled := False;
actRemoveUser.Enabled := False;
actDelFriend.Enabled := False;
end;
SetMenuItemVisible;
Exit;
end;
if TabSheetName = LVMoreUsers then
begin
ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
if (RealICQContacterTreeView.GetSelectedEmployee <> nil) then
begin
actSendMessage.Enabled := True;
miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
actSeeInformation.Enabled := True;
actShowHistory.Enabled := True;
actChangeRemark.Enabled := True;
// miGroup.Enabled := False;
actRemoveUser.Enabled := False;
actDelFriend.Enabled := False;
end;
SetMenuItemVisible;
Exit;
end;
ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Friend := RealICQFriendTreeView.GetSelectedEmployee;
// miManageGroup.Enabled := True;
// miManageGroup.Visible := True;
// menuItemShowGroup.Visible := True;
if Friend <> nil then
begin
GroupName := Friend.BranchID;
if GroupName = LvFriends then
actDelFriend.Enabled := True;
actSendMessage.Enabled := True;
miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
actSeeInformation.Enabled := True;
actShowHistory.Enabled := True;
actChangeRemark.Enabled := True;
// miGroup.Enabled := True and (not FSearchListViewInVisible);
actRemoveUser.Enabled := True;
SetMenuItemVisible;
end
else
begin
SetMenuItemVisible;
Exit;
end;
if AnsiSameStr(GroupName, LVFriends) then
begin
// miGroup.Caption := '移动至组(&M)...';
actRemoveUser.Enabled := False;
end
else
begin
//在自定义组的用户列表控件上弹出右键菜单
actSendMessage.Enabled := True;
miGoSpace.Enabled := ShowSNS and actSendMessage.Enabled;
actSeeInformation.Enabled := True;
actShowHistory.Enabled := True;
actChangeRemark.Enabled := True;
// miGroup.Enabled := True and (not FSearchListViewInVisible);
// miGroup.Caption := '移动至组(&M)...';
end;
// miGroup.Clear;
if FShowGroup then
begin
for iLoop := 0 to FGroups.Count - 1 do
begin
if GroupName = FGroups[iLoop] then
continue;
// MenuItem := TMenuItem.Create(miGroup);
// MenuItem.Caption := FGroups[iLoop];
// MenuItem.OnClick := miMoveGroupClick;
// MenuItem.Enabled := miGroup.Enabled;
// miGroup.Add(MenuItem);
end;
// MenuItem := TMenuItem.Create(miGroup);
// MenuItem.Caption := '-';
// miGroup.Add(MenuItem);
end;
// miGroup.Enabled := miGroup.Count > 0;
end;
//------------------------------------------------------------------------------
procedure TMainForm.WMQueryEndSession(var message: TWMQUERYENDSESSION);
begin
try
try
//Dialogs.ShowMessage('关机');
FreeAndNil(NotReadMessageBoxForm);
Application.Terminate;
if RealICQClient.Logined then
RealICQClient.Logout;
except
end;
finally
message.Result := 1; //允许
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.WMPowerBroadcast(var message: TMessage);
begin
try
try
if message.wparam = 4 then //..休眠
begin
if RealICQClient.Logined then
RealICQClient.Logout;
end;
if message.wparam = 18 then // 休眠重起
begin
if RealICQClient.SavedPassword then
RealICQClient.LoginAsSaved;
end;
except
end;
finally
message.Result := 1; //允许
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.CMWininichange(var Message: TWMWinIniChange);
begin
ChangeUIColor(FUIMainColor);
//TMainFormController.GetController.ChangeUIColor(UIMainColor);
DisableAlign;
try
PostMessage(Handle, WM_SIZE, 0, 0);
finally
EnableAlign;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetSearchListViewVisible(AShow: Boolean);
begin
FSearchListViewInVisible := AShow;
if AShow then
begin
pnlSearch.Left := shpFilterBorder.Left + 9;
pnlSearch.Top := shpFilterBorder.Top + shpFilterBorder.Height + 28;
pnlSearch.Width := shpFilterBorder.Width;
pnlSearch.Visible := True;
end
else
begin
pnlSearch.Visible := False;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.edFilterKeywordChange(Sender: TObject);
var
iLoop: Integer;
RealICQUser: TRealICQUser;
KeyWord, UserCaption: string;
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
AUsers: TStringList;
begin
KeyWord := Trim(edFilterKeyword.Text);
if (KeyWord = '查找联系人...') or (KeyWord = '') then
begin
if FSearchListViewInVisible then
SetSearchListViewVisible(False);
end
else
begin
if not FSearchListViewInVisible then
SetSearchListViewVisible(True);
if AnsiSameText(KeyWord, FLastSearchKeyWord) then
Exit;
//删除当前结果中不符合新的查询条件的记录
FLastSearchKeyWord := KeyWord;
for iLoop := FSearchListView.Items.Count - 1 downto 0 do
begin
if not AnsiSameText(Trim(edFilterKeyword.Text), KeyWord) then
Exit;
ListItem := FSearchListView.Items.Objects[iLoop] as TRealICQContacterListItem;
RealICQUser := ListItem.Data;
UserCaption := RealICQUser.DisplayName + '' + RealICQUser.LoginName + '' + RealICQUser.Watchword;
if (AnsiPos(UpperCase(KeyWord), UpperCase(UserCaption)) = 0) and (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.LoginName)) = 0) and (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.DisplayName)) = 0) and (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.Watchword)) = 0) then
FSearchListView.Items.Delete(iLoop);
Application.ProcessMessages;
end;
FSearchListView.FlashCaptionOnOnline := False;
//在好友列表中查找
AUsers := TUsersService.GetUsersService.GetWorkmatesAndFriends;
try
for iLoop := 0 to AUsers.Count - 1 do
begin
if not AnsiSameText(FLastSearchKeyWord, KeyWord) then
begin
Exit;
end;
RealICQUser := AUsers.Objects[iLoop] as TRealICQUser;
if (RealICQUser = RealICQClient.Me) then
continue;
UserCaption := RealICQUser.DisplayName + ' ' + RealICQUser.LoginName + ' ' + RealICQUser.Watchword;
if (AnsiPos(UpperCase(KeyWord), UpperCase(UserCaption)) > 0) or (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.LoginName)) > 0) or (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.DisplayName)) > 0) or (AnsiPos(UpperCase(KeyWord), GetPYIndexString(RealICQUser.Watchword)) > 0) then
begin
ItemIndex := FSearchListView.Items.IndexOf(RealICQUser.LoginName);
if ItemIndex = -1 then
begin
ItemIndex := FSearchListView.Items.Add(RealICQUser.LoginName);
ListItem := FSearchListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
//BindUserDataToItem(ListItem, RealICQUser);
TUsersService.GetUsersService.UpdateListItem(FSearchListView, ListItem, RealICQUser);
Application.ProcessMessages;
end;
end;
end;
finally
FreeAndNil(AUsers);
end;
FSearchListView.FlashCaptionOnOnline := FFlashCaptionOnOnline;
if FSearchListView.Items.Count <= 0 then
begin
ScrollBoxSearchUser.Visible := False;
lblSearchResult.Caption := #10 + #13 + ' 无搜索结果';
lblSearchResult.Visible := True;
end
else
begin
ScrollBoxSearchUser.Visible := True;
lblSearchResult.Visible := False;
end;
end;
end;
procedure TMainForm.edFilterKeywordClick(Sender: TObject);
var
KeyWord: string;
begin
KeyWord := Trim(edFilterKeyword.Text);
if KeyWord = '查找联系人...' then
edFilterKeyword.Text := '';
edFilterKeyword.Font.Color := clWindowText;
end;
//------------------------------------------------------------------------------
procedure TMainForm.edFilterKeywordExit(Sender: TObject);
var
KeyWord: string;
begin
KeyWord := Trim(edFilterKeyword.Text);
if KeyWord = '' then
edFilterKeyword.Text := '查找联系人...';
edFilterKeyword.Font.Color := clGray;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetLoginStateControlState;
const
CA_TEXT: string = '您选择了使用CA登录';
begin
try
if (FLoginState = stLeave) or (FLoginState = stBusy) then
spbLoginState.Caption := FLeaveMessage
else
spbLoginState.Caption := StateValues[Integer(FLoginState)];
RealICQClient.LoginState := FLoginState;
RealICQClient.LeaveMessage := FLeaveMessage;
// RealICQClient.Me.LoginState := FLoginState;
// RealICQClient.Me.LeaveMessage := FLeaveMessage;
if FSavePassword then
ImgLstCheckStates.GetIcon(1, spbSavePassword.Icon)
else
ImgLstCheckStates.GetIcon(0, spbSavePassword.Icon);
if RealICQClient.CaEnable then
begin
if RealICQClient.CALogin then
begin
ImgLstCheckStates.GetIcon(1, btnCaLogin.Icon);
edLoginName.Text := CA_TEXT;
edLoginName.Enabled := False;
edPassword.Enabled := False;
spbChangeLoginName.Enabled := False;
end
else
begin
ImgLstCheckStates.GetIcon(0, btnCaLogin.Icon);
if SameText(CA_TEXT, edLoginName.Text) then
edLoginName.Text := '';
edLoginName.Enabled := True;
edPassword.Enabled := True;
spbChangeLoginName.Enabled := True;
end;
end;
FAutoLogin := FAutoLogin and FSavePassword;
spbAutoLogin.Enabled := FSavePassword;
if FAutoLogin then
ImgLstCheckStates.GetIcon(1, spbAutoLogin.Icon)
else
ImgLstCheckStates.GetIcon(0, spbAutoLogin.Icon);
except
on E: Exception do
begin
Error(E.Message, 'TMainForm.SetLoginStateControlState');
end;
end;
//ShowMeInformation;
end;
//------------------------------------------------------------------------------
procedure TMainForm.edLoginNameChange(Sender: TObject);
begin
if AnsiSameText(edLoginName.Text, RealICQClient.LoginName) and RealICQClient.SavedPassword then
begin
edPassword.Text := '保存的密码';
lblPasswordTitle.Enabled := False;
edPassword.Enabled := False;
spbSavePassword.Enabled := False;
FLoginAsSavePassword := True;
FLoginState := RealICQClient.LoginState;
FLeaveMessage := RealICQClient.LeaveMessage;
FSavePassword := RealICQClient.SavedPassword;
FAutoLogin := RealICQClient.AutoLogin;
SetLoginStateControlState;
end
else if FLoginAsSavePassword then
begin
edPassword.Text := '';
edPassword.Enabled := True;
lblPasswordTitle.Enabled := True;
spbSavePassword.Enabled := True;
FLoginAsSavePassword := False;
FLoginState := stOnline;
FLeaveMessage := '';
FSavePassword := False;
FAutoLogin := False;
SetLoginStateControlState;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.edPasswordEnter(Sender: TObject);
begin
if not RealICQClient.CALogin then
begin
Self.FSavePassword := True;
// FAutoLogin := True;
RealICQClient.AutoLogin := FAutoLogin;
SetLoginStateControlState;
end;
end;
//------全市查找-----------------------------
procedure TMainForm.edtSearchMoreUserChange(Sender: TObject);
var
KeyWord: string;
iIndex, iLoop: Integer;
//FSearchMoreUserListView:TRealICQContacterListView;
begin
KeyWord := Trim((Sender as TEdit).Text);
iIndex := FContacterListViews.IndexOf(LVMoreUsers);
FSearchMoreUserListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
FSearchMoreUserListView.Items.Clear;
if (KeyWord = '查找联系人...') or (KeyWord = '') then
begin
pnlSearchMoreUser.Visible := False;
Exit;
end
else
begin
RealICQClient.OnSearchUserResult := RealICQClientSearchUserResult;
RealICQClient.SendSearchMoreUser(KeyWord, FCurrentServerID);
pnlSearchMoreUser.Left := shpSearchMoreUser.Left;
pnlSearchMoreUser.Width := pnlSelectServer.Width - 22;
pnlSearchMoreUser.Top := shpSearchMoreUser.Top + shpSearchMoreUser.Height;
LblSearchHint.Caption := #10 + #10 + #10 + #10 + #10'正在查询,请稍侯。';
LblSearchHint.Visible := True;
ScrollBoxSearchMoreUser.Visible := False;
ImgLogining.Visible := True;
pnlSearchMoreUser.Visible := True;
pnlSearchMoreUser.BringToFront;
end;
end;
//--------------------------------------------------------
procedure TMainForm.edtSearchMoreUserClick(Sender: TObject);
var
KeyWord: string;
begin
KeyWord := Trim(edtSearchMoreUser.Text);
if KeyWord = '查找联系人...' then
edtSearchMoreUser.Text := '';
edtSearchMoreUser.Font.Color := clWindowText;
end;
procedure TMainForm.edtSearchMoreUserExit(Sender: TObject);
var
KeyWord: string;
begin
KeyWord := Trim(edtSearchMoreUser.Text);
if KeyWord = '' then
edtSearchMoreUser.Text := '查找联系人...';
edtSearchMoreUser.Font.Color := clGray;
end;
//------------------------------------------------------------------------------
procedure TMainForm.edWatchwordExit(Sender: TObject);
var
AWatchword: WideString;
begin
spbWatchword.Visible := True;
shpWatchwordBorder.Visible := False;
edWatchword.Visible := False;
if RealICQClient.Logined then
begin
if (not AnsiSameStr(Trim(edWatchword.Text), RealICQClient.Me.Watchword)) and (not AnsiSameStr(Trim(edWatchword.Text), '在此键入您的个性签名')) then
begin
AWatchword := Trim(edWatchword.Text);
spbWatchword.Hint := AWatchword;
spbWatchword.ShowHint := False;
//字符串长度过长时,截短字符串并在后面显示“...”
while spbWatchword.Canvas.TextWidth(AWatchword) > pnlTop.Width - 86 do
begin
if Length(AWatchword) > 3 then
begin
if Copy(AWatchword, Length(AWatchword) - 2, Length(AWatchword)) = '...' then
AWatchword := Copy(AWatchword, 1, Length(AWatchword) - 3);
AWatchword := Copy(AWatchword, 1, Length(AWatchword) - 1) + '...';
end
else
break;
spbWatchword.ShowHint := True;
end;
spbWatchword.Caption := edWatchword.Text;
RealICQClient.ChangeBaseInformation(RealICQClient.Me.DisplayName, Trim(edWatchword.Text));
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.edWatchwordKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = 13 then
edWatchwordExit(edWatchword);
end;
//------------------------------------------------------------------------------
procedure TMainForm.edWebSearchKeyWordEnter(Sender: TObject);
begin
//
end;
//------------------------------------------------------------------------------
procedure TMainForm.edWebSearchKeyWordExit(Sender: TObject);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.edWebSearchKeyWordKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = 13 then
spbWebSearchClick(nil);
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbWatchwordClick(Sender: TObject);
begin
if not RealICQClient.Logined then
Exit;
spbWatchword.Visible := False;
shpWatchwordBorder.Left := spbWatchword.Left;
shpWatchwordBorder.Top := spbWatchword.Top;
shpWatchwordBorder.Width := pnlTop.Width - 66;
shpWatchwordBorder.Height := spbWatchword.Height;
edWatchword.Left := shpWatchwordBorder.Left + 2;
edWatchword.Top := shpWatchwordBorder.Top + (shpWatchwordBorder.Height - edWatchword.Height) div 2 + 1;
edWatchword.Width := shpWatchwordBorder.Width - 6;
edWatchword.Text := RealICQClient.Me.Watchword;
shpWatchwordBorder.Visible := True;
edWatchword.Visible := True;
edWatchword.SetFocus;
edWatchword.SelStart := 0;
edWatchword.SelLength := Length(edWatchword.Text);
shpWatchwordBorder.BringToFront;
edWatchword.BringToFront;
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbWebSearchClick(Sender: TObject);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbWinMeetClick(Sender: TObject);
var
WinMeetPath, Parameter: string;
Branch: TRealICQBranch;
ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVMoreUsers);
if (ItemIndex < 0) then
Exit;
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
ItemIndex := RealICQContacterTreeView.BranchItems.IndexOf(MainForm.RealICQClient.Me.BranchID);
if (ItemIndex < 0) then
Exit;
Branch := RealICQContacterTreeView.BranchItems.Objects[ItemIndex] as TRealICQBranch;
while Branch.Node.Parent <> nil do
begin
Branch := TRealICQBranch(Branch.Node.Parent.Data);
end;
WinMeetPath := GetFilePahtFromRegedit('\Software\WinSoft\WinMeet', 'AppPath');
if Trim(WinMeetPath) = '' then
begin
ShowMessage('您还没有安装视频会议客户端！');
Exit;
end;
Parameter := ' ' + MainForm.RealICQClient.LoginName + ' ' + MD5En(RealICQClient.Password) + ' ' + Branch.BranchID;
ShellExecute(handle, 'open', PChar(WinMeetPath), PChar(Parameter), '', SW_SHOWNORMAL);
end;
//------------------------------------------------------------------------------
procedure TMainForm.CreateParams(var Params: TCreateParams);
begin
inherited;
//Inherited CreateParams(Params);
with Params do
begin
Params.WndParent := 0;
//Params.WndParent := GetDesktopWindow();
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.WndProc(var Message: TMessage);
begin
inherited wndproc(message);
if message.msg = WM_DEVICECHANGE then
RealICQClient.CheckAVDevice;
if message.msg = CLOSEWINDOWS then
QuitWindows;
// if (message.msg = WM_WINDOWPOSCHANGING) then
// pnlGroups.Refresh;
// Debug('WM_WINDOWPOSCHANGING','WM_WINDOWPOSCHANGING');
// if (message.msg = WM_WINDOWPOSCHANGED) then
// pnlGroups.Refresh;
// Debug('WM_WINDOWPOSCHANGED','WM_WINDOWPOSCHANGED');
//(Handle, WM_PRINTCLIENT, 0, 0);
{if (message.msg = WM_PAINT) or (message.msg = WM_NCPAINT) then
begin
ActionMainMenuBar.Refresh;
end;}
end;
procedure TMainForm.spbAddToNAClick(Sender: TObject);
var
TabSheet: TTabSheet;
WebBrowser: TWebBrowser;
begin
MainForm.FormStyle := fsNormal;
try
try
TabSheet := pgcMultiWeb.ActivePage;
WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
AddToFavorite(WebBrowser);
except
end;
finally
// if MainForm.AlwaysOnTop then
// MainForm.FormStyle := fsStayOnTop
// else
// MainForm.FormStyle := fsNormal;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbWebCloseClick(Sender: TObject);
var
TabSheet: TTabSheet;
WebBrowser: TWebBrowser;
begin
TabSheet := pgcMultiWeb.ActivePage;
WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
if pgcMultiWeb.PageCount > 1 then
begin
try
if WebBrowser.Busy then
WebBrowser.Stop;
except
end;
TabSetMuiltWeb.Tabs.Delete(TabSheet.TabIndex);
TabSheet.PageControl := nil;
FreeAndNil(TabSheet);
end
else
begin
WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
WebBrowser.Navigate('about:blank');
end;
end;
procedure TMainForm.spbAutoLoginClick(Sender: TObject);
begin
FAutoLogin := not FAutoLogin;
RealICQClient.AutoLogin := FAutoLogin;
SetLoginStateControlState;
end;
procedure TMainForm.HideMainForm;
begin
if FMovingMainForm then
Exit;
if RealICQClient.Logining then
Exit;
PostMessage(Handle, WM_KILLFOCUS, 0, 0);
self.SendToBack;
FMainFormHidden := True;
end;
procedure TMainForm.ShowMainForm;
begin
if FMovingMainForm then
Exit;
self.BringToFront;
PostMessage(Handle, WM_SETFOCUS, 0, 0);
FMainFormHidden := False;
end;
procedure TMainForm.WMSizing(var Msg: TMessage);
begin
inherited;
HideUserCardForm;
FMovingMainForm := True;
end;
procedure TMainForm.WMSize(var Msg: TMessage);
begin
inherited;
HideUserCardForm;
FMovingMainForm := False;
//CheckWindowPositon;
end;
procedure TMainForm.WMMoving(var Msg: TWMMoving);
var
BaseTop, BaseLeft: Integer;
rect:TRect;
begin
inherited;
HideUserCardForm;
FMovingMainForm := True;
rect.Left := 1;
rect.Top := 1;
rect.Bottom := Screen.Height - 1;
rect.Right := Screen.Width - 1;
Windows.ClipCursor(@rect);
BaseTop := (Height - ClientHeight) div 4;
BaseLeft := (Width - ClientWidth) div 4;
if (Msg.DragRect^.Top < -BaseTop) then
FHidePosition := hpTop
else if (Msg.DragRect^.Left < -BaseLeft) then
FHidePosition := hpLeft
else if (Msg.DragRect^.Left > (Screen.WorkAreaWidth - Width + BaseLeft)) then
FHidePosition := hpRight
else
FHidePosition := hpNone;
end;
procedure TMainForm.WMMove(var Msg: TMessage);
begin
HideUserCardForm;
FMovingMainForm := False;
Windows.ClipCursor(0);
if not FAutoHide then
exit;
if FWindowMoveing then
exit;
case FHidePosition of
hpTop:
WindowMove(False, -ClientHeight);
hpLeft:
WindowMove(False, -ClientWidth);
hpRight:
WindowMove(False, (Screen.WorkAreaWidth - Width + ClientWidth));
end;
if FHidePosition <> hpNone then
SetOnTop(Handle, True)
else
if not FAlwaysOnTop then
SetOnTop(Handle, False);
end;
procedure TMainForm.WMNCMouseMove(var msg: TWMNCMousemove);
var
BaseTop, BaseLeft, BaseRight: Integer;
begin
inherited;
if not FAutoHide then
exit;
if FWindowMoveing then
exit;
case FHidePosition of
hpTop:
case msg.HitTest of
HTBOTTOMLEFT, HTBOTTOM, HTBOTTOMRIGHT:
begin
BaseTop := (Height - ClientHeight) div 2;
if Top < -BaseTop then
begin
WindowMove(True, -BaseTop);
TimerForHideMainForm.Enabled := True;
end;
end;
end;
hpLeft:
case msg.HitTest of
HTTOPRIGHT, HTRIGHT, HTBOTTOMRIGHT:
begin
BaseLeft := (Width - ClientWidth) div 2;
if Left < -BaseLeft then
begin
WindowMove(True, -BaseLeft);
TimerForHideMainForm.Enabled := True;
end;
end;
end;
hpRight:
case msg.HitTest of
HTTOPLEFT, HTLEFT, HTBOTTOMLEFT:
begin
BaseLeft := (Width - ClientWidth) div 2;
BaseRight := Screen.WorkAreaWidth - ClientWidth - BaseLeft;
if Left > BaseRight then
begin
WindowMove(True, BaseRight);
TimerForHideMainForm.Enabled := True;
end;
end;
end;
end;
end;
procedure TMainForm.WindowMove(blnShow: Boolean; iBase: Integer);
begin
FWindowMoveing := true;
DisableAlign;
if not pnlLogout.Visible then
pnlWorkArea.Visible := False;
if blnShow then
begin
case FHidePosition of
hpTop:
begin
ANimateWindow(Handle, 20, AW_HIDE or AW_VER_POSITIVE);
sleep(10);
Top := iBase;
ANimateWindow(Handle, 300, AW_SLIDE or AW_VER_POSITIVE);
end;
hpLeft:
begin
ANimateWindow(Handle, 20, AW_HIDE or AW_HOR_POSITIVE);
sleep(10);
left := iBase;
ANimateWindow(Handle, 300, AW_SLIDE or AW_HOR_POSITIVE);
end;
hpRight:
begin
ANimateWindow(Handle, 20, AW_HIDE or AW_HOR_NEGATIVE);
sleep(10);
left := iBase;
ANimateWindow(Handle, 300, AW_SLIDE or AW_HOR_NEGATIVE);
end;
end;
end
else
begin
case FHidePosition of
hpTop:
begin
ANimateWindow(Handle, 300, AW_HIDE or AW_VER_NEGATIVE);
sleep(10);
Top := iBase;
ANimateWindow(Handle, 20, AW_VER_NEGATIVE);
end;
hpLeft:
begin
ANimateWindow(Handle, 300, AW_HIDE or AW_HOR_NEGATIVE);
sleep(10);
Left := iBase;
ANimateWindow(Handle, 20, AW_HOR_NEGATIVE);
end;
hpRight:
begin
ANimateWindow(Handle, 300, AW_HIDE or AW_HOR_POSITIVE);
sleep(10);
Left := iBase;
ANimateWindow(Handle, 20, AW_HOR_POSITIVE);
end;
end;
end;
if not pnlLogout.Visible then
pnlWorkArea.Visible := true;
EnableAlign;
FWindowMoveing := false;
end;
procedure TMainForm.TimerForHideMainFormTimer(Sender: TObject);
var
Rect: TRect;
begin
if FMovingMainForm then
Exit;
if FWindowMoveing then
exit;
if not FAutoHide then
begin
if FMainFormHidden then
ShowMainForm;
FHidePosition := hpNone;
TimerForHideMainForm.Enabled := False;
Exit;
end;
//搜狗输入法冲突
// if FHidePosition <> hpNone then
// SetOnTop(Handle,True);
TimerForHideMainForm.Enabled := false;
Rect.Top := self.Top;
Rect.Left := self.Left;
Rect.Right := self.Left + self.Width;
Rect.Bottom := self.Top + self.Height;
if not PtInRect(Rect, Mouse.CursorPos) then
begin
case FHidePosition of
hpTop:
if Top <> -ClientHeight then
WindowMove(False, -ClientHeight);
hpLeft:
if Left <> -ClientWidth then
WindowMove(False, -ClientWidth);
hpRight:
if Left <> Screen.WorkAreaWidth - Width + ClientWidth then
WindowMove(False, (Screen.WorkAreaWidth - Width + ClientWidth));
end;
end;
TimerForHideMainForm.Enabled := FHidePosition <> hpNone;
end;
procedure TMainForm.CheckWindowPositon;
var
BaseTop, BaseLeft: Integer;
begin
BaseTop := (Height - ClientHeight) div 4;
BaseLeft := (Width - ClientWidth) div 4;
if (Top < -BaseTop) then
FHidePosition := hpTop
else if (Left < -BaseLeft) then
FHidePosition := hpLeft
else if (Left > (Screen.WorkAreaWidth - Width + BaseLeft)) then
FHidePosition := hpRight
else
FHidePosition := hpNone;
if TimerForHideMainForm <> nil then
TimerForHideMainForm.Enabled := FHidePosition <> hpNone;
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbCancelFilterClick(Sender: TObject);
begin
edFilterKeyword.Text := '查找联系人...';
edFilterKeyword.Font.Color := clGray;
end;
procedure TMainForm.spbChangeLoginNameClick(Sender: TObject);
var
Point: TPoint;
begin
Point.X := 0;
Point.Y := spLoginNameBorder.Height + 1;
Point := spLoginNameBorder.ClientToScreen(Point);
ppLoginedUsers.Popup(Point.X, Point.Y);
end;
procedure TMainForm.spbContacterViewStyleClick(Sender: TObject);
var
Point: TPoint;
begin
Point.X := 0;
Point.Y := spbContacterViewStyle.Height + 1;
Point := spbContacterViewStyle.ClientToScreen(Point);
ppContacterViewStyle.Popup(Point.X, Point.Y);
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbDisplayNameClick(Sender: TObject);
var
Point: TPoint;
begin
Point.X := 0;
Point.Y := spbDisplayName.Height + 1;
Point := spbDisplayName.ClientToScreen(Point);
ppChangeStates.Popup(Point.X, Point.Y);
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbEmailClick(Sender: TObject);
begin
//AddWebBrowserToPageControl('http://www.lxtalk.com/rd/', 999);
end;
procedure TMainForm.spbFindTeamClick(Sender: TObject);
begin
//非办公助手企业用户无查找群组权限
if (FProductType <> ptBGZS) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
begin
ShowMessage('您没有查找群组权限! ');
Exit;
end;
if SearchTeamForm <> nil then
begin
SearchTeamForm.BringToFront;
Exit;
end;
SearchTeamForm := TSearchTeamForm.Create(Application);
SearchTeamForm.Show;
end;
procedure TMainForm.spbGoClick(Sender: TObject);
var
TabSheet: TTabSheet;
WebBrowser: TWebBrowser;
begin
TabSheet := pgcMultiWeb.ActivePage;
WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
WebBrowser.Tag := -1;
try
if (WebBrowser.Busy) then
WebBrowser.Stop;
except
end;
WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
WebBrowser.Navigate(cbxURLInputer.Text);
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbLoginStateClick(Sender: TObject);
var
Point: TPoint;
begin
Point.X := 0;
Point.Y := spbLoginState.Height + 1;
Point := spbLoginState.ClientToScreen(Point);
ppLoginStates.Popup(Point.X, Point.Y);
end;
procedure TMainForm.spbNDCancelAllClick(Sender: TObject);
var
AMissionID: string;
UploadMission: TUploadMission;
ListItem: TRealICQContacterListItem;
begin
try
if (FLVNetWorkDiskUploadingFiles <> nil) and (FLVNetWorkDiskUploadingFiles.Items.Count > 0) then
begin
ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[0] as TRealICQContacterListItem;
if Assigned(ListItem) then
begin
UploadMission := TUploadMission(ListItem.Data);
if Assigned(UploadMission) then
begin
AMissionID := UploadMission.FID;
try
FLVNetWorkDiskUploadingFiles.Items.Delete(ListItem.ItemIndex);
FreeAndNil(UploadMission);
except
end;
RealICQNetWorkDiskClient.CancelUploadingFile(AMissionID);
end;
end;
end;
except
end;
try
if FLVNetWorkDiskUploadingFiles <> nil then
begin
FLVNetWorkDiskUploadingFiles.Items.Clear;
FLVNetWorkDiskUploadingFiles.ReDrawAll;
end;
except
end;
try
if FLVNetWorkDiskDownloadingFiles <> nil then
begin
FLVNetWorkDiskDownloadingFiles.Items.Clear;
FLVNetWorkDiskDownloadingFiles.ReDrawAll;
end;
except
end;
ClearFileMissions;
pnlNDMissions.Visible := False;
SplitterNDMissions.Visible := False;
spbNDCancelAll.Enabled := False;
FConfirmReplaceResult := -1;
FLastDownloadDirectory := '';
CheckNDControlState;
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbNDConnectClick(Sender: TObject);
var
LoginName: string;
begin
RealICQNetWorkDiskClient.TCPClient.RemoteAddress := RealICQClient.NetWorkDiskServerAddress;
RealICQNetWorkDiskClient.TCPClient.RemotePort := RealICQClient.NetWorkDiskServerPort;
RealICQNetWorkDiskClient.TCPClient.Proxy.Assign(RealICQClient.TCPClient.Proxy);
LoginName := RealICQClient.LoginName;
if Pos('+', RealICQClient.LoginName) > 0 then
LoginName := Copy(RealICQClient.LoginName, Pos('+', RealICQClient.LoginName) + 1, Length(RealICQClient.LoginName));
RealICQNetWorkDiskClient.Login(LoginName, RealICQClient.Password);
end;
procedure TMainForm.spbSavePasswordClick(Sender: TObject);
begin
FSavePassword := not FSavePassword;
SetLoginStateControlState;
end;
procedure TMainForm.spbSelectServerClick(Sender: TObject);
var
Point: TPoint;
begin
Point.X := 0;
Point.Y := spServerListBorder.Height;
Point := spServerListBorder.ClientToScreen(Point);
ppServerList.Popup(Point.X, Point.Y);
end;
procedure TMainForm.spbSelLanguageClick(Sender: TObject);
var
Point: TPoint;
begin
Point.X := 0;
Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
ppLanguages.Popup(Point.X, Point.Y);
end;
procedure TMainForm.spbSelUIColorClick(Sender: TObject);
var
Point: TPoint;
begin
Point.X := 0;
Point.Y := (Sender as TRealICQSpeedButton).Height + 1;
Point := (Sender as TRealICQSpeedButton).ClientToScreen(Point);
ppColors.Popup(Point.X, Point.Y);
end;
procedure TMainForm.spbShowHideRightClick(Sender: TObject);
begin
//ShowOrHideMuiltiWeb;
end;
procedure TMainForm.spbStopClick(Sender: TObject);
var
TabSheet: TTabSheet;
WebBrowser: TWebBrowser;
begin
try
TabSheet := pgcMultiWeb.ActivePage;
WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
if WebBrowser.Busy then
WebBrowser.Stop;
except
end;
end;
procedure TMainForm.TabSetMuiltWebClick(Sender: TObject);
var
TabSheet: TTabSheet;
WebBrowser: TWebBrowser;
begin
pgcMultiWeb.ActivePageIndex := TabSetMuiltWeb.TabIndex;
try
TabSheet := pgcMultiWeb.ActivePage;
WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
if not AnsiSameText(WebBrowser.LocationURL, 'about:blank') then
begin
with cbxURLInputer.ItemsEx.Add do
begin
Caption := WebBrowser.LocationURL;
if (Copy(Caption, 1, 5) = 'file:') or (Copy(Caption, 2, 1) = ':') then
ImageIndex := 2
else if Copy(Caption, 1, 4) = 'ftp:' then
ImageIndex := 1
else
ImageIndex := 0;
end;
cbxURLInputer.ItemIndex := cbxURLInputer.ItemsEx.Count - 1;
end;
except
end;
end;
procedure TMainForm.TabSetMuiltWebGetImageIndex(Sender: TObject; TabIndex: Integer; var ImageIndex: Integer);
var
TabSheet: TTabSheet;
WebBrowser: TWebBrowser;
AImageIndex: Integer;
begin
AImageIndex := 0;
try
TabSheet := pgcMultiWeb.Pages[TabIndex];
WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
if not AnsiSameText(WebBrowser.LocationURL, 'about:blank') then
begin
with cbxURLInputer.ItemsEx.Add do
begin
Caption := WebBrowser.LocationURL;
if (Copy(Caption, 1, 5) = 'file:') or (Copy(Caption, 2, 1) = ':') then
ImageIndex := 2
else if Copy(Caption, 1, 4) = 'ftp:' then
ImageIndex := 1
else
ImageIndex := 0;
AImageIndex := ImageIndex;
end;
cbxURLInputer.ItemIndex := cbxURLInputer.ItemsEx.Count - 1;
end;
except
end;
ImageIndex := AImageIndex;
end;
procedure TMainForm.TabSetNDMissionsChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
begin
PageControlNDMission.ActivePageIndex := TabSetNDMissions.TabIndex;
end;
procedure TMainForm.TabSetNDMissionsClick(Sender: TObject);
begin
PageControlNDMission.ActivePageIndex := TabSetNDMissions.TabIndex;
end;
procedure TMainForm.TimerForCheckDblClickTimer(Sender: TObject);
begin
TimerForCheckDblClick.Enabled := False;
SetForegroundWindow(TrueHiddenMainForm.Handle);
if RealICQClient.Logined and RealICQClient.Connected then
ppChangeStates.Popup(FCursorPosX, Screen.WorkAreaHeight)
else
ppTrayIcon.Popup(FCursorPosX, Screen.WorkAreaHeight);
end;
procedure TMainForm.TimerForCheckLogoutTimeoutTimer(Sender: TObject);
begin
TimerForCheckLogoutTimeout.Enabled := False;
RealICQClient.Logout;
SetUIState;
end;
procedure TMainForm.TrayIconClick(Sender: TObject);
begin
FCursorPosX := Mouse.CursorPos.X;
TimerForCheckDblClick.Interval := GetDoubleClickTime();
if not TimerForCheckDblClick.Enabled then
TimerForCheckDblClick.Enabled := True;
end;
procedure TMainForm.OpenNotReadMessage(iIndex: Integer);
var
nTeamID: string;
MessageID, SMSReceiver: string;
SystemMessage: TRealICQSystemMessage;
SMSForm: TSMSForm;
MessageList: TList;
NotReadMessage: TNotReadMessage;
begin
if (iIndex < 0) and (iIndex >= FNotReadMessages.Count) then
Exit;
if FNotReadMessages.Count = 0 then
actOpenMainForm.Execute
else
begin
MessageID := FNotReadMessages.Strings[iIndex];
if AnsiSameStr(Copy(MessageID, 1, Length(SMSMessageID)), SMSMessageID) then
begin
SMSReceiver := Copy(MessageID, Length(SMSMessageID) + 1, Length(MessageID) - Length(SMSMessageID));
// if SMSReceiver <> '' then
SMSForm := OpenSMSForm(SMSReceiver)
// else
// SMSForm := OpenSMSForm()
end
else if AnsiSameStr(Copy(MessageID, 1, Length(TeamMessageID)), TeamMessageID) then
begin
nTeamID := Copy(MessageID, Length(TeamMessageID) + 1, Length(MessageID) - Length(TeamMessageID));
OpenTeamTalkingForm(nTeamID);
end
else if AnsiSameStr(Copy(MessageID, 1, Length(SystemMessageID)), SystemMessageID) then
begin
try
SystemMessage := FNotReadMessages.Objects[iIndex] as TRealICQSystemMessage;
ShowSystemMessage(SystemMessage);
finally
FNotReadMessages.Delete(iIndex);
try
NotReadMessageBoxForm.ShowNotReadMessage;
NotReadMessageBoxForm.Height := 0;
NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
except
end;
end;
end
else
begin
MessageList := FNotReadMessages.Objects[iIndex] as TList;
NotReadMessage := MessageList[0];
OpenTalkingForm(MessageID, True, NotReadMessage.FRealICQClient);
end;
end;
end;
procedure TMainForm.TrayIconDblClick(Sender: TObject);
var
BaseTop, BaseLeft: Integer;
begin
TimerForCheckDblClick.Enabled := False;
OpenNotReadMessage(FNotReadMessages.Count - 1);
if FHidePosition <> hpNone then
begin
TimerForHideMainForm.Enabled := False;
FHidePosition := hpNone;
BaseTop := (Height - ClientHeight) div 4;
BaseLeft := (Width - ClientWidth) div 4;
Self.Top := 0;
Self.left := Screen.WorkAreaWidth - Width;
if not FAlwaysOnTop then
SetOnTop(Handle, False);
end;
end;
procedure TMainForm.TrayIconMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
iTimes: Integer;
ANeedShow: Boolean;
rcTray: TRect;
hwndTray: hWnd;
hwndChild: hWnd;
begin
try
if not Assigned(NotReadMessageBoxForm) then
Exit;
ANeedShow := (FNotReadMessages <> nil) and (FNotReadMessages.Count > 0) and (MainForm.RealICQClient.Connected) and (TimerForFlashTrayIcon.Enabled);
if not ANeedShow then
begin
if NotReadMessageBoxForm.Visible then
begin
NotReadMessageBoxForm.Visible := False;
NotReadMessageBoxForm.Timer1.Enabled := False;
end;
Exit;
end;
if (not NotReadMessageBoxForm.Visible) and (NotReadMessageBoxForm.Tag = 1) then
begin
//TrayIcon.Hint := '';
NotReadMessageBoxForm.Tag := 0;
hwndTray := FindWindow('Shell_TrayWnd', nil);
hwndChild := FindWindowEx(hwndTray, 0, 'TrayNotifyWnd', nil);
GetWindowRect(hwndChild, rcTray);
FTrayIconRect.Left := X - 20;
FTrayIconRect.Top := rcTray.Top;
FTrayIconRect.Right := FTrayIconRect.Left + 40;
FTrayIconRect.Bottom := rcTray.Bottom;
NotReadMessageBoxForm.ShowNotReadMessage;
NotReadMessageBoxForm.Height := 0;
NotReadMessageBoxForm.FRect := FTrayIconRect;
//NotReadMessageBoxForm.Left := X - NotReadMessageBoxForm.Width div 2;
NotReadMessageBoxForm.Left := Screen.WorkAreaWidth - NotReadMessageBoxForm.Width;
NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
NotReadMessageBoxForm.FRect.Left := NotReadMessageBoxForm.FRect.Left;
NotReadMessageBoxForm.FRect.Top := NotReadMessageBoxForm.Top;
NotReadMessageBoxForm.FRect.Right := NotReadMessageBoxForm.FRect.Right;
NotReadMessageBoxForm.FRect.Bottom := NotReadMessageBoxForm.FRect.Bottom;
NotReadMessageBoxForm.Visible := True;
NotReadMessageBoxForm.Timer1.Enabled := True;
end;
//MessageBoxForm.Visible := FNotReadMessages.Count > 0;
except
end;
end;
procedure TMainForm.TrayIconMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
//if AutoUpdateForm <> nil then Exit;
if Button = mbRight then
begin
SetForegroundWindow(TrueHiddenMainForm.Handle);
self.BringToFront;
ppTrayIcon.Popup(Mouse.CursorPos.X, Screen.WorkAreaHeight);
end;
end;
//------------------------------------------------------------------------------
{通讯录}
//------------------------------------------------------------------------------
procedure TMainForm.tsAddrBookShow(Sender: TObject);
begin
//
end;
//----保存联系人----------------------------------------------------- ---------
procedure TMainForm.SaveContacter(Name, Mobile, Tel, Email, Remark, BranchId: string);
var
MessageId, ParamValue: string;
begin
MessageId := IntToStr(GetTickCount);
CreateManageGroupMemberMessage('', Name, '', Mobile, Tel, Email, Remark, BranchId, MessageId);
//发送新增联系人消息
ParamValue := MessageId + #10 + '' + #10 + Name + #10 + Mobile + #10 + Tel + #10 + Email + #10 + Remark + #10 + '' + #10 + BranchId;
RealICQClient.SendAddrBookCommand(1, 1, ParamValue);
end;
//----修改备注名称--------------------------------------------------------------
procedure TMainForm.miSendTeamSMSClick(Sender: TObject);
var
iLoop: Integer;
ListItem: TRealICQContacterListItem;
RealICQTeam: TRealICQTeam;
begin
if not MainForm.RealICQClient.UserPermission.EnableMultiSendSms then
begin
ShowMessage('您没有短信群发权限！');
Exit;
end;
if FLVTeams.SelCount = 1 then
begin
for iLoop := 0 to FLVTeams.Items.Count - 1 do
begin
ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
RealICQTeam := ListItem.Data;
OpenTeamSMSForm(RealICQTeam.TeamID);
Break;
end;
end;
end;
end;
procedure TMainForm.miSetRemarkClick(Sender: TObject);
var
LoginName: string;
Remark, MessageId, ParamValue: string;
RealICQUser: TRealICQUser;
Employee: TRealICQEmployee;
RealICQContacterTreeView: TRealICQContacterTreeView;
ItemIndex: Integer;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Employee := RealICQContacterTreeView.GetSelectedEmployee;
LoginName := Employee.LoginName;
if LoginName <> '' then
begin
RealICQUser := GetAddrBookUser(Employee.BranchID, LoginName);
if RealICQUser = nil then
Exit;
Remark := RealICQUser.Remark;
Remark := Trim(ShowMyInputBox('修改备注名称', '新备注名称', RealICQUser.Remark, 50));
if not AnsiSameStr(Remark, RealICQUser.Remark) then//发送修改备注
begin
MessageId := IntToStr(GetTickCount);
CreateManageGroupMemberMessage(RealICQUser.LoginName, RealICQUser.DisplayName, RealICQUser.Remark, RealICQUser.Mobile, RealICQUser.Tel, RealICQUser.Email, Remark, Employee.BranchID, MessageId);
//发送修改联系人消息
RealICQUser.Remark := Remark;
LoginName := Employee.LoginName;
LoginName := Copy(LoginName, Pos('-', LoginName) + 1, Length(LoginName) - Pos('-', LoginName));
ParamValue := MessageId + #10 + LoginName + #10 + RealICQUser.DisplayName + #10 + RealICQUser.Mobile + #10 + RealICQUser.Tel + #10 + RealIcqUser.Email + #10 + RealICQUser.Watchword + #10 + Remark + #10 + Employee.BranchId;
MainForm.RealICQClient.SendAddrBookCommand(6, 1, ParamValue);
end;
end;
end;
procedure TMainForm.miAddGroupClick(Sender: TObject);
var
ItemIndex, iLoop: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
TmpBranch: TRealICQBranchInfo;
Branch: TRealICQBranch;
GroupName, ResultStr, SelBranchName: string;
ParamValue: string;
MessageId: string;
BranchNames, TmpList: TStringList;
Employee: TRealICQEmployee;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Branch := RealICQContacterTreeView.GetSelectedBranch;
if Branch = nil then
begin
Employee := RealICQContacterTreeView.GetSelectedEmployee;
if Employee <> nil then
Branch := Employee.Node.Parent.Data;
end;
if Branch <> nil then
SelBranchName := Branch.BranchName
else
SelBranchName := '我的通讯录';
BranchNames := TStringList.Create;
try
for iLoop := 0 to MainForm.RealICQClient.AddrBookGroups.Count - 1 do
begin
TmpBranch := MainForm.RealICQClient.AddrBookGroups.Objects[iLoop] as TRealICQBranchInfo;
GroupName := '';
GetParentGroupNameList(TmpBranch, GroupName);
BranchNames.AddObject(GroupName, TmpBranch);
if TmpBranch.ID = Branch.BranchID then
SelBranchName := GroupName;
end;
ResultStr := ShowAddrGroupInputBox('新建组', SelBranchName, BranchNames);
if ResultStr = '' then
exit;
TmpList := SplitString(ResultStr, #10);
GroupName := TmpList[1];
if BranchNames.IndexOf(TmpList[0] + GroupName + '\') >= 0 then
begin
ShowMessage('已存在相同名称的组！');
Exit;
end;
TmpBranch := BranchNames.Objects[BranchNames.IndexOf(TmpList[0])] as TRealICQBranchInfo;
//发送添加通讯录组消息
MessageId := IntToStr(GetTickCount);
CreateManageGroupMessage(TmpBranch.ID, GroupName, TmpBranch.ParentID, MessageId);
ParamValue := MessageId + #10 + GroupName + #10 + '0' + #10 + TmpBranch.ID + #10 + MainForm.RealICQClient.Me.LoginName;
MainForm.RealICQClient.SendAddrBookCommand(1, 0, ParamValue);
finally
BranchNames.Free;
end;
end;
procedure TMainForm.miUpdateGroupClick(Sender: TObject);
var
ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
Branch: TRealICQBranch;
GroupName, MessageId, ParamValue: string;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Branch := RealICQContacterTreeView.GetSelectedBranch;
if Branch <> nil then
begin
GroupName := Branch.BranchName;
if GroupName = '我的通讯录' then
begin
ShowMessage('默认组不允许修改！');
Exit;
end;
end
else
begin
ShowMessage('请选择要修改的组！');
Exit;
end;
GroupName := ShowMyInputBox('修改组', '组名称', GroupName, 500);
if (GroupName <> Branch.BranchName) and (GroupName <> '') then
begin
//发送修改通讯录组名消息
MessageId := IntToStr(GetTickCount);
CreateManageGroupMessage(Branch.BranchID, GroupName, Branch.ParentID, MessageId);
ParamValue := MessageId + #10 + GroupName + #10 + Branch.BranchID + #10 + Branch.ParentID + #10 + MainForm.RealICQClient.Me.LoginName;
MainForm.RealICQClient.SendAddrBookCommand(2, 0, ParamValue);
end;
end;
//-----删除通讯录组----------------------------------------------------
procedure TMainForm.miDelGroupClick(Sender: TObject);
var
ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
Branch: TRealICQBranch;
GroupId: string;
ParamValue: string;
MessageId: string;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Branch := RealICQContacterTreeView.GetSelectedBranch;
GroupId := '';
if Branch <> nil then
begin
if Branch.ParentID = '0' then
begin
ShowMessage('默认组不可以删除');
Exit;
end;
if MessageBox(Handle, '确定要将选中的组删除吗？', '确认删除', MB_OKCANCEL or MB_ICONQUESTION) <> IDOK then
Exit;
//发送删除通讯录组消息
MessageId := IntToStr(GetTickCount);
GetChildsGroupId(Branch.BranchID, GroupId);
CreateManageGroupMessage(GroupId, Branch.BranchName, Branch.ParentID, MessageId);
ParamValue := MessageId + #10 + GroupId + #10 + Branch.BranchID + #10 + Branch.ParentID + #10 + MainForm.RealICQClient.Me.LoginName;
MainForm.RealICQClient.SendAddrBookCommand(3, 0, ParamValue);
end
else
ShowMessage('请选择要删除的组！');
end;
//-----新增用户到通讯录---------------------------------------
procedure TMainForm.miAddGroupUserClick(Sender: TObject);
var
MessageId, ParamValue, BranchID: string;
Branch: TRealICQBranch;
TmpBranch: TRealICQBranchInfo;
Employee: TRealICQEmployee;
RealICQUser: TRealICQUser;
Node: TTreeNode;
ItemIndex, iLoop: Integer;
BranchNames: TStringList;
BranchName, GroupName: string;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
BranchName := '我的通讯录\';
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Branch := RealICQContacterTreeView.GetSelectedBranch;
if Branch = nil then
begin
Employee := RealICQContacterTreeView.GetSelectedEmployee;
if Employee <> nil then
begin
Node := Employee.Node.Parent;
Branch := Node.Data;
end;
end;
if Branch <> nil then
begin
if Branch.BranchName = '我的通讯录' then
begin
ShowMessage('默认组下面不允许添加联系人！');
Exit;
end;
BranchID := Branch.BranchID;
end;
if (GetGroupUserCount + 1) > MainForm.RealICQClient.UserPermission.AddrBookSize then
begin
ShowMessage('您的通讯录已满或者没有添加联系人的权限！' + #13 + '请联系系统管理员。');
Exit;
end;
BranchNames := TStringList.Create;
try
for iLoop := 0 to MainForm.RealICQClient.AddrBookGroups.Count - 1 do
begin
TmpBranch := MainForm.RealICQClient.AddrBookGroups.Objects[iLoop] as TRealICQBranchInfo;
GroupName := '';
GetParentGroupNameList(TmpBranch, GroupName);
if TmpBranch.ID = BranchID then
BranchNames.InsertObject(0, GroupName, TmpBranch)
else
BranchNames.AddObject(GroupName, TmpBranch);
end;
//弹出新增联系人窗体
RealICQUser := TRealICQUser.Create('', RealICQClient);
if not ShowAddrUserInputBox('新增联系人', RealICQUser, BranchNames) then
Exit;
if Trim(RealICQUser.Nickname) = '' then
Exit;
MessageId := IntToStr(GetTickCount);
CreateManageGroupMemberMessage('', RealICQUser.Nickname, RealICQUser.Remark, RealICQUser.Mobile, RealICQUser.Tel, RealICQUser.Email, RealICQUser.Remark1, BranchID, MessageId);
//发送新增联系人消息
ParamValue := MessageId + #10 + '' + #10 + RealICQUser.Nickname + #10 + RealICQUser.Mobile + #10 + RealICQUser.Tel + #10 + RealIcqUser.Email + #10 + RealICQUser.Remark1 + #10 + RealICQUser.Remark + #10 + BranchID;
RealICQClient.SendAddrBookCommand(1, 1, ParamValue);
finally
BranchNames.Free;
end;
end;
procedure TMainForm.miBusyClick(Sender: TObject);
begin
FLoginState := stBusy;
FLeaveMessage := '忙碌';
SetLoginStateControlState;
end;
procedure TMainForm.miUpdateGroupUserClick(Sender: TObject);
var
ItemIndex, iLoop: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
Employee: TRealICQEmployee;
BranchNames: TStringList;
Branch: TRealICQBranch;
RealICQUser: TRealICQUser;
LoginName: string;
ParamValue: string;
MessageId: string;
ParentNode: TTreeNode;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Employee := RealICQContacterTreeView.GetSelectedEmployee;
if Employee <> nil then
begin
//弹出修改窗体
BranchNames := TStringList.Create;
try
for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
begin
Branch := RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
if Branch.BranchID = Employee.BranchID then
BranchNames.Insert(0, Branch.BranchName)
else
BranchNames.Add(Branch.BranchName);
end;
ParentNode := Employee.Node.Parent;
Branch := ParentNode.Data;
RealICQUser := GetAddrBookUser(Employee.BranchID, Employee.LoginName);
if not ShowAddrUserInputBox('查看/编辑联系人', RealICQUser, BranchNames) then
Exit;
MessageId := IntToStr(GetTickCount);
CreateManageGroupMemberMessage(RealICQUser.LoginName, RealICQUser.DisplayName, RealICQUser.Remark, RealICQUser.Mobile, RealICQUser.Tel, RealICQUser.Email, RealICQUser.Remark1, Employee.BranchID, MessageId);
//发送修改联系人消息
LoginName := Employee.LoginName;
LoginName := Copy(LoginName, Pos('-', LoginName) + 1, Length(LoginName) - Pos('-', LoginName));
ParamValue := MessageId + #10 + LoginName + #10 + RealICQUser.Nickname + #10 + RealICQUser.Mobile + #10 + RealICQUser.Tel + #10 + RealIcqUser.Email + #10 + RealICQUser.Remark1 + #10 + RealICQUser.Remark + #10 + Employee.BranchId;
MainForm.RealICQClient.SendAddrBookCommand(2, 1, ParamValue);
finally
BranchNames.Free;
end;
end
else
ShowMessage('请选择要修改的联系人!');
end;
//----删除联系人-------------------------------------------------------------
procedure TMainForm.miDelGroupUserClick(Sender: TObject);
var
ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
Employee: TRealICQEmployee;
ParamValue: string;
MessageId, LoginName: string;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Employee := RealICQContacterTreeView.GetSelectedEmployee;
if Employee = nil then
begin
ShowMessage('请选择要删除的联系人');
Exit
end;
//发送删除通讯录组联系人消息
MessageId := IntToStr(GetTickCount);
CreateManageGroupMemberMessage(Employee.LoginName, Employee.DisplayName, '', Employee.Mobile, '', '', '', Employee.BranchID, MessageId);
LoginName := Employee.LoginName;
LoginName := Copy(LoginName, Pos('-', LoginName) + 1, Length(LoginName) - Pos('-', LoginName));
ParamValue := MessageId + #10 + LoginName + #10 + Employee.DisplayName + #10 + Employee.Mobile + #10 + '' + #10 + '' + #10 + '' + #10 + '' + #10 + Employee.BranchId;
MainForm.RealICQClient.SendAddrBookCommand(3, 1, ParamValue);
end;
procedure TMainForm.spbExportGroupUserClick(Sender: TObject);
var
ItemIndex, iLoop, jLoop, IIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
Branch: TRealICQBranch;
RealICQUser: TRealICQUser;
BranchInfo: TRealICQBranchInfo;
GroupId: string;
begin
SD.Title := '导出通讯录另存为';
SD.Filter := 'CSV(*.csv)|*.csv';
CsvLines := TStringList.Create;
CommaStr := TStringList.Create;
CommaStr.CommaText := '姓名 手机 电话 电子邮箱 备注';
CsvLines.Add(CommaStr.CommaText);
MainForm.RealICQClient.OnGettedAddrBookUsers := GettedAddrBookUsers1;
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
if (ItemIndex < 0) then
Exit;
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Branch := RealICQContacterTreeView.GetSelectedBranch;
if Branch = nil then
begin
ShowMessage('请在通讯录中选择组！');
Exit;
end;
if Branch.BranchName = '我的通讯录' then
begin
ShowMessage('默认组下面不允许导出联系人！');
Exit;
end;
SD.FileName := Branch.BranchName + '.csv';
GetChildsGroupId(Branch.BranchID, GroupId);
MainForm.RealICQClient.ExAddrBookUsers.Clear;
while Pos(',', GroupId) > 0 do
begin
IIndex := Pos(',', GroupId);
MainForm.RealICQClient.SendGetAddrbookUser(Copy(GroupId, 1, IIndex - 1));
sleep(200);
Delete(GroupId, 1, IIndex);
end;
MainForm.RealICQClient.SendGetAddrbookUser(GroupId);
if SD.Execute then
begin
CsvLines.SaveToFile(SD.FileName);
end;
CsvLines.Free;
CommaStr.Free;
end;
procedure TMainForm.GettedAddrBookUsers1(Sender: TObject);
var
iLoop: integer;
RealICQUser: TRealICQUser;
BranchInfo: TRealICQBranchInfo;
begin
for iLoop := MainForm.RealICQClient.ExAddrBookUsers.Count - 1 downto 0 do
begin
RealICQUser := MainForm.RealICQClient.ExAddrBookUsers.Objects[iLoop] as TRealICQUser;
CommaStr.CommaText := AnsiRePlaceStr(RealICQUser.DisplayName, ' ', '') + ',' + RealICQUser.Mobile + ',' + RealICQUser.Tel + ',' + RealICQUser.Email + ',' + RealICQUser.Remark1;
CsvLines.Add(CommaStr.CommaText);
end;
MainForm.RealICQClient.ExAddrBookUsers.Clear;
end;
//-----导入联系人---------------------------------
procedure TMainForm.spbImportGroupUserClick(Sender: TObject);
var
ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
Branch: TRealICQBranch;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
if (ItemIndex < 0) then
Exit;
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Branch := RealICQContacterTreeView.GetSelectedBranch;
if Branch = nil then
begin
ShowMessage('请在通讯录中选择组！');
Exit;
end;
if ImportGuideFrom = nil then
ImportGuideFrom := TImportGuideFrom.Create(self);
ImportGuideFrom.SelBranch := Branch;
ImportGuideFrom.Show;
ForceForeGroundWindow(ImportGuideFrom.Handle);
end;
//-------------得到指定通讯录组的所有子节点ID-----------------------------------
procedure TMainForm.GetChildsGroupId(GroupId: string; var Groups: string);
var
iLoop: Integer;
BranchInfo: TRealICQBranchInfo;
begin
if Groups <> '' then
Groups := Groups + ',';
Groups := Groups + GroupId;
for iLoop := 0 to MainForm.RealICQClient.AddrBookGroups.Count - 1 do
begin
BranchInfo := MainForm.RealICQClient.AddrBookGroups.Objects[iLoop] as TRealICQBranchInfo;
if BranchInfo.ParentID = GroupId then
GetChildsGroupId(BranchInfo.ID, Groups);
end;
end;
procedure TMainForm.miCutClick(Sender: TObject);
var
ItemIndex: Integer;
Employee: TRealICQEmployee;
Branch: TRealICQBranch;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
if FCutNode <> nil then
begin
if FCutNode.StateIndex = 0 then
begin
Branch := FCutNode.Data;
Branch.IsCutState := False;
Branch.Update;
end
else
begin
Employee := FCutNode.Data;
Employee.IsCutState := False;
Employee.Update;
end;
end;
Employee := RealICQContacterTreeView.GetSelectedEmployee;
if Employee <> nil then
begin
Employee.IsCutState := True;
Employee.Update;
FCutNode := Employee.Node;
Exit;
end;
Branch := RealICQContacterTreeView.GetSelectedBranch;
if Branch <> nil then
begin
if Branch.BranchName = '我的通讯录' then
begin
ShowMessage('默认组不允许剪切！');
Exit;
end;
Branch.IsCutState := True;
Branch.Update;
FCutNode := Branch.Node;
end;
end;
//---粘贴-----------------------------------------------------------------------
procedure TMainForm.miPasteClick(Sender: TObject);
var
ItemIndex, EmployeeCount, iLoop: Integer;
MessageId, ParamValue, LoginName: string;
Employee, TmpEmployee: TRealICQEmployee;
SelBranch, TmpBranch, Branch: TRealICQBranch;
RealICQContacterTreeView: TRealICQContacterTreeView;
ParentNode: TTreeNode;
RealICQUser: TRealICQUser;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Employee := RealICQContacterTreeView.GetSelectedEmployee;
if Employee <> nil then
begin
ItemIndex := RealICQContacterTreeView.BranchItems.IndexOf(Employee.BranchID);
SelBranch := RealICQContacterTreeView.BranchItems.Objects[ItemIndex] as TRealICQBranch;
end
else
SelBranch := RealICQContacterTreeView.GetSelectedBranch;
if SelBranch = nil then
Exit;
if FCutNode.StateIndex = 0 then
begin
TmpBranch := FCutNode.Data;
//判断同一级别是否存在相同的部门
for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
begin
Branch := RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
if (Branch.ParentID = SelBranch.BranchID) and (Branch.BranchName = TmpBranch.BranchName) then
begin
ShowMessage('已存在名称相同的组！');
TmpBranch.IsCutState := False;
TmpBranch.Update;
FCutNode := nil;
Exit;
end;
end;
ParentNode := TmpBranch.Node.Parent;
TmpBranch.Node.MoveTo(SelBranch.Node, naAddChild);
TmpBranch.ParentID := SelBranch.BranchID;
TmpBranch.Node.Selected := True;
TmpBranch.IsCutState := False;
TmpBranch.Update;
MessageId := IntToStr(GetTickCount);
CreateManageGroupMessage(TmpBranch.BranchID, TmpBranch.BranchName, SelBranch.BranchID, MessageId);
//发送修改组的父级ID
ParamValue := MessageId + #10 + TmpBranch.BranchName + #10 + TmpBranch.BranchID + #10 + SelBranch.BranchID + #10 + MainForm.RealICQClient.Me.LoginName;
MainForm.RealICQClient.SendAddrBookCommand(4, 0, ParamValue);
EmployeeCount := TmpBranch.EmployeeCount;
while ParentNode <> nil do
begin
TmpBranch := ParentNode.Data;
TmpBranch.EmployeeCount := TmpBranch.EmployeeCount - EmployeeCount;
TmpBranch.Update;
ParentNode := TmpBranch.Node.Parent;
end;
ParentNode := SelBranch.Node;
while ParentNode <> nil do
begin
TmpBranch := ParentNode.Data;
TmpBranch.EmployeeCount := TmpBranch.EmployeeCount + EmployeeCount;
TmpBranch.Update;
ParentNode := TmpBranch.Node.Parent;
end;
end
else
begin
TmpEmployee := FCutNode.Data;
if GetAddrBookUserIndex(SelBranch.BranchID, TmpEmployee.LoginName) >= 0 then
begin
ShowMessage('已存在名称相同的联系人！');
TmpEmployee.IsCutState := False;
TmpEmployee.Update;
FCutNode := nil;
Exit;
end;
MessageId := IntToStr(GetTickCount);
CreateManageGroupMemberMessage(TmpEmployee.LoginName, TmpEmployee.DisplayName, '', TmpEmployee.Mobile, TmpEmployee.Tel, TmpEmployee.EmailHint, '', SelBranch.BranchID, MessageId);
//发送修改联系人所属组消息
LoginName := TmpEmployee.LoginName;
LoginName := Copy(LoginName, Pos('-', LoginName) + 1, Length(LoginName) - Pos('-', LoginName));
ParamValue := MessageId + #10 + LoginName + #10 + TmpEmployee.DisplayName + #10 + TmpEmployee.Mobile + #10 + '' + #10 + '' + #10 + TmpEmployee.BranchID + #10 + '' + #10 + SelBranch.BranchId;
MainForm.RealICQClient.SendAddrBookCommand(5, 1, ParamValue);
end;
end;
//----得到父级的所有组名称---------------------------------------------
procedure TMainForm.GetParentGroupNameList(BranchInfo: TRealICQBranchInfo; var Groups: string);
var
iLoop: Integer;
TmpBranchInfo: TRealICQBranchInfo;
begin
Groups := BranchInfo.BranchName + '\' + Groups;
for iLoop := 0 to MainForm.RealICQClient.AddrBookGroups.Count - 1 do
begin
TmpBranchInfo := MainForm.RealICQClient.AddrBookGroups.Objects[iLoop] as TRealICQBranchInfo;
if BranchInfo.ParentID = TmpBranchInfo.ID then
GetParentGroupNameList(TmpBranchInfo, Groups);
end;
end;
//----创建管理组消息
procedure TMainForm.CreateManageGroupMessage(GroupId, GroupName, ParentId, MessageId: string);
var
ManageGroupMessage: TManageGroupMessage;
begin
ManageGroupMessage := TManageGroupMessage.Create;
ManageGroupMessage.MessageId := MessageId;
ManageGroupMessage.FGroupID := GroupId;
ManageGroupMessage.FGroupName := GroupName;
ManageGroupMessage.FParentID := ParentId;
FManageGroupMsgList.AddObject(ManageGroupMessage.MessageId, ManageGroupMessage);
end;
//----创建管理联系人消息
procedure TMainForm.CreateManageGroupMemberMessage(ID, DisplayName, NickName, Mobile, Tel, Email, Remark, GroupId, MessageId: string);
var
ManageGroupMemberMessage: TManageGroupMemberMessage;
begin
ManageGroupMemberMessage := TManageGroupMemberMessage.Create;
ManageGroupMemberMessage.MessageId := MessageId;
ManageGroupMemberMessage.FID := Id;
ManageGroupMemberMessage.FDisplayName := DisplayName;
ManageGroupMemberMessage.FNickName := NickName;
ManageGroupMemberMessage.FMobile := Mobile;
ManageGroupMemberMessage.FTel := Tel;
ManageGroupMemberMessage.FEmail := Email;
ManageGroupMemberMessage.FRemark := Remark;
ManageGroupMemberMessage.FGroupId := GroupId;
FManageGroupMemberMsgList.AddObject(ManageGroupMemberMessage.MessageId, ManageGroupMemberMessage);
end;
//----------------------------------------------------------
procedure TMainForm.GettedManageAddrBookResult(Sender: TObject; OperatModal: Integer; OperatCommand: Integer; RetValue, MessageId: Cardinal);
var
Branch: TRealICQBranch;
RealICQBranch: TRealICQBranchInfo;
RealICQUser, TmpRealICQUser: TRealICQUser;
TreeViewIndex, ItemIndex, iLoop, i, jLoop: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
ManageGroupMessage: TManageGroupMessage;
ManageGroupMemberMsg: TManageGroupMemberMessage;
TmpList, TmpDelUsers: TStringList;
Employee, TmpEmployee: TRealICQEmployee;
ErrMsg, TmpUsers: string;
begin
try
TreeViewIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[TreeViewIndex] as TRealICQContacterTreeView;
if RetValue = -1 then
begin
case OperatCommand of
1:
ErrMsg := '新建';
2:
ErrMsg := '修改';
3:
ErrMsg := '删除';
4:
ErrMsg := '批量添加';
end;
if OperatModal = 0 then
begin
if OperatCommand = 4 then
ErrMsg := '粘贴';
ErrMsg := ErrMsg + '组失败';
end
else
begin
ErrMsg := ErrMsg + '联系人失败';
if OperatCommand = 5 then
ErrMsg := '粘贴联系人失败';
if OperatCommand = 6 then
ErrMsg := '修改联系人备注失败';
end;
ShowMessage(ErrMsg);
Exit;
end;
if OperatModal = 0 then //对组操作
begin
i := FManageGroupMsgList.IndexOf(IntToStr(MessageId));
ManageGroupMessage := FManageGroupMsgList.Objects[i] as TManageGroupMessage;
case OperatCommand of
1:
begin //增加组
Branch := TRealICQBranch.Create(ManageGroupMessage.FGroupName);
Branch.BranchID := IntToStr(RetValue);
Branch.ParentID := ManageGroupMessage.FGroupID;
RealICQBranch := TRealICQBranchInfo.Create;
RealICQBranch.ID := IntToStr(RetValue);
RealICQBranch.ParentID := ManageGroupMessage.FGroupID;
RealICQBranch.BranchName := ManageGroupMessage.FGroupName;
RealICQContacterTreeView.AddBranch(Branch);
MainForm.RealICQClient.AddrBookGroups.AddObject(RealICQBranch.ID, RealICQBranch);
Branch.Node.Selected := True;
end;
2:
begin //修改组
ItemIndex := RealICQContacterTreeView.BranchItems.IndexOf(ManageGroupMessage.FGroupID);
Branch := RealICQContacterTreeView.BranchItems.Objects[ItemIndex] as TRealICQBranch;
Branch.BranchName := ManageGroupMessage.FGroupName;
Branch.Update;
ItemIndex := MainForm.RealICQClient.AddrBookGroups.IndexOf(ManageGroupMessage.FGroupID);
RealICQBranch := MainForm.RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
RealICQBranch.BranchName := ManageGroupMessage.FGroupName;
end;
3:
begin //删除组
try
TmpList := SplitString(ManageGroupMessage.FGroupID, ',');
for iLoop := 0 to TmpList.Count - 1 do
begin
ItemIndex := MainForm.RealICQClient.AddrBookGroups.IndexOf(TmpList[iLoop]);
if ItemIndex >= 0 then
begin
MainForm.RealICQClient.AddrBookGroups.Delete(ItemIndex);
ItemIndex := GetGroupUsers(TmpList[iLoop]);
while ItemIndex >= 0 do
begin
MainForm.RealICQClient.AddrBookUsers.Delete(ItemIndex);
ItemIndex := GetGroupUsers(TmpList[iLoop]);
end;
end;
end;
RealICQContacterTreeView.Clear;
FreeAndNil(RealICQContacterTreeView);
MainForm.ContacterTreeViews.Delete(TreeViewIndex);
MainForm.AddContacterTreeView(ScrollBoxAddrBook, LVAddrBook);
LoadAddrBook(ManageGroupMessage.FParentId);
TreeViewIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[TreeViewIndex] as TRealICQContacterTreeView;
ItemIndex := RealICQContacterTreeView.BranchItems.IndexOf(ManageGroupMessage.FParentID);
Branch := RealICQContacterTreeView.BranchItems.Objects[ItemIndex] as TRealICQBranch;
while Branch.ParentID <> '0' do
begin
NodeGroupClick(nil, Branch);
Branch := Branch.Node.Parent.Data;
end;
finally
if TmpList <> nil then
TmpList.Free;
if TmpDelUsers <> nil then
TmpDelUsers.Free;
end;
end;
4:
begin //剪切粘贴
ItemIndex := MainForm.RealICQClient.AddrBookGroups.IndexOf(ManageGroupMessage.FGroupID);
RealICQBranch := MainForm.RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
RealICQBranch.ParentID := ManageGroupMessage.FParentID;
end;
end;
FManageGroupMsgList.Delete(i);
end
else //对联系人操作
begin
i := FManageGroupMemberMsgList.IndexOf(IntToStr(MessageId));
ManageGroupMemberMsg := FManageGroupMemberMsgList.Objects[i] as TManageGroupMemberMessage;
case OperatCommand of
1:
begin //新增联系人
ItemIndex := RealICQClient.AddrBookGroups.IndexOf(ManageGroupMemberMsg.FGroupId);
RealICQBranch := RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
RealICQBranch.EmployeeCount := RealICQBranch.EmployeeCount + 1;
//---------------------------------------------
RealICQUser := TRealICQUser.Create(IntToStr(RetValue), MainForm.RealICQClient);
RealICQUser.LoginName := IntToStr(RetValue);
RealICQUser.DisplayName := ManageGroupMemberMsg.FDisplayName;
RealICQUser.Remark := ManageGroupMemberMsg.FNickName;
RealICQUser.Mobile := ManageGroupMemberMsg.FMobile;
RealICQUser.BranchID := ManageGroupMemberMsg.FGroupId;
RealICQUser.Tel := ManageGroupMemberMsg.FTel;
RealICQUser.Email := ManageGroupMemberMsg.FEmail;
RealICQUser.Remark1 := ManageGroupMemberMsg.FRemark;
MainForm.RealICQClient.AddrBookUsers.AddObject(RealICQUser.LoginName, RealICQUser);
Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
Employee.BranchID := RealICQUser.BranchID;
Employee.DisplayName := RealICQUser.DisplayName;
Employee.Mobile := RealICQUser.Mobile;
Employee.HasSMS := (Length(RealICQUser.Mobile) > 0);
Employee.SMSHint := RealICQUser.Mobile;
Employee.HasEmail := False;
Employee.HasAddFriend := False;
RealICQContacterTreeView.AddEmployee(Employee);
Employee.Node.Selected := True;
end;
2:
begin //修改联系人
ItemIndex := GetAddrBookUserIndex(ManageGroupMemberMsg.FGroupId, ManageGroupMemberMsg.FId);
Employee := RealICQContacterTreeView.EmployeeItems.Objects[ItemIndex] as TRealICQEmployee;
Employee.DisplayName := ManageGroupMemberMsg.FDisplayName;
Employee.Mobile := ManageGroupMemberMsg.FMobile;
Employee.SMSHint := ManageGroupMemberMsg.FMobile;
Employee.HasSMS := (Length(ManageGroupMemberMsg.FMobile) > 0);
Employee.Update;
end;
3:
begin //删除联系人
ItemIndex := RealICQClient.AddrBookGroups.IndexOf(ManageGroupMemberMsg.FGroupId);
RealICQBranch := RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
RealICQBranch.EmployeeCount := RealICQBranch.EmployeeCount - 1;
ItemIndex := GetAddrBookUserIndex(ManageGroupMemberMsg.FGroupId, ManageGroupMemberMsg.FId);
if ItemIndex >= 0 then
begin
RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
RealICQUser := GetAddrBookUser(ManageGroupMemberMsg.FGroupId, ManageGroupMemberMsg.FId);
RealICQClient.AddrBookUsers.Delete(RealICQClient.AddrBookUsers.IndexOfObject(RealICQUser));
end;
end;
4:
begin //批量添加联系人
TmpList := SplitString(ManageGroupMemberMsg.FId, ',');
ItemIndex := RealICQClient.AddrBookGroups.IndexOf(ManageGroupMemberMsg.FGroupId);
RealICQBranch := RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
RealICQBranch.IsGetUserList := True;
RealICQBranch.EmployeeCount := RealICQBranch.EmployeeCount + TmpList.Count;
for iLoop := 0 to TmpList.Count - 1 do
begin
if GetAddrBookUser(ManageGroupMemberMsg.FGroupId, TmpList[iLoop]) = nil then
begin
ItemIndex := MainForm.RealICQClient.MoreUsers.IndexOf(TmpList[iLoop]);
if ItemIndex >= 0 then
RealICQUser := MainForm.RealICQClient.MoreUsers.Objects[ItemIndex] as TRealICQUser
else
begin
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(TmpList[iLoop]);
end;
Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
Employee.BranchID := ManageGroupMemberMsg.FGroupId;
Employee.DisplayName := RealICQUser.DisplayName;
Employee.Mobile := RealICQUser.Mobile;
Employee.HasSMS := (Length(RealICQUser.Mobile) > 0);
Employee.EmailHint := RealICQUser.Email;
Employee.SMSHint := RealICQUser.Mobile;
Employee.HasEmail := False;
Employee.HasAddFriend := False;
RealICQContacterTreeView.AddEmployee(Employee);
Employee.Node.Selected := True;
end;
end;
for iLoop := TmpList.Count - 1 downto 0 do
begin
ItemIndex := MainForm.RealICQClient.MoreUsers.IndexOf(TmpList[iLoop]);
if ItemIndex >= 0 then
RealICQUser := MainForm.RealICQClient.MoreUsers.Objects[ItemIndex] as TRealICQUser
else
begin
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(TmpList[iLoop]);
end;
TmpRealICQUser := MainForm.RealICQClient.MoreUsers.Objects[ItemIndex] as TRealICQUser;
RealICQUser := TRealICQUser.Create(TmpList[iLoop], RealICQClient);
RealICQUser.LoginName := TmpRealICQUser.LoginName;
RealICQUser.DisplayName := TmpRealICQUser.DisplayName;
RealICQUser.Mobile := TmpRealICQUser.Mobile;
RealICQUser.BranchID := ManageGroupMemberMsg.FGroupId;
RealICQUser.Tel := TmpRealICQUser.Tel;
//RealICQUser.Email:=RealICQUser.EmailHint;
MainForm.RealICQClient.AddrBookUsers.AddObject(RealICQUser.LoginName, RealICQUser);
end;
end;
5:
begin
TmpEmployee := FCutNode.Data;
ItemIndex := RealICQClient.AddrBookGroups.IndexOf(ManageGroupMemberMsg.FGroupId);
RealICQBranch := RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
RealICQBranch.EmployeeCount := RealICQBranch.EmployeeCount + 1;
ItemIndex := RealICQClient.AddrBookGroups.IndexOf(TmpEmployee.BranchID);
RealICQBranch := RealICQClient.AddrBookGroups.Objects[ItemIndex] as TRealICQBranchInfo;
RealICQBranch.EmployeeCount := RealICQBranch.EmployeeCount - 1;
ItemIndex := GetAddrBookUserIndex(TmpEmployee.BranchID, TmpEmployee.LoginName);
Employee := TRealICQEmployee.Create(TmpEmployee.LoginName);
Employee.BranchID := ManageGroupMemberMsg.FGroupId;
Employee.DisplayName := TmpEmployee.DisplayName;
Employee.Tel := TmpEmployee.Tel;
Employee.Mobile := TmpEmployee.Mobile;
RealICQContacterTreeView.AddEmployee(Employee);
RealICQUser := GetAddrBookUser(TmpEmployee.BranchID, TmpEmployee.LoginName);
RealICQUser.BranchID := ManageGroupMemberMsg.FGroupId;
RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
Employee.Node.Selected := True;
end;
6:
begin
ItemIndex := GetAddrBookUserIndex(ManageGroupMemberMsg.FGroupId, ManageGroupMemberMsg.FId);
Employee := RealICQContacterTreeView.EmployeeItems.Objects[ItemIndex] as TRealICQEmployee;
if Employee <> nil then
begin
Employee.DisplayName := ManageGroupMemberMsg.FRemark;
Employee.Update;
end;
end;
end;
FManageGroupMemberMsgList.Delete(i);
end;
finally
if FCutNode <> nil then
FCutNode := nil;
end;
end;
//------得到联系人-----------------------------
function TMainForm.GetAddrBookUser(GroupId, LoginName: string): TRealICQUser;
var
iLoop: Integer;
RealICQUser: TRealICQUser;
begin
Result := nil;
for iLoop := 0 to MainForm.RealICQClient.AddrBookUsers.Count - 1 do
begin
RealICQUser := MainForm.RealICQClient.AddrBookUsers.Objects[iLoop] as TRealICQUser;
if (RealICQUser.BranchID = GroupId) and (RealICQUser.LoginName = LoginName) then
begin
Result := RealICQUser;
Break;
end;
end;
end;
//------得到联系人的下标------------------------------
function TMainForm.GetAddrBookUserIndex(GroupId, LoginName: string): Integer;
var
iLoop: Integer;
Employee: TRealICQEmployee;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
Result := -1;
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[MainForm.ContacterTreeViews.IndexOf(LVAddrBook)] as TRealICQContacterTreeView;
for iLoop := 0 to RealICQContacterTreeView.EmployeeItems.Count - 1 do
begin
Employee := RealICQContacterTreeView.EmployeeItems.Objects[iLoop] as TRealICQEmployee;
if (Employee.BranchID = GroupId) and (Employee.LoginName = LoginName) then
begin
Result := iLoop;
break;
end;
end;
end;
//-----得到联系人总的人数------------------
function TMainForm.GetGroupUserCount: Integer;
var
iLoop, ItemIndex: Integer;
TmpBranch: TRealICQBranch;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
if ItemIndex < 0 then
Exit;
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
begin
TmpBranch := RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
if TmpBranch.ParentID = '0' then
begin
Result := TmpBranch.EmployeeCount;
break;
end;
end;
end;
//---------------------------显示联系人------------------------------
procedure TMainForm.GettedAddrBookUsers(Sender: TObject);
var
iLoop, ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
RealICQUser: TRealICQUser;
TmpBranch: TRealICQBranch;
Employee: TRealICQEmployee;
ParentNode: TTreeNode;
BranchInfo: TRealICQBranchInfo;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
if ItemIndex < 0 then
Exit;
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.AdjustPosition := False;
RealICQContacterTreeView.HideSystemScrollBar;
RealICQContacterTreeView.BeginUpdate;
TmpBranch := nil;
ItemIndex := RealICQContacterTreeView.EmployeeItems.IndexOf('正在下载联系人');
if ItemIndex >= 0 then
begin
Employee := RealICQContacterTreeView.EmployeeItems.Objects[ItemIndex] as TRealICQEmployee;
TmpBranch := RealICQContacterTreeView.BranchItems.Objects[RealICQContacterTreeView.BranchItems.IndexOf(Employee.BranchID)] as TRealICQBranch;
RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
BranchInfo := RealICQClient.AddrBookGroups.Objects[RealICQClient.AddrBookGroups.IndexOf(TmpBranch.BranchID)] as TRealICQBranchInfo;
BranchInfo.IsGetUserList := True;
end;
{$region '添加联系人'}
for iLoop := MainForm.RealICQClient.AddrBookUsers.Count - 1 downto 0 do
begin
RealICQUser := MainForm.RealICQClient.AddrBookUsers.Objects[iLoop] as TRealICQUser;
if GetAddrBookUserIndex(RealICQUser.BranchID, RealICQUser.LoginName) >= 0 then
Continue;
if RealICQUser.BranchID <> TmpBranch.BranchID then
Continue;
Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
Employee.BranchID := RealICQUser.BranchID;
Employee.Mobile := RealICQUser.Mobile;
Employee.HasSMS := Length(RealICQUser.Mobile) > 0;
Employee.SMSHint := RealICQUser.Mobile;
Employee.HasEmail := False;
if Trim(RealICQUser.Remark) <> '' then
Employee.DisplayName := RealICQUser.Remark
else
Employee.DisplayName := RealICQUser.DisplayName;
Employee.HasAddFriend := False;
RealICQContacterTreeView.AddEmployee(Employee);
end;
{$endregion}
if TmpBranch <> nil then
begin
ParentNode := TmpBranch.Node;
while ParentNode <> nil do
begin
ParentNode.Expanded := True;
ParentNode := ParentNode.Parent;
end;
TmpBranch.Node.Selected := True;
TmpBranch.IsGetUserList := True;
end;
PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
RealICQContacterTreeView.MoveScrollBarToTop;
RealICQContacterTreeView.EndUpdate;
end;
//----------显示组-------------------------
procedure TMainForm.GettedAddrBookGroups(Sender: TObject);
begin
LoadAddrBook('0');
end;
//-------------------------------------------------------------------------
procedure TMainForm.LoadAddrBook(ExpandGroupId: string);
var
iLoop, ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
RealICQUser: TRealICQUser;
BranchInfo: TRealICQBranchInfo;
Branch, TmpBranch: TRealICQBranch;
Employee: TRealICQEmployee;
ParentNode: TTreeNode;
BranchId: string;
OnlineEmployee, EmployeeCount: Integer;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
if ItemIndex < 0 then
Exit;
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.OnItemOnline := nil;
RealICQContacterTreeView.OnItemOffline := nil;
RealICQContacterTreeView.OnItemIconButtonClick := nil;
RealICQContacterTreeView.OnItemMouseEnter := nil;
RealICQContacterTreeView.OnItemMouseLeave := nil;
RealICQContacterTreeView.ShowOnlineNumber := False;
RealICQContacterTreeView.ShowLoginState := False;
RealICQContacterTreeView.PopupMenu := ppAddrbookList;
RealICQContacterTreeView.AdjustPosition := False;
RealICQContacterTreeView.HideSystemScrollBar;
RealICQContacterTreeView.BeginUpdate;
TmpBranch := nil;
{$region '添加组'}
for iLoop := 0 to MainForm.RealICQClient.AddrBookGroups.Count - 1 do
begin
BranchInfo := MainForm.RealICQClient.AddrBookGroups.Objects[iLoop] as TRealICQBranchInfo;
if (RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)) >= 0 then
Continue;
Branch := TRealICQBranch.Create(BranchInfo.BranchName);
Branch.BranchID := BranchInfo.ID;
Branch.ParentID := BranchInfo.ParentID;
Branch.IsGetUserList := False;
OnlineEmployee := 0;
EmployeeCount := 0;
GetBranchEmpOnlineAndSum(RealICQClient.AddrBookGroups, BranchInfo, OnlineEmployee, EmployeeCount);
Branch.EmployeeCount := EmployeeCount;
Branch.OnlineEmployee := 0;
RealICQContacterTreeView.AddBranch(Branch);
if ExpandGroupId = '0' then
begin
BranchId := Branch.ParentID;
end
else
BranchId := Branch.BranchID;
if BranchId = ExpandGroupId then
begin
TmpBranch := Branch;
end;
end;
RealICQContacterTreeView.ReAlignBranchs;
{$endregion}
if TmpBranch <> nil then
begin
ParentNode := TmpBranch.Node;
while ParentNode <> nil do
begin
ParentNode.Expanded := True;
ParentNode := ParentNode.Parent;
end;
TmpBranch.Node.Selected := True;
end;
PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
RealICQContacterTreeView.MoveScrollBarToTop;
RealICQContacterTreeView.EndUpdate;
ScrollBoxAddrBook.Visible := True;
end;
//----------------------------------------------
procedure TMainForm.NodeGroupClick(Sender: TObject; Group: TRealICQBranch);
var
RealICQContacterTreeView: TRealICQContacterTreeView;
ItemIndex: Integer;
Employee: TRealICQEmployee;
BranchInfo: TRealICQBranchInfo;
begin
//-------获取指定部门下的用户------------------------------------------------
if (not Group.IsGetUserList) and (Group.Node.Parent <> nil) then
begin
MainForm.RealICQClient.OnGettedAddrBookUsers := GettedAddrBookUsers;
ItemIndex := FContacterTreeViews.IndexOf(LVAddrBook);
if ItemIndex < 0 then
exit;
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
if RealICQContacterTreeView.EmployeeItems.IndexOf('正在下载联系人') < 0 then
begin
RealICQContacterTreeView.ReCalculateEmployeeCount(Group);
BranchInfo := MainForm.RealICQClient.AddrBookGroups.Objects[MainForm.RealICQClient.AddrBookGroups.IndexOf(Group.BranchID)] as TRealICQBranchInfo;
Employee := TRealICQEmployee.Create('正在下载联系人');
Employee.BranchID := Group.BranchID;
RealICQContacterTreeView.AddEmployee(Employee);
if (BranchInfo.IsGetUserList) then
begin
GettedAddrBookUsers(nil);
end
else
begin
MainForm.RealICQClient.SendGetAddrbookUser(Group.BranchID);
end;
end;
Group.Node.Expanded := True;
end;
end;
//---------------------------------------------------------------------------
function TMainForm.GetGroupUsers(GroupId: string): Integer;
var
iLoop: Integer;
RealICQUser: TRealICQUser;
begin
Result := -1;
for iLoop := 0 to MainForm.RealICQClient.AddrBookUsers.Count - 1 do
begin
RealICQUser := MainForm.RealICQClient.AddrBookUsers.Objects[iLoop] as TRealICQUser;
if RealICQUser.BranchID = GroupId then
begin
Result := iLoop;
end;
end;
end;
{通讯录}
procedure TMainForm.tsCustomerServiceContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
begin
end;
//------------
procedure TMainForm.tsNetWorkDiskShow(Sender: TObject);
begin
if RealICQClient.NetWorkDiskServerPort <= 0 then
begin
lblNDState.Caption := '没有服务器';
end
else
begin
if (not RealICQNetWorkDiskClient.Connected) and (not RealICQNetWorkDiskClient.Connectting) then
begin
spbNDConnectClick(spbNDConnect);
end
else if not AnsiSameText(RealICQNetWorkDiskClient.LoginName, RealICQClient.LoginName) then
begin
RealICQNetWorkDiskClient.Logout;
spbNDConnectClick(spbNDConnect);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.WebBrowserAddrBookBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
begin
//
end;
procedure TMainForm.WebBrowserAddrBookDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
begin
//
end;
procedure TMainForm.WebBrowserForAdvertisementBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
begin
if not AnsiSameText(URL, MainForm.RealICQClient.MainFormAdversement.URL) then
begin
ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar('"' + string(URL) + '"'), '', SW_SHOWNORMAL);
Cancel := True;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.WebBrowserForAdvertisementDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
begin
try
WebBrowserForAdvertisement.OnDocumentComplete := nil;
WebBrowserForAdvertisement.OnBeforeNavigate2 := WebBrowserForAdvertisementBeforeNavigate2;
SetDomStyle(WebBrowserForAdvertisement.Document as IHtmlDocument2);
except
end;
pnlForHideWebBrowser.Visible := False;
pnlAdvertisement.Top := pnlWebSearch.Top - 1;
pnlAdvertisement.Height := RealICQClient.MainFormAdversement.Height + 2;
pnlWebSearch.Top := pnlAdvertisement.Top + pnlAdvertisement.Height + 1;
ClearMemory;
end;
//------------------------------------------------------------------------------
procedure TMainForm.WebBrowserForContactersBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
var
NewUrl: string;
Args: string;
ArgList: TStringList;
AForm: TForm;
index: Integer;
begin
NewUrl := URL;
if AnsiSameText(Copy(NewUrl, 1, 18), 'OpenTalkingForm://') then
begin
Cancel := True;
Args := Copy(NewUrl, 19, Length(NewUrl) - 19);
if AnsiSameText(Args, RealICQClient.Me.LoginName) then
begin
MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
Exit;
end;
OpenTalkingForm(Args, True);
Exit;
end;
if AnsiSameText(Copy(NewUrl, 1, 12), 'AddFriend://') then
begin
Cancel := True;
Args := Copy(NewUrl, 13, Length(NewUrl) - 13);
if AnsiSameText(Args, RealICQClient.Me.LoginName) then
begin
MessageBox(Handle, '对不起，不可以加自己为好友！', '提示', MB_ICONINFORMATION);
Exit;
end;
if TUsersService.GetUsersService.IsWorkmateOrFriend(Args) then
begin
MessageBox(Handle, PChar('用户 ' + Args + ' 已在您的好友列表中！'), '提示', MB_ICONINFORMATION);
Exit;
end;
ShowAddFriendWindow(Self, Args, '');
Exit;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ppLanguagesGetControlClass(Sender: TCustomActionBar; AnItem: TActionClient; var ControlClass: TCustomActionControlClass);
begin
ChangePPMenuColorMap(ppLanguages.PopupMenu);
end;
//------------------------------------------------------------------------------
procedure TMainForm.miLanguageClick(Sender: TObject);
var
MenuItem: TMenuItem;
begin
MenuItem := Sender as TMenuItem;
ChangeLanguage(ExtractFilePath(Application.ExeName) + 'Languages\' + AnsiReplaceStr(MenuItem.Caption, '&', '') + '.ini');
end;
procedure TMainForm.miLeaveClick(Sender: TObject);
begin
FLoginState := stLeave;
FLeaveMessage := '离开';
SetLoginStateControlState;
end;
procedure TMainForm.ppLanguagesPopup(Sender: TObject);
var
MenuItem: TMenuItem;
procedure FindLanguages(APath: string);
var
DSearchRec: TSearchRec;
FindResult: Integer;
begin
ppLanguages.Items.Clear;
FindResult := FindFirst(APath + '*.ini', faAnyFile, DSearchRec);
while FindResult = 0 do
begin
if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
if (DSearchRec.Attr and faDirectory) <> faDirectory then
begin
MenuItem := TMenuItem.Create(ppLanguages);
MenuItem.AutoHotkeys := maManual;
MenuItem.AutoLineReduction := maManual;
MenuItem.Caption := AnsiReplaceText(DSearchRec.Name, '.ini', '') + '&';
MenuItem.OnClick := miLanguageClick;
MenuItem.RadioItem := True;
MenuItem.AutoCheck := True;
MenuItem.Enabled := Language <> AnsiReplaceText(DSearchRec.Name, '.ini', '');
MenuItem.Checked := Language = AnsiReplaceText(DSearchRec.Name, '.ini', '');
ppLanguages.Items.Insert(0, MenuItem);
end;
FindResult := FindNext(DSearchRec);
end;
end;
begin
FindLanguages(ExtractFilePath(Application.ExeName) + 'Languages\');
end;
//------------------------------------------------------------------------------
procedure TMainForm.Post(stURL, stPostData: string; var wbWebBrowser: TWebBrowser);
var
vWebAddr, vPostData, vFlags, vFrame, vHeaders: OleVariant;
iLoop: Integer;
begin
{Are we posting data to this Url?}
if Length(stPostData) > 0 then
begin
{头信息当PostData使.}
vHeaders := 'Content-Type: application/x-www-form-urlencoded' + #10#13#0;
vPostData := VarArrayCreate([0, Length(stPostData)], varByte);
for iLoop := 0 to Length(stPostData) - 1 do
begin
vPostData[iLoop] := Ord(stPostData[iLoop + 1]);
end;
{结束字符}
vPostData[Length(stPostData)] := 0;
{Set the type of Variant, cast}
TVarData(vPostData).vType := varArray;
end;
vWebAddr := stURL;
wbWebBrowser.Navigate2(vWebAddr, vFlags, vFrame, vPostData, vHeaders);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ChangeLanguage(ALanguageIniFile: string);
var
IniFile: TIniFile;
iLoop: Integer;
OldLVAddrbook, OldLVSystemMessage, OldLVMyContacters, OldLVMoreUsers, OldLVFriends, OldLVStrangers, OldLVBlacklists, OldLVLatests, OldLVTeams, OldLVSearch: string;
begin
inherited ChangeLanguage(ALanguageIniFile);
RealICQClient.ChangeLanguage(ALanguageIniFile);
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'Languages\' + Language + '.ini');
try
{$region}
with IniFile do
begin
OldLVSystemMessage := LVSystemMessage;
OldLVMyContacters := LVMyContacters;
OldLVFriends := LVFriends;
OldLVStrangers := LVStrangers;
OldLVBlacklists := LVBlacklists;
OldLVLatests := LVLatests;
OldLVTeams := LVTeams;
OldLVSearch := LVSearch;
OldLVMoreUsers := LVMoreUsers;
OldLVAddrbook := LvAddrbook;
LVSystemMessage := FilterStr(ReadString(string(Self.ClassName), 'LVSystemMessage', ''));
LVMyContacters := FilterStr(ReadString(string(Self.ClassName), 'LVMyContacters', ''));
LVMoreUsers := FilterStr(ReadString(string(Self.ClassName), 'LVMoreUser', ''));
LVFriends := FilterStr(ReadString(string(Self.ClassName), 'LVFriends', ''));
LVStrangers := FilterStr(ReadString(string(Self.ClassName), 'LVStrangers', ''));
LVBlacklists := FilterStr(ReadString(string(Self.ClassName), 'LVBlacklists', ''));
LVLatests := FilterStr(ReadString(string(Self.ClassName), 'LVLatests', ''));
LVTeams := FilterStr(ReadString(string(Self.ClassName), 'LVTeams', ''));
LVSearch := FilterStr(ReadString(string(Self.ClassName), 'LVSearch', ''));
LVAddrbook := FilterStr(ReadString(string(Self.ClassName), 'LVAddrbook', ''));
end;
{$endregion}
finally
FreeAndNil(IniFile);
end;
edWebSearchKeyWordExit(nil);
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
if AnsiSameStr(OldLVSystemMessage, FContacterListViews.Strings[iLoop]) then
FContacterListViews.Strings[iLoop] := LVSystemMessage;
if AnsiSameStr(OldLVMyContacters, FContacterListViews.Strings[iLoop]) then
FContacterListViews.Strings[iLoop] := LVMyContacters;
if AnsiSameStr(OldLVFriends, FContacterListViews.Strings[iLoop]) then
FContacterListViews.Strings[iLoop] := LVFriends;
if AnsiSameStr(OldLVStrangers, FContacterListViews.Strings[iLoop]) then
FContacterListViews.Strings[iLoop] := LVStrangers;
if AnsiSameStr(OldLVAddrbook, FContacterListViews.Strings[iLoop]) then
FContacterListViews.Strings[iLoop] := LVAddrbook;
//if AnsiSameStr(OldLVBlacklists, FContacterListViews.Strings[iLoop]) then
// FContacterListViews.Strings[iLoop] := LVBlacklists;
if AnsiSameStr(OldLVLatests, FContacterListViews.Strings[iLoop]) then
FContacterListViews.Strings[iLoop] := LVLatests;
if AnsiSameStr(OldLVTeams, FContacterListViews.Strings[iLoop]) then
FContacterListViews.Strings[iLoop] := LVTeams;
if AnsiSameStr(OldLVSearch, FContacterListViews.Strings[iLoop]) then
FContacterListViews.Strings[iLoop] := LVSearch;
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
if AnsiSameStr(OldLVMyContacters, FContacterTreeViews.Strings[iLoop]) then
FContacterTreeViews.Strings[iLoop] := LVMyContacters;
if AnsiSameStr(OldLVFriends, FContacterTreeViews.Strings[iLoop]) then
FContacterTreeViews.Strings[iLoop] := LVFriends;
if AnsiSameStr(OldLVMoreUsers, FContacterTreeViews.Strings[iLoop]) then
FContacterTreeViews.Strings[iLoop] := LVMoreUsers;
if AnsiSameStr(OldLVAddrbook, FContacterTreeViews.Strings[iLoop]) then
FContacterTreeViews.Strings[iLoop] := LVAddrbook;
end;
if (RealICQClient.Logined and RealICQClient.Connected and pnlWorkArea.Visible) then
begin
ShowGroupInterface;
end;
edFilterKeyword.Text := '';
edFilterKeywordExit(edFilterKeyword);
SetUIState;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetLoginControlsVisible(Value: Boolean);
begin
lblLoginNameTitle.Visible := Value;
spLoginNameBorder.Visible := Value;
spbChangeLoginName.Visible := Value;
edLoginName.Visible := Value;
lblPasswordTitle.Visible := Value;
spPasswordBorder.Visible := Value;
edPassword.Visible := Value;
lblLoginStateTitle.Visible := Value;
spbLoginState.Visible := Value;
spbSavePassword.Visible := Value;
spbAutoLogin.Visible := Value;
//btnCALogin.Visible := RealICQClient.CaEnable and Value;
btLogin.Visible := Value;
lblRemoveMyLoginInfo.Visible := Value and RealICQClient.SavedPassword;
lblPasswordTitle.Enabled := not lblRemoveMyLoginInfo.Visible;
edPassword.Enabled := not lblRemoveMyLoginInfo.Visible;
//lblForgotPassword.Visible := Value;
lblNetworkConfig.Visible := Value;
//lblHelper.Visible := Value;
//lblNetworkConfig.Top:=Height-100;
//lblHelper.Top:=Height-80;
//lblRegister.Visible := Value;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientDisconnected(Sender: TObject);
begin
ScrollBoxMoreUser.Tag := 0;
try
if FSearchListViewInVisible then
spbCancelFilterClick(nil);
//ToDo
if pnlMiddleRight.Visible then
ShowOrHideMuiltiWeb;
if Assigned(AGuideViewForm) then
FreeAndNil(AGuideViewForm);
finally
lblLoginState.Caption := '正在注销...';
SetLoginControlsVisible(False);
pnlWorkArea.Visible := False;
pnlLogout.Visible := True;
//WebBrowserForEMail.Navigate('http://mail.lishui.gov.cn/web_email/modules/i_logout.phtml');
TimerForCheckLogoutTimeout.Enabled := True;
TimerForGetBranchOnlineStates.Enabled := False;
pnlForTopMessage.Visible := False;
TimerForShowSystemNotices.Enabled := pnlForTopMessage.Visible;
{ TODO -olqq -c : 退出时，重置Log的登录名 2014/12/14 10:59:28 }
LoggerImport.LoginName := '';
TTeamsAdapter.Stop;
TMessagesHander.GetHander.Uninstall;
TMainFormController.GetController.LogoutFromAppCentre;
FDBHistory.DBFileName := '';
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetUIState;
var
iLoop: Integer;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterTreeView: TRealICQContacterTreeView;
RealICQFriendTreeView: TRealICQContacterTreeView;
GroupMembers: TStringList;
TabSheet: TTabSheet;
SystemMessage: TRealICQSystemMessage;
NotReadMessageObject: TObject;
MessageList: TList;
Employee: TRealICQEmployee;
RealICQUser: TRealICQUser;
VisibleValue: Boolean;
iIndex: Integer;
GroupName, MessageID: string;
SysMsgInterface: TSysMsgInterface;
begin
if OptionsForm <> nil then
OptionsForm.GetSets;
{$region '根据状态显示登录界面上的按钮等界面元素的内容和行为'}
TimerForLogining.Enabled := RealICQClient.Logining;
if True then
edLoginName.Text := RealICQClient.InputLoginName;
if RealICQClient.Logining then
begin
actLoginAs.Enabled := False;
lblLoginState.Caption := '正在登录...';
lblLoginState.Refresh;
SetLoginControlsVisible(False);
btLogin.Enabled := True;
btLogin.Visible := True;
btLogin.Caption := '取消(&C)';
btLogin.Refresh;
Application.ProcessMessages;
end
else if RealICQClient.SavedPassword and (not RealICQClient.Logined) then
begin
edPassword.Text := '保存的密码';
lblPasswordTitle.Enabled := False;
edPassword.Enabled := False;
FLoginAsSavePassword := True;
actLoginAs.Enabled := (not RealICQClient.Logined or not RealICQClient.Connected) and (not RealICQClient.Logining);
actLoginAs.Caption := '作为 ' + RealICQClient.LoginName + ' 登录(&S)';
btLogin.Enabled := True;
btLogin.Visible := True;
btLogin.Caption := '登录(&S)';
btLogin.Refresh;
lblLoginState.Caption := '';
SetLoginControlsVisible(True);
end
else if (not RealICQClient.Logined) then
begin
edPassword.Text := '';
lblPasswordTitle.Enabled := True;
edPassword.Enabled := True;
FLoginAsSavePassword := False;
actLoginAs.Enabled := False;
actLoginAs.Caption := '作为 ... 登录(&S)';
btLogin.Enabled := True;
btLogin.Visible := True;
btLogin.Caption := '登录(&S)';
btLogin.Refresh;
lblLoginState.Caption := '';
SetLoginControlsVisible(True);
end;
{$endregion}
{$region '设置控件的Enabled属性'}
actReg.Enabled := (not RealICQClient.Logining) and (not RealICQClient.Reging);
actOptions.Enabled := (not RealICQClient.Logining) and (not RealICQClient.Reging);
actConnectSet.Enabled := actOptions.Enabled;
actLogout.Enabled := (not (not RealICQClient.Logined or not RealICQClient.Connected) and (not RealICQClient.Logining) and (not RealICQClient.Reging)) and RealICQClient.Connected;
actOpenRecvFileDir.Enabled := actLogout.Enabled;
btLogin.Default := not actLogout.Enabled;
actOnline.Enabled := actLogout.Enabled;
actHidden.Enabled := actLogout.Enabled;
actOffline.Enabled := actLogout.Enabled;
actBusy.Enabled := actLogout.Enabled;
actMute.Enabled := actLogout.Enabled;
actLeave.Enabled := actLogout.Enabled;
actPhone.Enabled := actLogout.Enabled;
actRepast.Enabled := actLogout.Enabled;
actMeeting.Enabled := actLogout.Enabled;
actOtherState.Enabled := actLogout.Enabled;
actOfflieAutoResponse.Enabled := actLogout.Enabled;
actPersonalSet.Enabled := actLogout.Enabled;
actChangePass.Enabled := actLogout.Enabled;
actFindUsers.Enabled := actLogout.Enabled;
actShowLoginName.Enabled := actLogout.Enabled;
actShowDisplayName.Enabled := actLogout.Enabled;
actShowAllName.Enabled := actLogout.Enabled;
actShowRemark.Enabled := actLogout.Enabled;
actShowBigHeadImage.Enabled := actLogout.Enabled;
actShowMiddleHeadImage.Enabled := actLogout.Enabled;
actShowSmallHeadImage.Enabled := actLogout.Enabled;
actShowNormalHeadImage.Enabled := actLogout.Enabled;
actShowGroup.Enabled := actLogout.Enabled;
actGroupManager.Enabled := actLogout.Enabled;
actShowStrangers.Enabled := actLogout.Enabled;
actShowBlacklists.Enabled := actLogout.Enabled;
actShowTeams.Enabled := actLogout.Enabled;
actShowLatests.Enabled := actLogout.Enabled;
actShowGIFInMailForm.Enabled := actLogout.Enabled;
actShowGIFInTalkingForm.Enabled := actLogout.Enabled;
actCustomFacesManager.Enabled := actLogout.Enabled;
actMsgManager.Enabled := actLogout.Enabled;
actAVSet.Enabled := actLogout.Enabled;
RealICQNetWorkDiskClientConnectStateChanged(Self.RealICQNetWorkDiskClient);
SetLoginStateMenuChecked;
SetStyleMenuChecked;
{$endregion}
{$region '设置控件的Visible属性'}
lblReConnect.Visible := False;
actLoginAs.Visible := actLoginAs.Enabled;
if (RealICQClient.WorkingMode = wmCorporation) then
begin
actShowBigHeadImage.Visible := False;
actShowMiddleHeadImage.Visible := False;
actShowStrangers.Visible := False;
actShowBlacklists.Visible := False;
actReg.Visible := False;
//actFindUsers.Visible := False;
actShowTree.Visible := False;
end
else
begin
actShowBigHeadImage.Visible := not actShowTree.Checked;
actShowMiddleHeadImage.Visible := not actShowTree.Checked;
actShowStrangers.Visible := True;
actShowBlacklists.Visible := True;
actReg.Visible := True;
//actFindUsers.Visible := True;
actShowTree.Visible := True;
end;
VisibleValue := RealICQClient.Logined and RealICQClient.Connected;
ActionManager.ActionBars.ActionBars[1].Items[1].Visible := VisibleValue;
ActionManager.ActionBars.ActionBars[1].Items[2].Visible := VisibleValue;
//spbShowHideRight.Visible := VisibleValue;
{$endregion}
{$region '根据登录/连接状态，显示登录界面或联系人界面'}
if RealICQClient.Logined and RealICQClient.Connected then
begin
pnlWorkArea.Visible := True;
pnlLogout.Visible := False;
SetAllTakingFormEnabledState(True);
SetAllSMSFormEnabledState(True);
if not TLimitCondition.UserInfoCheck(MainForm.RealICQClient.Me) then
begin
MainForm.actPersonalSetExecute(nil)
end
else if TLimitCondition.FirstLoginComfirm then
begin
ShowMessage('请确认或修改您的个人信息！');
MainForm.actPersonalSetExecute(nil);
end;
end
else
begin
pnlWorkArea.Visible := False;
pnlLogout.Visible := True;
tsCustomerService.PageControl := nil;
tsCustomers.PageControl := pgcMainWorkArea;
RealICQNetWorkDiskClient.Logout;
if VideoForm <> nil then
FreeAndNil(VideoForm);
if CreateTeamForm <> nil then
FreeAndNil(CreateTeamForm);
if SearchForm <> nil then
FreeAndNil(SearchForm);
if VCardForm <> nil then
FreeAndNil(VCardForm);
if SearchTeamForm <> nil then
FreeAndNil(SearchTeamForm);
if SelFaceForm <> nil then
FreeAndNil(SelFaceForm);
if CustomFacesManagerForm <> nil then
FreeAndNil(CustomFacesManagerForm);
if MessagesManagerForm <> nil then
FreeAndNil(MessagesManagerForm);
if AddFaceForm <> nil then
FreeAndNil(AddFaceForm);
try
CloseAllTeamOptionsForms;
except
end;
try
WebBrowserForAdvertisement.OnDocumentComplete := nil;
WebBrowserForAdvertisement.OnBeforeNavigate2 := nil;
pnlAdvertisement.Height := 0;
if WebBrowserForAdvertisement.Busy then
WebBrowserForAdvertisement.Stop;
WebBrowserForAdvertisement.Navigate('about:blank');
except
end;
try
// CloseAllSeeUserInformationForms;
except
end;
try
CloseAllChangeSystemMessageForms;
except
end;
try
SetAllTakingFormEnabledState(False);
SetAllSMSFormEnabledState(False);
except
end;
TimerForFlashTrayIcon.Enabled := False;
if Assigned(NotReadMessageBoxForm) then
NotReadMessageBoxForm.Visible := False;
TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Offline.ico');
TrayIcon.SetDefaultIcon;
TrayIcon.Hint := Application.Title + ' - 未登录';
{$region '删除WEB标签'}
try
for iLoop := 0 to FWebTabs.Count - 1 do
begin
TabSheet := FWebTabs[iLoop];
TabSheet.PageControl := nil;
FreeAndNil(TabSheet);
end;
except
end;
FWebTabs.Clear;
{$endregion}
{$region '删除未处理的系统消息'}
try
for iLoop := 0 to FSystemMessages.Count - 1 do
begin
SystemMessage := FSystemMessages[iLoop];
FreeAndNil(SystemMessage);
end;
except
end;
FSystemMessages.Clear;
{$endregion}
{$region '清除还未读的消息'}
for iLoop := 0 to FNotReadMessages.Count - 1 do
begin
MessageID := FNotReadMessages[iLoop];
if AnsiSameStr(Copy(MessageID, 1, Length(SystemMessageID)), SystemMessageID) then
begin
try
NotReadMessageObject := FNotReadMessages.Objects[iLoop];
FreeAndNil(NotReadMessageObject);
except
end;
end
else
begin
MessageList := FNotReadMessages.Objects[iLoop] as TList;
while MessageList.Count > 0 do
begin
try
NotReadMessageObject := TObject(MessageList[0]);
FreeAndNil(NotReadMessageObject);
except
end;
MessageList.Delete(0);
end;
FreeAndNil(MessageList);
end;
end;
FNotReadMessages.Clear;
{$endregion}
{try
for iLoop :=FNotAddedEmployeeList.Count-1 Downto 0 do
begin
try
RealICQUser:= FNotAddedEmployeeList.Objects[iLoop] as TRealICQUser;
if Assigned(RealICQUser) then FreeAndNil(RealICQUser);
except
end;
end;
finally
FNotAddedEmployeeList.Clear;
end; }
if FNotAddedEmployeeList.Count > 0 then
FNotAddedEmployeeList.Clear;
if Assigned(FLVSystemMessage) then
FLVSystemMessage.Items.Clear;
if Assigned(FLVTeams) then
FLVTeams.Items.Clear;
if Assigned(FLVCustomers) then
FLVCustomers.Items.Clear;
{$region '删除用于显示用户列表对象'}
for iLoop := FContacterListViews.Count - 1 downto 0 do
begin
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
try
RealICQContacterListView.Items.Clear;
except
end;
GroupName := FContacterListViews[iLoop];
if AnsiSameText(GroupName, LVFriends) or AnsiSameText(GroupName, LVStrangers) or
{AnsiSameText(GroupName, LVBlacklists) or}
(FGroups.IndexOf(GroupName) >= 0) then
begin
try
FreeAndNil(RealICQContacterListView);
except
end;
FContacterListViews.Delete(iLoop);
end;
end;
for iLoop := FContacterTreeViews.Count - 1 downto 0 do
begin
try
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
try
RealICQContacterTreeView.Clear;
except
end;
finally
try
FreeAndNil(RealICQContacterTreeView);
except
end;
FContacterTreeViews.Delete(iLoop);
end;
end;
for iLoop := FContacterTreeViews.Count - 1 downto 0 do
begin
try
RealICQFriendTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
try
RealICQFriendTreeView.Clear;
except
end;
finally
try
FreeAndNil(RealICQFriendTreeView);
except
end;
FContacterTreeViews.Delete(iLoop);
end;
end;
{$endregion}
for iLoop := 0 to RealICQClient.SysMsgInterfaces.Count - 1 do
begin
SysMsgInterface := RealICQClient.SysMsgInterfaces.Objects[iLoop] as TSysMsgInterface;
FreeAndNil(SysMsgInterface);
end;
RealICQClient.SysMsgInterfaces.Clear;
for iLoop := 0 to FGroups.Count - 1 do
begin
GroupMembers := FGroups.Objects[iLoop] as TStringList;
GroupMembers.Clear;
GroupMembers.Free;
end;
FGroups.Clear;
end;
{$endregion}
PostMessage(Handle, WM_SIZE, 0, 0);
Application.ProcessMessages;
if not TrayIcon.Visible then
begin
TrayIcon.Visible := True;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.AddMessageHistory(ASystemMessageType: TSystemMessageType; ASimpleMessage: string; ASystemMessage: TRealICQSystemMessage);
var
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
ID: string;
begin
ID := '';
case ASystemMessageType of
smSimple:
begin
ID := IntToStr(GetTickCount);
while FLVSystemMessage.Items.IndexOf(ID) >= 0 do
begin
ID := IntToStr(GetTickCount);
Sleep(10);
Application.ProcessMessages;
end;
end;
smSystemMessage:
ID := IntToStr(ASystemMessage.MessageID);
end;
FLVSystemMessage.ShowHeadImageButton := False;
ItemIndex := FLVSystemMessage.Items.Add(ID);
ListItem := FLVSystemMessage.Items.Objects[ItemIndex] as TRealICQContacterListItem;
with ListItem do
begin
DisplayName := TimeToStr(Now);
LoginState := stOnline;
case ASystemMessageType of
smSimple:
begin
Watchword := ASimpleMessage;
try
HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + SimpleMessagePicture);
except
end;
end;
smSystemMessage:
begin
Watchword := ASystemMessage.Title;
try
HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + SystemMessagePicture);
except
end;
end;
end;
ReDrawItem;
end;
FLVSystemMessage.TopIndex := ItemIndex;
end;
//------------------------------------------------------------------------------
constructor TMainForm.Create(AOwner: TComponent);
begin
MainForm := Self;
inherited Create(AOwner);
end;
//------------------------------------------------------------------------------
procedure TMainForm.FormCreate(Sender: TObject);
function URLDecode(const S: string): string;
var
Idx: Integer; // loops thru chars in string
Hex: string; // string of hex characters
Code: Integer; // hex character code (-1 on error)
begin
// Intialise result and string index
Result := '';
Idx := 1;
// Loop thru string decoding each character
while Idx <= Length(S) do
begin
case S[Idx] of
'%':
begin
// % should be followed by two hex digits - exception otherwise
if Idx <= Length(S) - 2 then
begin
// there are sufficient digits - try to decode hex digits
Hex := S[Idx + 1] + S[Idx + 2];
Code := SysUtils.StrToIntDef('$' + Hex, -1);
Inc(Idx, 2);
end
else
// insufficient digits - error
Code := -1;
// check for error and raise exception if found
if Code = -1 then
raise SysUtils.EConvertError.Create('Invalid hex digit in URL');
// decoded OK - add character to result
Result := Result + Chr(Code);
end;
'+':
// + is decoded as a space
Result := Result + ' ' else
// All other characters pass thru unchanged
Result := Result + S[Idx];
end;
Inc(Idx);
end;
end;
function UserIsLogined(user: string): Boolean;
var
hWndStart, hwndLike: HWND;
WndCaption: array[0..254] of char;
WndClassName: array[0..254] of char;
ActiveTimes: Integer;
begin
Result := False;
try
ActiveTimes := 0;
hWndStart := GetDesktopWindow;
hwndLike := GetWindow(hWndStart, GW_CHILD);
while hwndLike <> 0 do
begin
GetWindowText(hwndLike, @WndCaption, 254);
GetClassName(hwndLike, @WndClassName, 254);
if (pos(user, StrPas(WndCaption)) <> 0) and (pos('TrueHiddenMainForm', StrPas(WndClassName)) <> 0) then
begin
Result := True;
ShowWindow(hwndLike, SW_SHOW);
ForceForeGroundWindow(hwndLike);
Inc(ActiveTimes);
if ActiveTimes >= 2 then
Break;
end;
hwndLike := GetWindow(hwndLike, GW_HWNDNEXT);
end;
except
on E: Exception do
begin
Error(E.Message, 'TMainForm.UserIsLogined(' + user + ')');
end;
end;
end;
var
iIndex, i: Integer;
gif: TGIFImage;
ca: string;
IdHttp: TIdHTTP;
ResponeStr: string;
Sends: TStrings;
jo, ja: ISuperObject;
CALoginName, CAPassWord: string;
icon: TIcon; //cmg
begin
try
FServerInfoList := TStringList.Create;
TAuthority.SetDropFileAuthority;
TrayIcon.Visible := False;
if FileExists(ExtractFilePath(paramstr(0)) + LoginingGif) then
begin
gif := TGIFImage.Create;
try
gif.LoadFromFile(ExtractFilePath(paramstr(0)) + LoginingGif);
gif.Animate := True;
ImgLoadingMoreBranchs.Picture.Assign(gif);
finally
gif.Free;
end;
end;
//ImgLstForLogining.FileLoad(rtIcon, ExtractFilePath(paramstr(0)) + 'Images\State\TrayIcon\0.ico', $ff00ff);
//ImgLstForLogining.FileLoad(rtIcon, ExtractFilePath(paramstr(0)) + 'Images\State\TrayIcon\1.ico', $ff00ff);
//ImgLstForLogining.FileLoad(rtIcon, ExtractFilePath(paramstr(0)) + 'Images\State\TrayIcon\2.ico', $ff00ff);
//ImgLstForLogining.FileLoad(rtIcon, ExtractFilePath(paramstr(0)) + 'Images\State\TrayIcon\3.ico', $ff00ff);
//cmg
begin
Icon := Ticon.create;
try
Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\0.ico');
i := ImgLstForLogining.addicon(Icon);
Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\1.ico');
i := ImgLstForLogining.addicon(Icon);
Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\2.ico');
i := ImgLstForLogining.addicon(Icon);
Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\3.ico');
i := ImgLstForLogining.addicon(Icon);
finally
Icon.Free;
end;
end;
//注册自定义消息
CLOSEWINDOWS := RegisterWindowMessage('关闭窗口');
if FileExists(ExtractFilePath(Application.ExeName) + 'Images\Logo.gif') then
ImgLogo.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\Logo.gif');
if FileExists(ExtractFilePath(Application.ExeName) + 'Images\AppCode.png') then
ImgApp.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\AppCode.png');
LoadMainTabImage;
//LoadGroupConfig;(群组配置信息转移到CEF)
//FDownFile := TDownFile.Create;
//FDownFile.OnComplete := DownFileComplete;
//调用自动更新程序
FCheckedUpdate := True;
try
RegisterOleFile(ExtractFilePath(Application.ExeName) + IEContext_DLL_PACH, 1);
except
on E: Exception do
Error(E.Message, 'TMainForm.FormCreate-RegisterOleFile(IEContext.dll)');
end;
try
RegisterOleFile(ExtractFilePath(Application.ExeName) + ImageX2_DLL_PACH, 1);
except
on E: Exception do
Error(E.Message, 'TMainForm.FormCreate-RegisterOleFile(ImageX2.dll)');
end;
try
RegisterOleFile(ExtractFilePath(Application.ExeName) + AppCentreCom_DLL_PACH, 1);
except
on E: Exception do
Error(E.Message, 'TMainForm.FormCreate-RegisterOleFile(AppCentreCom.dll)');
end;
if HookID <> 0 then
UnHookWindowsHookEx(HookID);
HookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId());
MinButtonForClose := True;
FGettedTrayIconRect := False;
FMainFormHidden := False;
FWindowMoveing := False;
FHidePosition := hpNone;
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
Caption := Application.Title;
actOpenMainForm.Caption := '打开 ' + Application.Title + ' 主界面(&O)';
//btShowMiniPage.Visible := TCustomerConfig.GetConfig.ShowGuideViewBtn;
FIsLogout := False;
DoubleBuffered := True;
pnlTop.DoubleBuffered := True;
pnlClient.DoubleBuffered := True;
pnlWorkArea.DoubleBuffered := True;
pnlLogout.DoubleBuffered := True;
edFilterKeyword.DoubleBuffered := True;
pnlWebSearch.DoubleBuffered := True;
pnlWebSearchSplit.DoubleBuffered := True;
pnlTeams.DoubleBuffered := True;
pnlAll.DoubleBuffered := True;
edLoginName.DoubleBuffered := True;
edPassword.DoubleBuffered := True;
pnlNDToolBar.DoubleBuffered := True;
pnlNDStateBar.DoubleBuffered := True;
pnlNetWorkFiles.DoubleBuffered := True;
pnlMiddleClient.DoubleBuffered := True;
pgcMultiWeb.DoubleBuffered := True;
pnlToolBar.DoubleBuffered := True;
FHintWindow := TSingleBorderHintWindow.Create(Self);
FHintWindow.Visible := False;
FGetUsersTask := TStringList.Create;
//默认值
ActiveButtonTag := 1;
HotKeyID_ReadMessage := 0;
HotKeyID_CopyScreen := 0;
FShowGroup := False;
FFlashCaptionOnOnline := True;
FLVSelectedItemBorderColor := $00E9CAAD;
FLVSelectedItemBorderInnerColor := $00F7F7F7;
FLVSelectedItemBackColor := $00FEE9CE;
FLVHeadImageBorderColor := $00E9CAAD;
FLVHeadImageBackColor := clWhite;
FLVStyle := lsMiddleHeadImage;
FLVCaptionStyle := csDisplayName;
FShowTree := False;
LoadAutoUpdateConfigs;
LoadDefaultConfigs;
FFlashTrayIconIndex := 0;
FFlashTrayIconIndexAtLogining := 0;
FNotReadMessages := TStringList.Create;
FGroups := TStringList.Create;
FWebTabs := TList.Create;
FFaceList := TStringList.Create;
FTempFaceList := TStringList.Create;
FFaceCategory := TStringList.Create;
FInputFont := TFont.Create;
FContacterListViews := TStringList.Create;
FContacterTreeViews := TStringList.Create;
FContacterTreeViews := TStringList.Create;
FSystemMessages := TList.Create;
//TMainFormController.GetController.ChangeStyle;
try
FDBHistory := TRealICQDBHistory.Create;
except
//ShowMessage('数据库创建失败');
on E: Exception do
begin
ShowMessage('异常类名称:' + E.ClassName + #13#10 + '异常信息:' + E.Message);
end;
end;
FWebPanels := TStringList.Create;
FOfflineAutoResponseTexts := TStringList.Create;
FNotAddedEmployeeList := TStringList.Create;
FSystemNotices := TList.Create;
FToolBarButtonList := TStringList.Create;
FToolBarButtonIconList := TStringList.Create;
FManageGroupMsgList := TStringList.Create;
FManageGroupMemberMsgList := TStringList.Create;
FFriendInfo := TStringList.Create;
FLoginAsSavePassword := False;
FSavePassword := False;
FAutoLogin := False;
FLoginState := stOnline;
FLeaveMessage := '';
pnlMiddleClient.Align := alClient;
pnlMiddleRight.Align := alRight;
pnlAll.Constraints.MinWidth := pnlMiddleClient.Constraints.MinWidth;
pnlAll.Constraints.MaxWidth := pnlMiddleClient.Constraints.MaxWidth;
ChangeLanguage(ExtractFilePath(Application.ExeName) + 'Languages\简体中文.ini');
{$region '生成显示系统消息的ListView'}
AddContacterListView(pnlTemp, LVSystemMessage);
FLVSystemMessage := FContacterListViews.Objects[0] as TRealICQContacterListView;
FContacterListViews.Delete(0);
FLVSystemMessage.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + SystemMessagePicture);
FLVSystemMessage.Style := lsSmallHeadImage;
FLVSystemMessage.CaptionStyle := csDisplayName;
FLVSystemMessage.PopupMenu := nil;
FLVSystemMessage.OnItemOnline := nil;
FLVSystemMessage.OnItemOffline := nil;
FLVSystemMessage.OnItemMouseEnter := nil;
FLVSystemMessage.OnItemMouseLeave := nil;
FLVSystemMessage.OnItemIconButtonClick := nil;
FLVSystemMessage.OnItemIconButtonDblClick := nil;
FLVSystemMessage.ShowMobileButton := False;
FLVSystemMessage.ShowTelButton := False;
FLVSystemMessage.ShowEmailButton := False;
FLVSystemMessage.ShowSMSButton := False;
FLVSystemMessage.ShowCameraButton := False;
FLVSystemMessage.ShowHeadImageButton := False;
FLVSystemMessage.ShowHint := False;
FLVSystemMessage.SelectedItemBackgroud.Graphic := nil;
FLVSystemMessage.HeadImageBorderColor := clWhite;
FLVSystemMessage.SelectedItemBorderInnerColor := clWhite;
FLVSystemMessage.SelectedItemBackColor := clWhite;
{$endregion}
{$region '生成显示群组列表的ListView'}
AddContacterListView(ScrollBoxTeam, LVTeams);
// navForContacters.Groups[3] := LVTeams;
FLVTeams := FContacterListViews.Objects[0] as TRealICQContacterListView;
FContacterListViews.Delete(0);
FLVTeams.AdjustPosition := False;
FLVTeams.LeavePicture := nil;
FLVTeams.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + TeamPicture);
FLVTeams.Style := lsSmallHeadImage;
FLVTeams.CaptionStyle := csDisplayName;
FLVTeams.PopupMenu := ppTeamListView;
FLVTeams.OnItemOnline := nil;
FLVTeams.OnItemOffline := nil;
FLVTeams.OnItemMouseEnter := nil;
FLVTeams.OnItemMouseLeave := nil;
FLVTeams.OnItemIconButtonClick := nil;
FLVTeams.OnItemIconButtonDblClick := nil;
FLVTeams.ShowMobileButton := False;
FLVTeams.ShowTelButton := False;
FLVTeams.ShowEmailButton := False;
FLVTeams.ShowSMSButton := False;
FLVTeams.ShowCameraButton := False;
FLVTeams.ShowHeadImageButton := False;
pnlTeams.Parent := ScrollBoxTeam;
pnlTeams.Align := alTop;
pnlTeams.ShowHint := False;
{$endregion}
{$region '生成显示网络硬盘文件的ListView'}
AddContacterListView(pnlNDFiles, '网络硬盘');
FLVNetWorkDisk := FContacterListViews.Objects[0] as TRealICQContacterListView;
FLVNetWorkDisk.Align := alClient;
FContacterListViews.Delete(0);
FLVNetWorkDisk.LeavePicture := nil;
FLVNetWorkDisk.SelectedItemBackgroud.Graphic := nil;
FLVNetWorkDisk.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchCollapsedBMP);
FLVNetWorkDisk.Style := lsSmallHeadImage;
FLVNetWorkDisk.CaptionStyle := csDisplayName;
FLVNetWorkDisk.PopupMenu := ppNetWorkFile;
FLVNetWorkDisk.HeadImageBorderColor := clWhite;
FLVNetWorkDisk.SelectedItemBorderInnerColor := clWhite;
FLVNetWorkDisk.SelectedItemBackColor := clWhite;
FLVNetWorkDisk.OnItemOnline := nil;
FLVNetWorkDisk.OnItemOffline := nil;
FLVNetWorkDisk.OnItemMouseEnter := nil;
FLVNetWorkDisk.OnItemMouseLeave := nil;
FLVNetWorkDisk.OnItemIconButtonClick := nil;
FLVNetWorkDisk.OnItemIconButtonDblClick := nil;
FLVNetWorkDisk.ShowMobileButton := False;
FLVNetWorkDisk.ShowTelButton := False;
FLVNetWorkDisk.ShowEmailButton := False;
FLVNetWorkDisk.ShowSMSButton := False;
FLVNetWorkDisk.ShowCameraButton := False;
FLVNetWorkDisk.ShowHeadImageButton := False;
FLVNetWorkDisk.AdjustPosition := True;
FLVNetWorkDisk.OnItemShowHint := ItemShowHint;
FLVNetWorkDisk.OnItemDoubleClick := NDItemDoubleClick;
FLVNetWorkDisk.OnSelectItemChanged := NDSelectItemChanged;
FLVNetWorkDisk.OnItemClick := NDSelectItemChanged;
FLVNetWorkDisk.OnItemMouseEnter := NDSelectItemChanged;
FLVNetWorkDisk.OnDropFiles := NDMissionDropFiles;
FLVNetWorkDisk.OnItemMouseDown := NDItemMouseDown;
DragAcceptFiles(FLVNetWorkDisk.Handle, True);
{$endregion}
{$region '生成显示网络硬盘上传文件任务列表的ListView'}
AddContacterListView(tsUploadingFiles, '硬盘上传文件');
FLVNetWorkDiskUploadingFiles := FContacterListViews.Objects[0] as TRealICQContacterListView;
FLVNetWorkDiskUploadingFiles.Align := alClient;
FContacterListViews.Delete(0);
FLVNetWorkDiskUploadingFiles.LeavePicture := nil;
FLVNetWorkDiskUploadingFiles.SelectedItemBackgroud.Graphic := nil;
FLVNetWorkDiskUploadingFiles.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchCollapsedBMP);
FLVNetWorkDiskUploadingFiles.Style := lsSmallHeadImage;
FLVNetWorkDiskUploadingFiles.CaptionStyle := csDisplayName;
FLVNetWorkDiskUploadingFiles.PopupMenu := ppNetWorkMisson;
FLVNetWorkDiskUploadingFiles.HeadImageBorderColor := clWhite;
FLVNetWorkDiskUploadingFiles.SelectedItemBorderInnerColor := clWhite;
FLVNetWorkDiskUploadingFiles.SelectedItemBackColor := clWhite;
FLVNetWorkDiskUploadingFiles.OnItemOnline := nil;
FLVNetWorkDiskUploadingFiles.OnItemOffline := nil;
FLVNetWorkDiskUploadingFiles.OnItemMouseEnter := nil;
FLVNetWorkDiskUploadingFiles.OnItemMouseLeave := nil;
FLVNetWorkDiskUploadingFiles.OnItemIconButtonClick := NDMissionItemIconButtonClick;
FLVNetWorkDiskUploadingFiles.OnItemIconButtonDblClick := nil;
FLVNetWorkDiskUploadingFiles.ShowMobileButton := False;
FLVNetWorkDiskUploadingFiles.ShowTelButton := False;
FLVNetWorkDiskUploadingFiles.ShowEmailButton := False;
FLVNetWorkDiskUploadingFiles.ShowSMSButton := False;
FLVNetWorkDiskUploadingFiles.ShowCameraButton := False;
FLVNetWorkDiskUploadingFiles.ShowHeadImageButton := False;
FLVNetWorkDiskUploadingFiles.AdjustPosition := False;
FLVNetWorkDiskUploadingFiles.OnItemShowHint := ItemShowHint;
FLVNetWorkDiskUploadingFiles.OnItemDoubleClick := nil;
FLVNetWorkDiskUploadingFiles.OnSelectItemChanged := nil;
FLVNetWorkDiskUploadingFiles.OnItemClick := nil;
FLVNetWorkDiskUploadingFiles.OnItemMouseEnter := nil;
FLVNetWorkDiskUploadingFiles.ShowSMSButton := True;
FLVNetWorkDiskUploadingFiles.SMSIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + CancelIcon);
{$endregion}
{$region '生成显示网络硬盘下载文件任务列表的ListView'}
AddContacterListView(tsDownloadingFiles, '硬盘下载文件');
FLVNetWorkDiskDownloadingFiles := FContacterListViews.Objects[0] as TRealICQContacterListView;
FLVNetWorkDiskDownloadingFiles.Align := alClient;
FContacterListViews.Delete(0);
FLVNetWorkDiskDownloadingFiles.LeavePicture := nil;
FLVNetWorkDiskDownloadingFiles.SelectedItemBackgroud.Graphic := nil;
FLVNetWorkDiskDownloadingFiles.DefaultPictureSmall.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchCollapsedBMP);
FLVNetWorkDiskDownloadingFiles.Style := lsSmallHeadImage;
FLVNetWorkDiskDownloadingFiles.CaptionStyle := csDisplayName;
FLVNetWorkDiskDownloadingFiles.PopupMenu := ppNetWorkMisson;
FLVNetWorkDiskDownloadingFiles.HeadImageBorderColor := clWhite;
FLVNetWorkDiskDownloadingFiles.SelectedItemBorderInnerColor := clWhite;
FLVNetWorkDiskDownloadingFiles.SelectedItemBackColor := clWhite;
FLVNetWorkDiskDownloadingFiles.OnItemOnline := nil;
FLVNetWorkDiskDownloadingFiles.OnItemOffline := nil;
FLVNetWorkDiskDownloadingFiles.OnItemMouseEnter := nil;
FLVNetWorkDiskDownloadingFiles.OnItemMouseLeave := nil;
FLVNetWorkDiskDownloadingFiles.OnItemIconButtonClick := NDMissionItemIconButtonClick;
FLVNetWorkDiskDownloadingFiles.OnItemIconButtonDblClick := nil;
FLVNetWorkDiskDownloadingFiles.ShowMobileButton := False;
FLVNetWorkDiskDownloadingFiles.ShowTelButton := False;
FLVNetWorkDiskDownloadingFiles.ShowEmailButton := False;
FLVNetWorkDiskDownloadingFiles.ShowSMSButton := False;
FLVNetWorkDiskDownloadingFiles.ShowCameraButton := False;
FLVNetWorkDiskDownloadingFiles.ShowHeadImageButton := False;
FLVNetWorkDiskDownloadingFiles.AdjustPosition := False;
FLVNetWorkDiskDownloadingFiles.OnItemShowHint := ItemShowHint;
FLVNetWorkDiskDownloadingFiles.OnItemDoubleClick := nil;
FLVNetWorkDiskDownloadingFiles.OnSelectItemChanged := nil;
FLVNetWorkDiskDownloadingFiles.OnItemClick := nil;
FLVNetWorkDiskDownloadingFiles.OnItemMouseEnter := nil;
FLVNetWorkDiskDownloadingFiles.ShowSMSButton := True;
FLVNetWorkDiskDownloadingFiles.SMSIcon.LoadFromFile(ExtractFilePath(Application.ExeName) + CancelIcon);
{$endregion}
iIndex := AddContacterListView(tsCustomers, '客服人员');
FLVCustomers := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
FContacterListViews.Delete(iIndex);
FLVCustomers.AdjustPosition := False;
FLVCustomers.OnItemOnline := nil;
FLVCustomers.OnItemOffline := nil;
FLVCustomers.Style := lsSmallHeadImage;
FLVCustomers.Parent := tsCustomers;
FLVCustomers.OnHeadImageMouseEnter := ItemOnHeadImageEnter;
FLVCustomers.OnHeadImageMouseLeave := ItemOnHeadImageLeave;
iIndex := AddContacterListView(ScrollBoxLatests, LVLatests);
FLVLatests := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
FLVLatests.AdjustPosition := False;
FLVLatests.OnItemOnline := nil;
FLVLatests.OnItemOffline := nil;
FLVLatests.Parent := ScrollBoxLatests;
FLVLatests.OnHeadImageMouseEnter := ItemOnHeadImageEnter;
FLVLatests.OnHeadImageMouseLeave := ItemOnHeadImageLeave;
iIndex := AddContacterListView(ScrollBoxSearchMoreUser, LVMoreUsers);
FSearchListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
FSearchListView.OnItemOnline := nil;
FSearchListView.OnItemOffline := nil;
FSearchListView.OnItemIconButtonClick := nil;
FSearchListView.OnHeadImageMouseEnter := ItemOnHeadImageEnter;
FSearchListView.OnHeadImageMouseLeave := ItemOnHeadImageLeave;
FSearchListView.ShowTelButton := False;
FSearchListView.ShowCameraButton := False;
FSearchListView.ShowEmailButton := False;
FSearchListView.AdjustPosition := False;
iIndex := AddContacterListView(ScrollBoxSearchUser, LVSearch);
FSearchListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
FSearchListView.OnItemOnline := nil;
FSearchListView.OnItemOffline := nil;
ChangeUIColor(UIMainColor);
PostMessage(Handle, WM_SIZE, 0, 0);
Application.ProcessMessages;
Sleep(200);
SetUIState;
AddWebBrowserToPageControl('about:blank', -2);
lblWeatherCity.Transparent := True;
lblWeather.Transparent := True;
lblWeatheren.Transparent := True;
//扩展标签开始
FToolBarButtonList.AddObject(LVMyContacters, MyContacters);
FToolBarButtonList.AddObject(LVMoreUsers, SysMsg);
FToolBarButtonList.AddObject(LVFriends, MyFriend);
FToolBarButtonList.AddObject(LvTeams, MyTeam);
FToolBarButtonList.AddObject(LvLatests, Latests);
FToolBarButtonIconList.AddObject(LVMyContacters, MyContactersIcon);
FToolBarButtonIconList.AddObject(LVMoreUsers, SysMsgIcon);
FToolBarButtonIconList.AddObject(LVFriends, MyFriendIcon);
FToolBarButtonIconList.AddObject(LvTeams, MyTeamIcon);
FToolBarButtonIconList.AddObject(LvLatests, LatestsIcon);
//扩展标签结束
//未读消息
NotReadMessageBoxForm := TNotReadMessageBoxForm.Create(Self);
NotReadMessageBoxForm.Left := -1000;
NotReadMessageBoxForm.Top := -1000;
NotReadMessageBoxForm.Show;
NotReadMessageBoxForm.Hide;
tsContactersShow(tsContacters);
if RealICQClient.CaEnable and (ParamStr(1) = 'wscc://sso') then
begin
ca := DecodeString(ParamStr(2));
ca := URLDecode(ca);
//ca := copy(ca,pos('ca=',ca)+3,length(ca));
Sends := TStringList.Create;
IdHttp := TIdHTTP.Create(nil);
try
ResponeStr := Idhttp.post('http://' + RealICQClient.CaServerAddress + ':' + inttostr(RealICQClient.CaPort) + '/api/Structure/LoginByCA?ca=' + ca, Sends);
ResponeStr := UTF8Decode(ResponeStr);
try
jo := SO(ResponeStr);
CALoginName := jo['data.loginName'].AsString;
CAPassWord := jo['data.password'].AsString;
except
end;
finally
Freeandnil(IdHttp);
Sends.Free;
end;
if not UserIsLogined(CALoginName) then
RealICQClient.Login(CALoginName, CAPassWord, FLoginState, FLeaveMessage, FSavePassword, False, True)
else
begin
try
Application.Terminate;
except
end;
end;
end
else
begin
FAutoLogin := RealICQClient.AutoLogin;
FSavePassword := RealICQClient.SavedPassword;
SetLoginStateControlState;
if RealICQClient.AutoLogin and (RealICQClient.SavedPassword or RealICQClient.CALogin) then
RealICQClient.LoginAsSaved;
end;
//调整大小解决右边框被覆盖问题
DisableAlign;
try
PostMessage(Handle, WM_SIZE, 0, 0);
Height := Height - 1;
Height := Height + 1;
finally
EnableAlign;
end;
tsCustomerService.PageControl := nil;
RealICQClient.OnGettedSysMsgInterfaces := RealICQClientGettedSysMsgInterfaces;
Application.ProcessMessages;
except
on E: Exception do
Error(E.Message, 'TMainForm.FormCreate');
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.FormDeactivate(Sender: TObject);
begin
if edWatchword.Visible then
edWatchwordExit(edWatchword);
//debug('FormDeactivate','TMainForm.FormDeactivate');
end;
//------------------------------------------------------------------------------
procedure TMainForm.FormDestroy(Sender: TObject);
begin
try
if RealICQClient.Connected then
RealICQClient.Logout;
if AThreadPool <> nil then
AThreadPool.TerminateAllYarns;
//FreeAndNil(FDownFile);
FHintWindow.ReleaseHandle;
FHintWindow.Free;
FGetUsersTask.Clear;
FreeAndNil(FGetUsersTask);
FServerInfoList.Clear;
FreeAndNil(FServerInfoList);
// FreeAndNil(FPCAMessage);
FreeAndNil(FOfflineAutoResponseTexts);
FNotAddedEmployeeList.Clear;
FreeAndNil(FNotAddedEmployeeList);
FSystemMessages.Clear;
FreeAndNil(FSystemMessages);
FToolBarButtonList.Clear;
FreeAndNil(FToolBarButtonList);
FToolBarButtonIconList.Clear;
FreeAndNil(FToolBarButtonIconList);
FNotReadMessages.Clear;
FreeAndNil(FNotReadMessages);
FContacterListViews.Clear;
FreeAndNil(FContacterListViews);
FContacterTreeViews.Clear;
FreeAndNil(FContacterTreeViews);
FWebTabs.Clear;
FreeAndNil(FWebTabs);
FGroups.Clear;
FreeAndNil(FGroups);
FFriendInfo.Clear;
FreeAndNil(FFriendInfo);
FManageGroupMsgList.Clear;
FreeAndNil(FManageGroupMsgList);
FManageGroupMemberMsgList.Clear;
FreeAndNil(FManageGroupMemberMsgList);
while FWebPanels.Count > 0 do
begin
try
FWebPanels.Objects[0].Free;
except
end;
FWebPanels.Delete(0);
end;
FWebPanels.Clear;
FreeAndNil(FWebPanels);
while FSystemNotices.Count > 0 do
begin
try
TSystemNotices(FSystemNotices[0]).Free;
except
end;
FSystemNotices.Delete(0);
end;
FSystemNotices.Clear;
FreeAndNil(FSystemNotices);
while FFaceList.Count > 0 do
begin
try
FFaceList.Objects[0].Free;
except
end;
FFaceList.Delete(0);
end;
FFaceList.Clear;
FreeAndNil(FFaceList);
while FTempFaceList.Count > 0 do
begin
try
FTempFaceList.Objects[0].Free;
except
end;
FTempFaceList.Delete(0);
end;
FTempFaceList.Clear;
FreeAndNil(FTempFaceList);
FFaceCategory.Clear;
FreeAndNil(FFaceCategory);
FreeAndNil(FInputFont);
FreeAndNil(FDBHistory);
if HookID <> 0 then
UnHookWindowsHookEx(HookID);
if HotKeyID_ReadMessage <> 0 then
begin
UnregisterHotKey(Handle, HotKeyID_ReadMessage);
DeleteAtom(HotKeyID_ReadMessage);
end;
if HotKeyID_CopyScreen <> 0 then
begin
UnregisterHotKey(Handle, HotKeyID_CopyScreen);
DeleteAtom(HotKeyID_CopyScreen);
end;
finally
GetDataModule.Uninstall;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.FormResize(Sender: TObject);
var
iLoop: Integer;
ContacterTreeView: TRealICQContacterTreeView;
FriendTreeView: TRealICQContacterTreeView;
ListView: TRealICQContacterListView;
begin
ShowMeInformation;
if FContacterTreeViews = nil then
Exit;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
ContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
ContacterTreeView.ReDrawAll;
end;
{for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
FriendTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
FriendTreeView.ReDrawAll;
end; }
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
ListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
ListView.ReDrawAll;
end;
if FLVNetWorkDisk <> nil then
FLVNetWorkDisk.ReDrawAll;
if FTVCustomerLatests <> nil then
FTVCustomerLatests.ReDrawAll;
pnlSearchMoreUser.Width := pnlSelectServer.Width - 5;
ImgLogining.Left := (pnlSearchMoreUser.Width - ImgLogining.Width) div 2;
{ TODO -olqq -c : 二维码居中 2014/12/14 11:05:27 }
ImgApp.Left := (Self.Width - ImgApp.Width - 26) div 2;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SaveWindowState;
begin
if WindowState <> wsMaximized then
begin
FMainFormLeft := Left;
FMainFormTop := Top;
FMainFormHeight := Height;
FMainFormWidth := Width - pnlMiddleRight.Width;
try
SaveDefaultConfigs;
except
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.sbpNewWebTabClick(Sender: TObject);
begin
AddWebBrowserToPageControl('about:blank', -1);
end;
//------------------------------------------------------------------------------
procedure TMainForm.sbpSMSClick(Sender: TObject);
begin
OpenSMSForm('', True);
end;
//------------------------------------------------------------------------------
procedure TMainForm.FormShow(Sender: TObject);
var J:Integer;
begin
try
//tsCustomers.Parent := nil;
//tsCustomers.PageControl := nil;
//pgcMainWorkArea.RemoveControl(tsCustomers);
//FreeAndNil(tsCustomers);
// Repaint;
// for J := 0 to Self.ControlCount -1 do
// if (Self.Controls[J] is TRealICQContacterTreeView) then
// Self.Controls[J].Repaint;
except
end;
//tsNetWorkDisk.Parent := nil;
//tsNetWorkDisk.PageControl := nil;
//pgcMainWorkArea.RemoveControl(tsNetWorkDisk);
//FreeAndNil(tsNetWorkDisk);
ClearMemory;
actOpenMainForm.Execute;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if FSearchListViewInVisible then
begin
edFilterKeyword.Text := '';
edFilterKeyword.Font.Color := clGray;
end;
Action := caNone;
if pnlMiddleRight.Visible then
begin
ShowOrHideMuiltiWeb;
Exit;
end;
ZoomEffect(Self, zaMinimize);
ShowWindow(Handle, SW_HIDE);
FHidden := true;
end;
//------------------------------------------------------------------------------
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
SaveWindowState;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actLoginExecute(Sender: TObject);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.actRegExecute(Sender: TObject);
begin
if RegForm <> nil then
Exit;
RegForm := TRegForm.Create(Self);
try
if RegForm.ShowModal <> mrOK then
begin
RealICQClient.CancelReg;
end;
finally
FreeAndNil(RegForm);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actDelFriendExecute(Sender: TObject);
var
ItemIndex: Integer;
RealICQFriendTreeView: TRealICQContacterTreeView;
Friend: TRealICQEmployee;
begin
if MessageBox(Handle, '确实要将选中的用户从好友列表中删除吗？', '确认删除', MB_OKCANCEL or MB_ICONQUESTION) <> IDOK then
Exit;
ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Friend := RealICQFriendTreeView.GetSelectedEmployee;
if (Friend <> nil) then
begin
if Friend.BranchID = LVFriends then
RealICQClient.DelFriend(Friend.LoginName);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actRemoveUserExecute(Sender: TObject);
var
ItemIndex: Integer;
GroupName: string;
RealICQFriendTreeView: TRealICQContacterTreeView;
Friend: TRealICQEmployee;
MenuItem: TMenuItem;
begin
ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Friend := RealICQFriendTreeView.GetSelectedEmployee;
if Friend = nil then
Exit;
GroupName := Friend.BranchID;
if MessageBox(Handle, PChar('确实要将选中的用户从' + GroupName + '删除吗？'), '确认删除', MB_OKCANCEL or MB_ICONQUESTION) <> IDOK then
Exit;
if FShowGroup and (FGroups.IndexOf(GroupName) <> -1) then
begin
// MenuItem := miGroup.Find(LVFriends);
// miMoveGroupClick(MenuItem);
exit;
end;
{
Screen.Cursor := crHourGlass;
Application.ProcessMessages;
try
if GroupName = lvBlacklists then
begin
RealICQClient.DelBlacklists(Friend.LoginName);
ShowAddFriendWindow(Self, Friend.LoginName, Friend.DisplayName);
Sleep(15);
end;
finally
Screen.Cursor := crDefault;
end;
}
end;
//------------------------------------------------------------------------------
procedure TMainForm.actLogoutExecute(Sender: TObject);
var
ShellPath: string;
begin
if GetTalkingFormCount > 0 then
begin
if MessageBox(Handle, '确实要注销吗，此操作将会关闭所有的对话窗口！', '提示', MB_ICONINFORMATION or MB_OKCANCEL) = ID_CANCEL then
Exit;
CloseAllTalkingForm;
end;
CloseAllSMSForm;
RealICQClient.Logout;
RealICQClient.FriendCount := 0;
FIsLogout := True;
ShellPath:= ExtractFilePath(paramstr(0)) + 'Online.exe';
if FileExists(ShellPath) then
WinExec(PChar(ShellPath + ' /R ' + '"' + Application.ExeName + '"'), SW_SHOW);
end;
//------------------------------------------------------------------------------
procedure TMainForm.actLoginAsExecute(Sender: TObject);
begin
if RegForm <> nil then
begin
MessageBox(RegForm.Handle, '请先关闭新用户注册窗口', '提示', MB_ICONINFORMATION);
Exit;
end;
RealICQClient.LoginAsSaved;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actOfflieAutoResponseExecute(Sender: TObject);
begin
if OptionsForm <> nil then
Exit;
OptionsForm := TOptionsForm.Create(Self);
try
OptionsForm.PageIndex := 10;
OptionsForm.ShowModal;
finally
FreeAndNil(OptionsForm);
end;
end;
procedure TMainForm.actOnlineExecute(Sender: TObject);
begin
RealICQClient.ChangeState(TRealICQLoginState((Sender as TAction).Tag), (Sender as TAction).Caption);
end;
//------------------------------------------------------------------------------
procedure TMainForm.actHiddenExecute(Sender: TObject);
begin
RealICQClient.ChangeState(stHidden, '');
end;
//------------------------------------------------------------------------------
procedure TMainForm.actLeaveExecute(Sender: TObject);
begin
RealICQClient.ChangeState(stLeave, (Sender as TAction).Caption);
end;
//------------------------------------------------------------------------------
procedure TMainForm.actHelpExecute(Sender: TObject);
begin
//ShellExecute(handle,'open',pchar('C:\Program Files\Internet Explorer\IEXPLORE.EXE'),PChar('http://www.lxtalk.com'),'',SW_SHOWMAXIMIZED);
//ShellExecute(handle, 'open',PChar(GetDefaultBrowser), PChar('http://www.lxtalk.com'),'',SW_SHOWMAXIMIZED);
end;
//------------------------------------------------------------------------------
procedure TMainForm.actOtherStateExecute(Sender: TObject);
var
LeaveMessage: string;
begin
LeaveMessage := Trim(ShowMyInputBox('其它状态', '请输入离开状态说明文字', '', 16));
if Length(LeaveMessage) > 0 then
RealICQClient.ChangeState(stLeave, LeaveMessage);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientLoginResult(Sender: TObject; LoginResultType: TRealICQLoginResultType; ResultMessage: string);
var
hwnd: THandle;
DBFileName: string;
RemoteVersion: string;
RemoteKeylist: string;
begin
TimerForLogining.Enabled := False;
if not FCheckedUpdate then
begin
if not FileExists(ExtractFilePath(paramstr(0)) + 'Online.exe') then
DownLoadUpdateConfig
else
WinExec(PChar(ExtractFilePath(paramstr(0)) + 'Online.exe /S0 /C /Q'), SW_SHOW);
end;
FCheckedUpdate := not FCheckedUpdate;
case LoginResultType of
rtLoginOK, rtCanUpdate:
begin
Success('成功连接服务器!', 'TMainForm.RealICQClientLoginResult');
AddMessageHistory(smSimple, '登录至服务器', nil);
lblLoginState.Caption := '已登录，数据下载中...';
lblLoginState.Refresh;
lblNDState.Caption := RealICQClient.NetWorkDiskServerAddress + '(' + IntToStr(RealICQClient.NetWorkDiskServerPort) + ')';
DBFileName := RealICQClient.GetUserDir + PersonalMessageHistoryDBFile;
if not FileExists(DBFileName) then
CopyFile(PChar(ExtractFilePath(paramstr(0)) + MessageHistoryDBFile), PChar(DBFileName), False);
try
FDBHistory.LoginName := RealICQClient.LoginName;
FDBHistory.DBFileName := DBFileName;
except
on E: Exception do
begin
Error(E.Message, '加载本地数据库失败');
end;
end;
// btShowMiniPage.Visible := RealICQClient.ShowMiniPage;
if RealICQClient.WorkingMode = wmPublic then
begin
{$region 'wmPublic工作模式'}
{ AddContacterListView(navForContacters.Groups.Objects[0] as TScrollBox, LVFriends);
navForContacters.Groups[0] := LVFriends;
AddContacterListView(navForContacters.Groups.Objects[1] as TScrollBox, LVStrangers);
navForContacters.Groups[1] := LVStrangers;
AddContacterListView(navForContacters.Groups.Objects[2] as TScrollBox, LVBlacklists);
navForContacters.Groups[2] := LVBlacklists; }
{$endregion}
//debug('wmPublic','TMainForm.RealICQClientLoginResult');
end
else if RealICQClient.WorkingMode = wmCorporation then
begin
{$region 'wmCorporation'}
FShowGroup := False;
AddFriendTreeView(ScrollBoxMyFriend, LVFriends);
AddContacterTreeView(ScrollBoxContacters, LVMyContacters);
AddContacterTreeView(ScrollBoxAddrBook, LVAddrBook);
//产品类型
FProductType := TRealICQProductType(TConditionConfig.GetConfig.ProductType);
// LQQ
// 把请求当前用户从RealICQClient移动到BranchService
TMessagesHander.GetHander.Init;
{$endregion}
//debug('wmCorporation','TMainForm.RealICQClientLoginResult');
end;
try
TTeamsAdapter.Start(RealICQClient.LoginName);
TGroupShareConfig.GetConfig.URL := RealICQClient.HeadImageURL;
btShowMiniPage.Visible := TCustomerConfig.GetConfig.ShowGuideViewBtn;
//用户类型
FUserType := RealICQClient.LoginUserType;
//关键字过滤
FFilter := TFilterConfig.GetConfig.Filter;
if FFilter then
begin
RemoteVersion := HttpGet(TFilterConfig.GetConfig.Version, 1);
if TFilterConfig.GetConfig.Local <> RemoteVersion then
begin
RemoteKeylist := HttpGet(TFilterConfig.GetConfig.Keyword, 1);
TFilterConfig.GetConfig.SaveKeylist(RemoteKeylist);
TFilterConfig.GetConfig.Local := RemoteVersion;
end;
FKeyList := TFilterConfig.GetConfig.Keylist;
end;
TMainFormController.GetController.ChangeStyle;
TMainFormController.GetController.LoginToAppCentre(RealICQClient.LoginName);
pnlToolBarResize(nil);
except
on E: Exception do
begin
Error(E.Message, 'TMainForm.RealICQClientLoginResult');
end;
end;
end;
// rtMustUpdate:
// begin
// //启动升级程序
// hWnd := FindWindow(pchar('TUpdateFrm'), pchar(trim('自动更新')));
// if hWnd = 0 then
// WinExec('Update.exe', SW_SHOW);
// end;
// rtVersionError:
// MessageBox(Handle, '抱歉，您当前使用的客户端版本不受支持', '登录失败', MB_ICONINFORMATION);
// rtLoginErrorByDisplayName:
// MessageBox(Handle, '存在姓名相同的用户，请使用登录名登录！', '登录失败', MB_ICONINFORMATION);
rtAuthorizationError:
begin
MessageBox(Handle, '用户名或密码错误', '登录失败', MB_ICONINFORMATION);
RealICQClient.ClearSavedPassword;
actLoginAs.Visible := False;
SetLoginControlsVisible(True);
end;
rtOther:
MessageBox(Handle, PChar(ResultMessage), '登录失败', MB_ICONINFORMATION);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientLoginStateChanged(Sender: TObject);
begin
if not RealICQClient.Logined then
TimerForCheckLogoutTimeout.Enabled := False;
SetUIState;
ClearMemory;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientPleaseSendFaceToMe(Sender: TObject; ALoginName, AFaceMD5Code: string);
var
iIndex: Integer;
Face: TFace;
begin
iIndex := FFaceList.IndexOf(AFaceMD5Code);
if iIndex >= 0 then
begin
Face := FFaceList.Objects[iIndex] as TFace;
(Sender as TRealICQClient).SendFile(MainForm.UseCacheDir, MainForm.CacheDir, ALoginName, Face.FileName, foFace);
Exit;
end;
iIndex := FTempFaceList.IndexOf(AFaceMD5Code);
if iIndex >= 0 then
begin
Face := FTempFaceList.Objects[iIndex] as TFace;
(Sender as TRealICQClient).SendFile(MainForm.UseCacheDir, MainForm.CacheDir, ALoginName, Face.FileName, foFace);
Exit;
end;
if FileExists(FindRecvedFace(AFaceMD5Code)) then
begin
(Sender as TRealICQClient).SendFile(MainForm.UseCacheDir, MainForm.CacheDir, ALoginName, FindRecvedFace(AFaceMD5Code), foFace);
Exit;
end
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientPleaseUploadTeamFace(Sender: TObject; MD5String: string; var FileName: string);
var
iIndex: Integer;
Face: TFace;
begin
iIndex := FFaceList.IndexOf(MD5String);
if iIndex >= 0 then
begin
Face := FFaceList.Objects[iIndex] as TFace;
FileName := Face.FileName;
Exit;
end;
iIndex := FTempFaceList.IndexOf(MD5String);
if iIndex >= 0 then
begin
Face := FTempFaceList.Objects[iIndex] as TFace;
FileName := Face.FileName;
Exit;
end;
if FileExists(FindRecvedFace(MD5String)) then
begin
FileName := FindRecvedFace(MD5String);
Exit;
end
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientReConnectExecute(Sender: TObject; ASeconds: Integer);
begin
TimerForLogining.Enabled := False;
TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Offline.ico');
TrayIcon.SetDefaultIcon;
lblLoginState.Caption := '连接已中断' + #$D#$A + IntToStr(ASeconds) + ' 秒后重新建立连接。';
lblLoginState.Visible := True;
SetLoginControlsVisible(False);
if not btLogin.Visible then
begin
btLogin.Visible := True;
btLogin.Caption := '取消(&C)';
btLogin.Refresh;
end;
lblReConnect.Visible := True;
TimerForCheckLogoutTimeout.Enabled := False;
if not RealICQClient.ReConnectExecuting then
RealICQClient.CancelReConnectAndLogin;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientRemovedUser(Sender: TObject; ALoginName: string);
var
itemIndex: Integer;
RealICQFriendTreeView: TRealICQContacterTreeView;
// Friend: TRealICQEmployee;
// Node: TTreeNode;
begin
ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
if ItemIndex >= 0 then
begin
RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
ItemIndex := RealICQFriendTreeView.EmployeeItems.IndexOf(ALoginName);
if ItemIndex >= 0 then
RealICQFriendTreeView.EmployeeItems.Delete(ItemIndex);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.TimerForFlashTrayIconTimer(Sender: TObject);
var
Icon: TIcon;
Bitmap: TBitmap;
MessageID: string;
RealICQUser: TRealICQUser;
begin
if FNotReadMessages.Count = 0 then
begin
NotReadMessageBoxForm.Visible := False;
TimerForFlashTrayIcon.Enabled := False;
ShowMeInformation;
Exit;
end;
if not (RealICQClient.Logined and RealICQClient.Connected) then
begin
TimerForFlashTrayIcon.Enabled := False;
NotReadMessageBoxForm.Visible := False;
Exit;
end;
Icon := nil;
Bitmap := nil;
MessageID := FNotReadMessages.Strings[FNotReadMessages.Count - 1];
if AnsiSameStr(Copy(MessageID, 1, Length(SMSMessageID)), SMSMessageID) then
begin
Icon := TIcon.Create;
Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + SMSMessageIcon);
end
else if AnsiSameStr(Copy(MessageID, 1, Length(TeamMessageID)), TeamMessageID) then
begin
Icon := TIcon.Create;
Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + TeamIcon);
end
else if AnsiSameStr(Copy(MessageID, 1, Length(SystemMessageID)), SystemMessageID) then
begin
Icon := TIcon.Create;
Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + SystemMessageIcon);
end
else
begin
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageID);
if FileExists(RealICQUser.HeadImageFile) then
begin
try
Bitmap := GetSamllBitmap(RealICQUser.HeadImageFile, 16, 16, False);
except
Icon := TIcon.Create;
Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultIcon);
end;
end
else
begin
Icon := TIcon.Create;
Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultIcon);
end;
end;
try
while ImgLstForFlashTrayIcon.Count > 1 do
ImgLstForFlashTrayIcon.Delete(1);
if Icon <> nil then
ImgLstForFlashTrayIcon.AddIcon(Icon)
else if Bitmap <> nil then
ImgLstForFlashTrayIcon.Add(Bitmap, nil);
finally
try
FreeAndNil(Bitmap);
FreeAndNil(Icon);
except
end;
end;
ImgLstForFlashTrayIcon.GetIcon(FFlashTrayIconIndex, TrayIcon.Icon);
TrayIcon.SetDefaultIcon;
if FFlashTrayIconIndex <> 0 then
FFlashTrayIconIndex := 0
else
FFlashTrayIconIndex := 1;
end;
//------------------------------------------------------------------------------
procedure TMainForm.TimerForLoginingTimer(Sender: TObject);
begin
ImgLstForLogining.GetIcon(FFlashTrayIconIndexAtLogining, TrayIcon.Icon);
TrayIcon.SetDefaultIcon;
Inc(FFlashTrayIconIndexAtLogining);
if FFlashTrayIconIndexAtLogining >= ImgLstForLogining.Count then
FFlashTrayIconIndexAtLogining := 0;
// TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Offline.ico');
// TrayIcon.SetDefaultIcon;
end;
procedure TMainForm.TimerForreconnectgroupTimer(Sender: TObject);
begin
if (realICQClient.Logined and realICQClient.Connected) then
begin
{ TODO -olqq -c : 重连的时候，做下异常处理 2014/12/12 15:36:23 }
try
TTeamsAdapter.Start(RealICQClient.LoginName);
{ TODO -olqq -c : 在procedure TGroup.OnOpen中有重复 2014/12/12 15:41:02 }
//WebSocketTeamSubscribe;
except
on E: Exception do
Log(E.Message, 'TMainForm.TimerForreconnectgroupTimer');
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.StopFlashTeam(ATeamID: string);
var
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
begin
ItemIndex := FLVTeams.Items.IndexOf(ATeamID);
if ItemIndex >= 0 then
begin
ListItem := FLVTeams.Items.Objects[ItemIndex] as TRealICQContacterListItem;
ListItem.StopFlash;
end;
end;
procedure TMainForm.StopHeadImageFlash(AID: string);
var
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
begin
ItemIndex := FLVTeams.Items.IndexOf(AID);
if ItemIndex >= 0 then
begin
ListItem := FLVTeams.Items.Objects[ItemIndex] as TRealICQContacterListItem;
ListItem.StopFlash();
end;
end;
procedure TMainForm.SysMsgClick(Sender: TObject);
begin
RealICQClient.SendGetMoreServerList;
end;
procedure TMainForm.SysMsgIconClick(Sender: TObject);
begin
RealICQClient.SendGetMoreServerList;
end;
//------------------------------------------------------------------------------
procedure TMainForm.StopFlash(ALoginName: string);
var
ItemIndex: Integer;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterListItem: TRealICQContacterListItem;
RealICQFriendTreeView: TRealICQContacterTreeView;
RealICQContacterTreeView: TRealICQContacterTreeView;
Employee: TRealICQEmployee;
Friend: TRealICQEmployee;
begin
ItemIndex := FSearchListView.Items.IndexOf(ALoginName);
if ItemIndex >= 0 then
begin
RealICQContacterListItem := FSearchListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
RealICQContacterListItem.StopFlash;
end;
if (RealICQClient.WorkingMode = wmCorporation) or (FShowTree and (TFriendsService.GetService.IsFriend(ALoginName)) and (TWorkmatesService.GetService.IsWorkmate(ALoginName))) then
begin
ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
if RealICQContacterTreeView <> nil then
begin
Employee := RealICQContacterTreeView.GetEmployee(ALoginName);
if Employee <> nil then
Employee.StopFlash
else
begin
ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
if RealICQFriendTreeView <> nil then
begin
Friend := RealICQFriendTreeView.GetEmployee(ALoginName);
if Friend <> nil then
Friend.StopFlash;
end;
end;
end;
end
else
begin
RealICQContacterListView := GetListViewByLoginName(ALoginName);
if RealICQContacterListView <> nil then
begin
ItemIndex := RealICQContacterListView.Items.IndexOf(ALoginName);
if ItemIndex >= 0 then
begin
RealICQContacterListItem := RealICQContacterListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
RealICQContacterListItem.StopFlash;
end;
end;
end;
end;
procedure TMainForm.WMHotKeyHandle(var Msg: TWMHotKey);
var
iLoop: Integer;
AForm: TTalkingForm;
begin
msg.Result := 1; //该消息已经处理
if msg.HotKey = HotKeyID_ReadMessage then
begin
TrayIconDblClick(TrayIcon);
end;
if msg.HotKey = HotKeyID_CopyScreen then
begin
for iLoop := 0 to TalkingForms.Count - 1 do
begin
AForm := TalkingForms[iLoop];
if AForm.Active then
begin
ShowCopyScreenForm(AForm);
Exit;
end;
end;
ShowCopyScreenForm(nil);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ShowRealICQMessage(RealICQMessage: TRealICQMessage; ShowSendFailed: Boolean; ARealICQClient: TRealICQClient);
var
LoginName: string;
iIndex, ItemIndex: Integer;
TalkingForm: TTalkingForm;
MessageList: TList;
NotReadMessage: TNotReadMessage;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterListItem: TRealICQContacterListItem;
RealICQContacterTreeView: TRealICQContacterTreeView;
Employee: TRealICQEmployee;
RealICQFriendTreeView: TRealICQContacterTreeView;
Friend: TRealICQEmployee;
NeedAddToNotReadMessages: Boolean;
begin
try
RealICQMessage.MessageStr := TTextMessageService.GetService.ContentFilter(RealICQMessage);
FDBHistory.SaveMessage('-1', RealICQMessage.Sender, RealICQMessage.Receiver, RealICQMessage.SendDateTime, RealICQMessage.FontStr, RealICQMessage.MessageStr, RealICQMessage.IsEncryMessage);
if RealICQMessage.IsEncryMessage then
RealICQMessage.ID := FDBHistory.GetMaxMessageId;
finally
if AnsiSameText(RealICQMessage.Sender, ARealICQClient.LoginName) then
LoginName := RealICQMessage.Receiver
else
LoginName := RealICQMessage.Sender;
TalkingForm := GetTalkingForm(LoginName, ARealICQClient);
if TalkingForm = nil then
NeedAddToNotReadMessages := True
else
NeedAddToNotReadMessages := not TalkingForm.CanWriteMessage;
if NeedAddToNotReadMessages then
begin
NotReadMessage := TNotReadMessage.Create;
NotReadMessage.FRealICQMessage := RealICQMessage;
NotReadMessage.FShowSendFailed := ShowSendFailed;
NotReadMessage.FRealICQClient := ARealICQClient;
iIndex := FNotReadMessages.IndexOf(LoginName);
if iIndex >= 0 then
begin
MessageList := FNotReadMessages.Objects[iIndex] as TList;
MessageList.Add(NotReadMessage);
end
else
begin
if MessageBoxForm = nil then
begin
{$region '跳动头像'}
ItemIndex := FSearchListView.Items.IndexOf(LoginName);
if ItemIndex >= 0 then
begin
RealICQContacterListItem := FSearchListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
if FlashImageOnGetMessage then
RealICQContacterListItem.Flash(fsJump);
end;
if (RealICQClient.WorkingMode = wmCorporation) or (FShowTree and TUsersService.GetUsersService.IsWorkmateOrFriend(LoginName)) then
begin
ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
if RealICQContacterTreeView <> nil then
begin
Employee := RealICQContacterTreeView.GetEmployee(LoginName);
if Employee <> nil then
begin
if FlashImageOnGetMessage then
Employee.Flash(fsJump);
end
else
begin
ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
if RealICQFriendTreeView <> nil then
begin
Friend := RealICQFriendTreeView.GetEmployee(LoginName);
if Friend <> nil then
if FlashImageOnGetMessage then
Friend.Flash(fsJump)
end;
end;
end;
end
else
begin
RealICQContacterListView := GetListViewByLoginName(LoginName);
if RealICQContacterListView <> nil then
begin
ItemIndex := RealICQContacterListView.Items.IndexOf(LoginName);
if ItemIndex >= 0 then
begin
RealICQContacterListItem := RealICQContacterListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
if FlashImageOnGetMessage then
RealICQContacterListItem.Flash(fsJump);
end;
end; // if RealICQContacterListView <> nil ...
end;
{$endregion}
end;
MessageList := TList.Create;
MessageList.Add(NotReadMessage);
FNotReadMessages.AddObject(LoginName, MessageList);
end;
if MessageBoxForm <> nil then
begin
if (GetForegroundWindow <> MessageBoxForm.Handle) then
FlashWindow(MessageBoxForm.Handle, True);
MessageBoxForm.ShowMessage(RealICQMessage.Sender, MTUser);
end
else if (not TimerForFlashTrayIcon.Enabled) then
TimerForFlashTrayIcon.Enabled := True;
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
NotReadMessageBoxForm.ShowNotReadMessage;
NotReadMessageBoxForm.Height := 0;
NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
end
else
begin
if (GetForegroundWindow <> TalkingForm.Handle) then
begin
FlashWindow(TalkingForm.Handle, True);
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
TalkingForm.ShowMessage(RealICQMessage, ShowSendFailed);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientSendedSendFileRequest(Sender, FileTransmitter: TObject);
var
PtoPFileTransmitter: TPtoPFileTransmitter;
TalkingForm: TTalkingForm;
ALoginName: string;
RealICQUser: TRealICQUser;
ItemIndex: Integer;
RealICQContacterListItem: TRealICQContacterListItem;
begin
PtoPFileTransmitter := FileTransmitter as TPtoPFileTransmitter;
if PtoPFileTransmitter.Objective = foFace then
begin
TalkingForm := GetTalkingForm(PtoPFileTransmitter.LoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
end
else
begin
TalkingForm := OpenTalkingForm(PtoPFileTransmitter.LoginName, True, Sender as TRealICQClient);
end;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowSendedSendFileRequest(PtoPFileTransmitter);
{$region '更新“最近联系人列表”中的数据'}
if Sender = RealICQClient then
begin
ALoginName := PtoPFileTransmitter.LoginName;
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
if RealICQUser <> nil then
begin
ItemIndex := FLVLatests.Items.IndexOf(ALoginName);
if ItemIndex = -1 then
ItemIndex := FLVLatests.Items.Add(ALoginName);
RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
//BindUserDataToItem(RealICQContacterListItem, RealICQUser);
TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
RealICQContacterListItem.MoveToTop;
end;
end;
{$endregion}
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientSendedTeamMessage(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
begin
ShowRealICQTeamMessage(RealICQTeamMessage, False);
end;
procedure TMainForm.RealICQClientCancelControlRemoteControlTransmite(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowCancelControlRemoteControlTransmite;
end;
procedure TMainForm.RealICQClientCanceledSendFolder(Sender: TObject; AID: Cardinal; ALoginName: string);
var
ReceiveFolderRequestForm: TReceiveFolderRequestForm;
iLoop: Integer;
begin
for iLoop := 0 to ReceiveFolderForms.Count - 1 do
begin
ReceiveFolderRequestForm := TReceiveFolderRequestForm(ReceiveFolderForms[iLoop]);
if (ReceiveFolderRequestForm.FID = AID) and AnsiSameText(ALoginName, ReceiveFolderRequestForm.FLoginName) then
begin
ReceiveFolderRequestForm.CanceledSendFolder;
Break;
end;
end;
end;
procedure TMainForm.RealICQClientCancelSendFile(Sender: TObject; ALoginName: string; AOppositeID: Cardinal);
var
TalkingForm: TTalkingForm;
iWaitTimes: Integer;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm <> nil then
begin
if (GetForegroundWindow <> TalkingForm.Handle) then
begin
FlashWindow(TalkingForm.Handle, True);
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
iWaitTimes := 0;
while not TalkingForm.CanWriteMessage do
begin
Application.ProcessMessages;
Inc(iWaitTimes);
if iWaitTimes > 1000 then
break;
Sleep(10);
end;
TalkingForm.ShowCancelSendFile(AOppositeID);
end;
end;
procedure TMainForm.RealICQClientChangePasswordResult(Sender: TObject; APassChanged: Boolean; ANewPassword: string);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedSendFileRequest(Sender: TObject; SendFileRequestInfo: TSendFileRequestInfo);
var
AShowActive: Boolean;
TalkingForm: TTalkingForm;
iWaitTimes: Integer;
ALoginName: string;
RealICQUser: TRealICQUser;
ItemIndex: Integer;
RealICQContacterListItem: TRealICQContacterListItem;
begin
AShowActive := (RealICQClient.IsAutoState = True) and (RealICQClient.Me.LoginState = stLeave) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌');
TalkingForm := GetTalkingForm(SendFileRequestInfo.LoginName, Sender as TRealICQClient);
if TalkingForm = nil then
begin
TalkingForm := OpenTalkingForm(SendFileRequestInfo.LoginName, not AShowActive, Sender as TRealICQClient);
end;
iWaitTimes := 0;
while not TalkingForm.CanWriteMessage do
begin
Application.ProcessMessages;
Inc(iWaitTimes);
if iWaitTimes > 1000 then
break;
Sleep(10);
end;
if (GetForegroundWindow <> TalkingForm.Handle) and (SendFileRequestInfo.Objective = foFile) then
begin
FlashWindow(TalkingForm.Handle, True);
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
TalkingForm.ShowGettedSendFileRequest(SendFileRequestInfo);
{$region '更新“最近联系人列表”中的数据'}
if Sender = RealICQClient then
begin
ALoginName := SendFileRequestInfo.LoginName;
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
if RealICQUser <> nil then
begin
ItemIndex := FLVLatests.Items.IndexOf(ALoginName);
if ItemIndex = -1 then
ItemIndex := FLVLatests.Items.Add(ALoginName);
RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
//BindUserDataToItem(RealICQContacterListItem, RealICQUser);
TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
RealICQContacterListItem.MoveToTop;
end;
end;
{$endregion}
end;
procedure TMainForm.RealICQClientGettedSendFolderRequest(Sender: TObject; AID, ACount: Cardinal; ALoginName: string; AFilesStream: TStream);
var
ReceiveFolderRequestForm: TReceiveFolderRequestForm;
begin
ReceiveFolderRequestForm := TReceiveFolderRequestForm.Create(Self);
ReceiveFolderRequestForm.FCount := ACount;
ReceiveFolderRequestForm.FID := AID;
ReceiveFolderRequestForm.FLoginName := ALoginName;
ReceiveFolderRequestForm.FFilesStream := AFilesStream;
ReceiveFolderRequestForm.Show;
ReceiveFolderRequestForm.BringToFront;
end;
procedure TMainForm.RealICQClientGettedSendOfflineFileRequest(Sender: TObject; ALoginName: string; AOppositeID: Cardinal);
var
TalkingForm: TTalkingForm;
iWaitTimes: Integer;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm <> nil then
begin
if (GetForegroundWindow <> TalkingForm.Handle) then
begin
FlashWindow(TalkingForm.Handle, True);
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
iWaitTimes := 0;
while not TalkingForm.CanWriteMessage do
begin
Application.ProcessMessages;
Inc(iWaitTimes);
if iWaitTimes > 1000 then
break;
Sleep(10);
end;
TalkingForm.ShowSendOfflineFileRequest(AOppositeID);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientSendMessageFailed(Sender: TObject; RealICQMessage: TRealICQMessage);
begin
ShowRealICQMessage(RealICQMessage, True, Sender as TRealICQClient);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientSendTeamMessageFailed(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
begin
ShowRealICQTeamMessage(RealICQTeamMessage, True);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientShakeWindow(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
iWaitTimes: Integer;
begin
if not MainForm.ShowShakeWindow then
Exit;
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
begin
TalkingForm := OpenTalkingForm(ALoginName, True, Sender as TRealICQClient);
end;
iWaitTimes := 0;
while not TalkingForm.CanWriteMessage do
begin
Application.ProcessMessages;
Inc(iWaitTimes);
if iWaitTimes > 1000 then
break;
Sleep(10);
end;
if GetTickCount - TalkingForm.LastRecvShakeWindowTicket < 150000 then
Exit;
ForceForeGroundWindow(TalkingForm.Handle);
TalkingForm.ShowShakeWindow(False);
TalkingForm.LastRecvShakeWindowTicket := GetTickCount;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientSMSResult(Sender: TObject; AMessageID: Cardinal; AResult: Integer);
var
iIndex: Integer;
SMSMessage: TSMSMessage;
begin
iIndex := SMSMessages.IndexOf(IntToStr(AMessageID));
if iIndex >= 0 then
begin
SMSMessage := SMSMessages.Objects[iIndex] as TSMSMessage;
SMSMessage.Sended := AResult = 0;
SMSMessage.SMSForm.ShowSMSMessageResult(AMessageID, AResult);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientTeamInfoReady(Sender: TObject; ARealICQTeam: TRealICQTeam);
var
iLoop, iIndex: Integer;
ListItem: TRealICQContacterListItem;
MemberList: TStringList;
begin
iIndex := FLVTeams.Items.IndexOf(ARealICQTeam.TeamID);
if iIndex = -1 then
iIndex := FLVTeams.Items.Add(ARealICQTeam.TeamID);
ListItem := FLVTeams.Items.Objects[iIndex] as TRealICQContacterListItem;
if ARealICQTeam.IsTempTeam then
ListItem.Watchword := ''
else
ListItem.Watchword := ARealICQTeam.TeamIntro;
ListItem.LoginState := stLeave;
MemberList := SplitString(ARealICQTeam.TeamMembers, Chr(10));
try
for iLoop := MemberList.Count - 1 downto 0 do
begin
if Length(Trim(MemberList[iLoop])) = 0 then
MemberList.Delete(iLoop);
end;
ListItem.LeaveMessage := IntToStr(MemberList.Count) + '个成员';
finally
MemberList.Free;
end;
{try
ListItem.HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + TeamPicture);
except
ListItem.HeadImagePicture.Graphic := nil;
end; }
if ARealICQTeam.IsTempTeam then
ListItem.DisplayName := '多人对话'
else
ListItem.DisplayName := ARealICQTeam.TeamCaption;
ListItem.Data := ARealICQTeam;
ListItem.ReDrawItem;
// UpdateTeamOptionsForm(ARealICQTeam);
UpdateTeamTalkingForm(ARealICQTeam);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientReceivedAdversement(Sender: TObject);
begin
if (not RealICQClient.MainFormAdversement.Visible) then
begin
if pnlAdvertisement.Height > 0 then
pnlAdvertisement.Height := 0;
end
else
begin
WebBrowserForAdvertisement.OnBeforeNavigate2 := nil;
pnlForHideWebBrowser.Visible := True;
pnlForHideWebBrowser.BringToFront;
WebBrowserForAdvertisement.OnDocumentComplete := WebBrowserForAdvertisementDocumentComplete;
WebBrowserForAdvertisement.Navigate(AnsiReplaceText(AnsiReplaceText(RealICQClient.MainFormAdversement.URL, '[%LoginName%]', RealICQClient.LoginName), '[%BranchID%]', RealICQClient.Me.BranchID));
pnlWebSearch.Top := pnlAdvertisement.Top + pnlAdvertisement.Height + 1;
end;
UpdateTalkingFormAdversement;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientReceivedCustomMessage(Sender: TObject; AContent: string);
var
Contents: TStringList;
LoginName: string;
SystemMessage: TRealICQSystemMessage;
jo: ISuperObject;
reg: TPerlRegEx;
begin
if AnsiSameText('ReGetCountByReceiver', AContent) then
begin
RealICQClient.SendGetNewInformation(0);
Exit;
end;
if AnsiSameText('ReGetAnnouncement', AContent) then
begin
RealICQClient.SendGetNewInformation(1);
Exit;
end;
AContent := AnsiReplaceStr(AContent, Chr(13), '');
Contents := RealICQUtils.SplitString(AContent, Chr(10));
try
//TODO: lqq 新消息通知接口
if (Contents.Count > 1) and (CompareText(Contents[0], 'SendNotify') = 0) then
begin
jo := SO(Contents[1]);
SystemMessage := TRealICQSystemMessage.Create;
SystemMessage.MessageID := GetTickCount;
Sleep(100);
SystemMessage.MessageType := mtBroadcast;
SystemMessage.AutoOpenWindow := True;
SystemMessage.Position := mpRightBottom;
SystemMessage.Left := 0;
SystemMessage.Top := 0;
SystemMessage.Width := 258;
SystemMessage.Height := 168;
SystemMessage.Delay := 0;
SystemMessage.MaxShowTimes := 0;
SystemMessage.Title := jo.S['title'];
SystemMessage.URL := jo.S['url'];
if jo.S['appkey'] = '' then
SystemMessage.Content := Format('%s
', [SystemMessage.URL, jo.S['content']])
else
SystemMessage.Content := Format('%s
', ['SSO||' + jo.S['appkey'] + '||' + SystemMessage.URL, jo.S['content']]);
SystemMessage.AutoCloseTime := 0;
RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
Exit;
end;
if Contents.Count >= 3 then
begin
{ if AnsiSameText(Contents.Strings[0], 'CONFIRMDLG') then
begin
SystemMessage := TRealICQSystemMessage.Create;
SystemMessage.MessageID :=StrToInt(Contents.Strings[5]);// GetTickCount;
Sleep(100);
SystemMessage.MessageType := mtConfirmMsg;
SystemMessage.AutoOpenWindow := True;
SystemMessage.Position := mpCenter;
SystemMessage.Width := 278;
SystemMessage.Height := 178;
SystemMessage.Delay := 0;
SystemMessage.MaxShowTimes := 0;
SystemMessage.Content := Contents.Strings[2];
SystemMessage.Title := Contents.Strings[3];
SystemMessage.URL := Contents.Strings[4]+Chr(10)+Contents.Strings[6]+Chr(10)+Contents.Strings[7];
SystemMessage.AutoCloseTime :=120;
RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
end; }
if AnsiSameText(Contents.Strings[0], 'RJOA') or AnsiSameText(Contents.Strings[0], 'RDOA') or AnsiSameText(Contents.Strings[0], 'CONFIRM_NOTIFY') then
begin
SystemMessage := TRealICQSystemMessage.Create;
SystemMessage.MessageID := GetTickCount;
Sleep(100);
SystemMessage.MessageType := mtBroadcast;
if AnsiSameText(Contents.Strings[0], 'CONFIRM_NOTIFY') then
SystemMessage.MessageType := mtAdvertisement;
SystemMessage.AutoOpenWindow := True;
SystemMessage.Position := mpRightBottom;
SystemMessage.Left := 0;
SystemMessage.Top := 0;
SystemMessage.Width := 258;
SystemMessage.Height := 168;
SystemMessage.Delay := 0;
SystemMessage.MaxShowTimes := 0;
SystemMessage.Title := '系统提醒';
reg := TPerlRegEx.Create;
try
reg.Subject := Contents.Strings[2];
reg.RegEx := '<[^>]+>';
reg.Replacement := '';
while reg.MatchAgain do
begin
if (Length(reg.Groups[0]) >= 3) and ((SameText(LeftStr(reg.Groups[0], 3), ''))) then
Continue;
if (SameText(reg.Groups[0], '')) then
Continue;
reg.Replace();
end;
SystemMessage.Content := '' + reg.Subject + '
';
finally
reg.Free;
end;
SystemMessage.URL := '';
SystemMessage.AutoCloseTime := 0;
if AnsiSameText(Contents.Strings[0], 'RDOA') or AnsiSameText(Contents.Strings[0], 'CONFIRM_NOTIFY') then
begin
SystemMessage.URL := Contents.Strings[4];
if Contents.Strings[6] = '1' then
begin
LoginName := RealICQClient.LoginName;
if Pos('-', RealICQClient.LoginName) > 0 then
LoginName := Copy(RealICQClient.LoginName, Pos('-', RealICQClient.LoginName) + 1, Length(RealICQClient.LoginName));
SystemMessage.URL := SystemMessage.URL + Contents.Strings[5];
end;
SystemMessage.Title := Contents.Strings[7];
end
else
begin
if Contents.Count >= 7 then
SystemMessage.URL := Contents.Strings[3];
try
if Contents.Count >= 5 then
SystemMessage.Width := StrToInt(Contents.Strings[4]);
if Contents.Count >= 6 then
SystemMessage.Height := StrToInt(Contents.Strings[5]);
if Contents.Count >= 7 then
begin
if Contents.Strings[6] = '1' then
begin
TimerForShowSystemNotices.Enabled := False;
RealICQClient.SendGetNewInformation(1);
end
else
begin
RealICQClient.SendGetNewInformation(0);
end;
end
else
begin
RealICQClient.SendGetNewInformation(0);
end;
if Contents.Count >= 8 then
SystemMessage.Title := Contents.Strings[7];
except
end;
end;
RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
end;
if AnsiSameText(Contents.Strings[0], 'LXUMC') then
begin
// if not MainForm.ShowFileTransCompleted then Exit;
SystemMessage := TRealICQSystemMessage.Create;
SystemMessage.MessageID := GetTickCount;
SystemMessage.MessageType := mtBroadcast;
SystemMessage.AutoOpenWindow := True;
SystemMessage.Position := mpRightBottom;
SystemMessage.Left := 0;
SystemMessage.Top := 0;
SystemMessage.Width := 258;
SystemMessage.Height := 148;
SystemMessage.Delay := 0;
SystemMessage.MaxShowTimes := 0;
SystemMessage.Title := '系统提醒';
SystemMessage.Content := Contents.Strings[2];
SystemMessage.URL := '';
SystemMessage.AutoCloseTime := 0;
if Contents.Count > 3 then
SystemMessage.Title := Contents.Strings[3];
RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
end;
if AnsiSameText(Contents.Strings[0], 'EMAIL') then
begin
if AnsiSameText(Contents.Strings[1], '0') then
begin
spbEmail.Caption := '(' + Contents.Strings[2] + ')';
end
else if AnsiSameText(Contents.Strings[1], '1') then
begin
spbEmail.Caption := '(' + IntToStr(StrToInt(ReplaceStr(ReplaceStr(spbEmail.Caption, '(', ''), ')', '')) + 1) + ')';
SystemMessage := TRealICQSystemMessage.Create;
SystemMessage.MessageID := GetTickCount;
SystemMessage.MessageType := mtBroadcast;
SystemMessage.AutoOpenWindow := True;
SystemMessage.Position := mpRightBottom;
SystemMessage.Left := 0;
SystemMessage.Top := 0;
SystemMessage.Width := 258;
SystemMessage.Height := 148;
SystemMessage.Delay := 0;
SystemMessage.MaxShowTimes := 0;
SystemMessage.Title := '系统提醒';
if AnsiSameText(Copy(Contents.Strings[3], 1, 7), 'http://') then
begin
SystemMessage.Content := '您从 ' + Contents.Strings[2] + ' 处收到一封新邮件!';
SystemMessage.URL := Contents.Strings[3];
end
else
begin
SystemMessage.Content := '您从 ' + Contents.Strings[3] + ' 处收到一封新邮件!';
SystemMessage.URL := '';
end;
SystemMessage.AutoCloseTime := 15;
RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
end;
end;
end;
finally
FreeAndNil(Contents);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientReceivedMessage(Sender: TObject; RealICQMessage: TRealICQMessage);
var
ItemIndex: Integer;
RealICQContacterListItem: TRealICQContacterListItem;
RealICQUser: TRealICQUser;
ALoginName: string;
begin
ShowRealICQMessage(RealICQMessage, False, Sender as TRealICQClient);
{$region '更新“最近联系人列表”中的数据'}
if Sender = RealICQClient then
begin
if not AnsiSameText(RealICQMessage.Sender, RealICQClient.LoginName) then
ALoginName := RealICQMessage.Sender
else
ALoginName := RealICQMessage.Receiver;
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
if RealICQUser <> nil then
begin
ItemIndex := FLVLatests.Items.IndexOf(ALoginName);
if ItemIndex = -1 then
ItemIndex := FLVLatests.Items.Add(ALoginName);
RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
//BindUserDataToItem(RealICQContacterListItem, RealICQUser);
TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
RealICQContacterListItem.MoveToTop;
end;
end;
{$endregion}
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientReceivedOfflineAutoResponseSet(Sender: TObject; AEnabled: Boolean; AText: string);
begin
actOfflieAutoResponse.Checked := AEnabled;
if OptionsForm <> nil then
OptionsForm.GetSets;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientReceivedOfflineFile(Sender: TObject; ASender, AFileName: string; AFileSize: Int64; ASendDateTime: TDateTime);
var
AShowActive: Boolean;
TalkingForm: TTalkingForm;
iWaitTimes: Integer;
ALoginName: string;
RealICQUser: TRealICQUser;
ItemIndex: Integer;
RealICQContacterListItem: TRealICQContacterListItem;
begin
if AnsiSameText(ASender, RealICQClient.Me.LoginName) then
Exit;
AShowActive := (RealICQClient.IsAutoState = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌');
TalkingForm := GetTalkingForm(ASender, RealICQClient);
if TalkingForm = nil then
begin
TalkingForm := OpenTalkingForm(ASender, not AShowActive, RealICQClient);
end;
iWaitTimes := 0;
while not TalkingForm.CanWriteMessage do
begin
Application.ProcessMessages;
Inc(iWaitTimes);
if iWaitTimes > 1000 then
break;
Sleep(10);
end;
if (GetForegroundWindow <> TalkingForm.Handle) then
begin
FlashWindow(TalkingForm.Handle, True);
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
TFileTransmitAdapter.Receive(TalkingForm, AFileName, 0, ASender, '', ASendDateTime, Self.RealICQClient, AFileSize);
{$region '更新“最近联系人列表”中的数据'}
if Sender = RealICQClient then
begin
ALoginName := ASender;
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
if RealICQUser <> nil then
begin
ItemIndex := FLVLatests.Items.IndexOf(ALoginName);
if ItemIndex = -1 then
ItemIndex := FLVLatests.Items.Add(ALoginName);
RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
//BindUserDataToItem(RealICQContacterListItem, RealICQUser);
TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
RealICQContacterListItem.MoveToTop;
end;
end;
{$endregion}
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientReceivedServerList(Sender: TObject; AServerList: string);
var
ServerList: TStringList;
iLoop, chrPos: Integer;
MenuItem: TMenuItem;
ServerInfo: TServerInfo;
//config: TConditionConfig;
begin
//config := TConditionConfig.GetConfig;
while ppServerList.Items.Count > 0 do
ppServerList.Items.Delete(0);
ServerList := SplitString(AServerList, Chr(10));
try
iLoop := 0;
while iLoop < ServerList.Count - 1 do
begin
ServerInfo := TServerInfo.Create;
ServerInfo.ServerId := ServerList[iLoop];
Inc(iLoop);
ServerInfo.ServerName := ServerList[iLoop];
Inc(iLoop);
// if config.OtherServersDisable and not (UpperCase(ServerInfo.ServerId) = UpperCase(RealICQClient.ServerID)) then
// begin
// Continue;
// end;
MenuItem := TMenuItem.Create(ppServerList);
MenuItem.AutoHotkeys := maManual;
MenuItem.AutoLineReduction := maManual;
MenuItem.Caption := '&' + ServerInfo.ServerName;
MenuItem.Hint := ServerInfo.ServerId;
MenuItem.OnClick := miChangeServerClick;
MenuItem.Tag := iLoop;
if UpperCase(ServerInfo.ServerId) = UpperCase(RealICQClient.ServerID) then
begin
edServerList.Text := ServerInfo.ServerName;
ImgLoadingMoreBranchs.Visible := True;
ScrollBoxMoreUser.Visible := False;
//RealICQClient.SendGetMoreBranch(ServerInfo.ServerId);
RealICQClient.SendGetBranchs(ServerInfo.ServerId, 0);
FCurrentServerID := ServerInfo.ServerId;
//Todo: 调用Online.exe
if FileExists(ExtractFilePath(Application.ExeName) + 'Online.exe') then
TCheckRunProcessThread.Create('Online', ExtractFilePath(Application.ExeName) + 'Online.exe')
//else
//Self.PostUpdateLog;
end;
FServerInfoList.AddObject(ServerInfo.ServerId, ServerInfo);
ppServerList.Items.Add(MenuItem);
end;
finally
FreeAndNil(ServerList);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ShowRealICQTeamMessage(RealICQTeamMessage: TRealICQTeamMessage; ShowSendFailed: Boolean);
var
nTeamID: string;
iIndex, ItemIndex: Integer;
MessageList: TList;
TalkingForm: TTalkingForm;
NotReadTeamMessage: TNotReadTeamMessage;
NeedAddToNotReadMessages: Boolean;
ListItem: TRealICQContacterListItem;
ASave: Boolean;
begin
try
ASave := AutoSaveMessage;
if Copy(RealICQTeamMessage.MessageStr, 1, 11) = '' then
begin
if Copy(RealICQTeamMessage.MessageStr, Length(RealICQTeamMessage.MessageStr) - 11, 12) = '' then
begin
ASave := False;
end;
end;
if ASave then
begin
FDBHistory.SaveMessage(RealICQTeamMessage.TeamID, RealICQTeamMessage.Sender, RealICQClient.LoginName, RealICQTeamMessage.SendDateTime, RealICQTeamMessage.FontStr, RealICQTeamMessage.MessageStr, RealICQTeamMessage.IsEncryMessage);
if RealICQTeamMessage.IsEncryMessage then
RealICQTeamMessage.ID := FDBHistory.GetMaxMessageId;
end;
except
end;
nTeamID := RealICQTeamMessage.TeamID;
TalkingForm := GetTeamTalkingForm(nTeamID);
if TalkingForm = nil then
NeedAddToNotReadMessages := True
else
NeedAddToNotReadMessages := not TalkingForm.CanWriteMessage;
if NeedAddToNotReadMessages then
begin
NotReadTeamMessage := TNotReadTeamMessage.Create;
NotReadTeamMessage.FRealICQTeamMessage := RealICQTeamMessage;
NotReadTeamMessage.FShowSendFailed := ShowSendFailed;
iIndex := FNotReadMessages.IndexOf(TeamMessageID + nTeamID);
if iIndex >= 0 then
begin
MessageList := FNotReadMessages.Objects[iIndex] as TList;
MessageList.Add(NotReadTeamMessage);
end
else
begin
{$region '跳动头像'}
ItemIndex := FLVTeams.Items.IndexOf(nTeamID);
if ItemIndex >= 0 then
begin
ListItem := FLVTeams.Items.Objects[ItemIndex] as TRealICQContacterListItem;
if FlashImageOnGetMessage then
ListItem.Flash(fsJump);
end;
{$endregion}
MessageList := TList.Create;
MessageList.Add(NotReadTeamMessage);
FNotReadMessages.AddObject(TeamMessageID + nTeamID, MessageList);
TimerForFlashTrayIcon.Enabled := True;
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
if MessageBoxForm <> nil then
begin
if (GetForegroundWindow <> MessageBoxForm.Handle) then
FlashWindow(MessageBoxForm.Handle, True);
MessageBoxForm.ShowMessage(RealICQTeamMessage.Sender, MTTeam);
Exit;
end
else if (not TimerForFlashTrayIcon.Enabled) then
TimerForFlashTrayIcon.Enabled := True;
NotReadMessageBoxForm.ShowNotReadMessage;
NotReadMessageBoxForm.Height := 0;
NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
end
else
begin
if (GetForegroundWindow <> TalkingForm.Handle) then
begin
FlashWindow(TalkingForm.Handle, True);
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
TalkingForm.ShowTeamMessage(RealICQTeamMessage, ShowSendFailed);
end;
end;
procedure TMainForm.RealICQClientReceivedSMS(Sender: TObject; ASMSSender, ASMSContent: string; ASMSDateTime: TDateTime);
var
NotReadSMSMessage: TNotReadSMSMessage;
SMSForm: TSMSForm;
ASender: string;
iLoop: Integer;
ARealICQUser: TRealICQUser;
NeedAddToNotReadMessages: Boolean;
MessageList: TList;
iIndex: Integer;
AUsers: TStringList;
begin
ASender := '';
AUsers := TUsersService.GetUsersService.GetWorkmatesAndFriends;
try
for iLoop := 0 to AUsers.Count - 1 do
begin
ARealICQUser := AUsers.Objects[iLoop] as TRealICQUser;
if Length(Trim(ARealICQUser.Mobile)) < 11 then
continue;
if Pos(ARealICQUser.Mobile, ASMSSender) > 0 then
begin
ASender := ARealICQUser.LoginName;
Break;
end;
if Length(ARealICQUser.Mobile) < 10 then
begin
if AnsiSameStr('1060578' + ARealICQUser.Mobile, ASMSSender) then
begin
ASender := ARealICQUser.LoginName;
Break;
end;
end;
end;
// if ASender = '' then
// ASender := ASMSSender;
finally
FreeAndNil(AUsers);
end;
SMSForm := GetSMSForm(ASender);
NotReadSMSMessage := TNotReadSMSMessage.Create;
NotReadSMSMessage.FSMSSender := ASMSSender;
NotReadSMSMessage.FSMSContent := ASMSContent;
NotReadSMSMessage.FSMSDateTime := ASMSDateTime;
iIndex := FNotReadMessages.IndexOf(SMSMessageID + ASender);
if iIndex >= 0 then
begin
MessageList := FNotReadMessages.Objects[iIndex] as TList;
MessageList.Add(NotReadSMSMessage);
end
else
begin
MessageList := TList.Create;
MessageList.Add(NotReadSMSMessage);
FNotReadMessages.AddObject(SMSMessageID + ASender, MessageList);
TimerForFlashTrayIcon.Enabled := True;
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
if SMSForm = nil then
NeedAddToNotReadMessages := True
else
NeedAddToNotReadMessages := not SMSForm.CanWriteMessage;
if NeedAddToNotReadMessages then
begin
TimerForFlashTrayIcon.Enabled := True;
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
if MessageBoxForm <> nil then
begin
if (GetForegroundWindow <> MessageBoxForm.Handle) then
FlashWindow(MessageBoxForm.Handle, True);
MessageBoxForm.ShowMessage(ASender, MTSMS);
Exit;
end
else if (not TimerForFlashTrayIcon.Enabled) then
TimerForFlashTrayIcon.Enabled := True;
NotReadMessageBoxForm.ShowNotReadMessage;
NotReadMessageBoxForm.Height := 0;
NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
end
else
begin
if (GetForegroundWindow <> SMSForm.Handle) then
begin
FlashWindow(SMSForm.Handle, True);
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
//显示收到的短消息
SMSForm.LoadNotReadSMSMessages;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientReceivedSystemMessage(Sender: TObject; ASystemMessage: TRealICQSystemMessage);
begin
if (ASystemMessage.MaxShowTimes = 0) or ((GetSystemMessageCounter(ASystemMessage.MessageID) < ASystemMessage.MaxShowTimes) and (ASystemMessage.MaxShowTimes > 0)) then
begin
try
FDBHistory.SaveSystemMessage(ASystemMessage.MessageID, ASystemMessage.MessageType, ASystemMessage.Position, ASystemMessage.Left, ASystemMessage.Top, ASystemMessage.Width, ASystemMessage.Height, ASystemMessage.Title, ASystemMessage.Content, ASystemMessage.URL, ASystemMessage.AutoCloseTime);
except
end;
FSystemMessages.Insert(0, ASystemMessage);
if TimerForShowSystemMessage.Enabled = False then
TimerForShowSystemMessage.Enabled := True;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ShowSystemMessage(ASystemMessage: TRealICQSystemMessage);
begin
try
OpenSystemMessageForm(IntToStr(ASystemMessage.MessageID), ASystemMessage.MessageType, ASystemMessage.Position, ASystemMessage.Left, ASystemMessage.Top, ASystemMessage.Width, ASystemMessage.Height, ASystemMessage.Title, ASystemMessage.Content, ASystemMessage.URL, ASystemMessage.AutoCloseTime);
IncSystemMessageCounter(ASystemMessage.MessageID);
finally
FreeAndNil(ASystemMessage);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.TimerForShowSystemMessageTimer(Sender: TObject);
var
iLoop: Integer;
ASystemMessage: TRealICQSystemMessage;
begin
if FSystemMessages.Count = 0 then
TimerForShowSystemMessage.Enabled := False
else
begin
for iLoop := FSystemMessages.Count - 1 downto 0 do
begin
ASystemMessage := FSystemMessages[iLoop];
ASystemMessage.Delay := ASystemMessage.Delay - 0.2;
if ASystemMessage.Delay <= 0 then
begin
FSystemMessages.Delete(iLoop);
if ASystemMessage.AutoOpenWindow then
begin
ShowSystemMessage(ASystemMessage);
end
else
begin
FNotReadMessages.AddObject(SystemMessageID + IntToStr(ASystemMessage.MessageID), ASystemMessage);
TimerForFlashTrayIcon.Enabled := True;
if PlaySoundOnGetSystemMessage then
PlayEventSound(FSystemMessageEventSound);
NotReadMessageBoxForm.ShowNotReadMessage;
NotReadMessageBoxForm.Height := 0;
NotReadMessageBoxForm.Top := Screen.WorkAreaHeight - NotReadMessageBoxForm.Height;
end;
end;
end;
if (self.MessageBoxForm <> nil) then
MessageBoxForm.ShowSystemMessages(FSystemMessages);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientReceivedTeamMessage(Sender: TObject; RealICQTeamMessage: TRealICQTeamMessage);
begin
ShowRealICQTeamMessage(RealICQTeamMessage, False);
end;
procedure TMainForm.RealICQClientReceivedVideoImage(Sender: TObject; ALoginName: string; ABitmap: TBitmap);
begin
end;
{
//------------------------------------------------------------------------------
procedure TMainForm.UpdateFriendNode(Friend: TRealICQEmployee; RealICQUser: TRealICQUser; ANeedFlash: Boolean);
var
GIFImage: TGIFImage;
jo: IsuperObject;
ARemarkTel, ARemarkMobile, ARemark: string;
begin
jo := TUserRemarkService.GetService.GetUserRemark(RealICQUser.LoginName);
if jo <> nil then
begin
ARemark := jo.S['Remark'];
ARemarkTel := jo.S['Phone'];
ARemarkMobile := jo.S['Mobile'];
end;
Friend.HasCamera := RealICQUser.InstalledCamera;
Friend.Watchword := RealICQUser.Watchword;
Friend.LeaveMessage := RealICQUser.LeaveMessage;
Friend.HasTelephone := (Length(Trim(ARemarkTel)) > 0) or (Length(Trim(RealICQUser.Tel)) > 0) or (Length(Trim(RealICQUser.Mobile)) > 0);
Friend.TelephoneHint := '';
if Length(Trim(ARemarkTel)) > 0 then
begin
Friend.TelephoneHint := Friend.TelephoneHint + '备注:' + Trim(ARemarkTel);
end;
if Length(Trim(RealICQUser.Tel)) > 0 then
begin
if Length(Trim(Friend.TelephoneHint)) > 0 then
Friend.TelephoneHint := Friend.TelephoneHint + ' ';
Friend.TelephoneHint := Friend.TelephoneHint + '电话:' + Trim(RealICQUser.Tel);
end;
if Length(Trim(RealICQUser.Mobile)) > 0 then
begin
if Length(Trim(Friend.TelephoneHint)) > 0 then
Friend.TelephoneHint := Friend.TelephoneHint + ' ';
Friend.TelephoneHint := Friend.TelephoneHint + '手机:' + Trim(RealICQUser.Mobile);
end;
Friend.HasMobilePhone := False;
Friend.HasEmail := (Length(Trim(RealICQUser.Email)) > 0);
Friend.HasSMS := (Length(Trim(RealICQUser.Mobile)) > 0);
if not Friend.HasTelephone then
Friend.HasTelephone := Friend.HasSMS;
Friend.Mobile := Trim(RealICQUser.Mobile);
Friend.Tel := Trim(RealICQUser.Tel);
if Length(Trim(ARemarkMobile)) > 0 then
Friend.MobilePhoneHint := Trim(ARemarkMobile)
else
Friend.MobilePhoneHint := Trim(RealICQUser.Mobile);
Friend.HeadImageHint := '单击显示联系人卡片';
Friend.TelephoneHint := Friend.TelephoneHint;
Friend.EmailHint := Trim(RealICQUser.Email) + '(双击发送邮件)';
Friend.SMSHint := Trim(Friend.MobilePhoneHint) + '(双击发送手机短信息)';
Friend.CameraHint := '双击发送视频对话邀请';
if (RealICQClient.EnableSecretLevel) and (RealICQUser.Secret = slAllCannotSee) then
begin
Friend.TelephoneHint := '*';
Friend.MobilePhoneHint := '*';
Friend.SMSHint := '*';
end;
if FileExists(RealICQUser.HeadImageFile) then
begin
try
if (RealICQUser.HeadImageFileType = htGIF) then
begin
GIFImage := TGIFImage.Create;
GIFImage.Animate := False;
try
GIFImage.LoadFromFile(RealICQUser.HeadImageFile);
Friend.HeadImagePicture.Bitmap.Assign(GIFImage);
finally
GIFImage.Free;
end;
end
else
Friend.HeadImagePicture.LoadFromFile(RealICQUser.HeadImageFile);
except
Friend.HeadImagePicture.Graphic := nil;
end;
end
else
Friend.HeadImagePicture.Graphic := nil;
Friend.DisplayName := RealICQUser.DisplayName;
Friend.LoginState := RealICQUser.LoginState;
Friend.Data := RealICQUser;
if ANeedFlash then
Friend.Update;
end;
//------------------------------------------------------------------------------
procedure TMainForm.UpdateEmployeeNode(Employee: TRealICQEmployee; RealICQUser: TRealICQUser; ANeedFlash: Boolean);
var
GIFImage: TGIFImage;
jo: ISuperObject;
ARemarkTel, ARemarkMobile, ARemark: string;
begin
jo := TUserRemarkService.GetService.GetUserRemark(RealICQUser.LoginName);
if jo <> nil then
begin
ARemark := jo.S['Remark'];
ARemarkTel := jo.S['Phone'];
ARemarkMobile := jo.S['Mobile'];
end;
Employee.HasCamera := RealICQUser.InstalledCamera;
Employee.Watchword := RealICQUser.Watchword;
Employee.LeaveMessage := RealICQUser.LeaveMessage;
Employee.HasNewSNS := ShowSNS and RealICQUser.HasNewSNSUpdate;
Employee.NewSNSHint := '个人空间最近有更新，点击查看';
Employee.HasTelephone := (Length(Trim(ARemarkTel)) > 0) or (Length(Trim(ARemarkTel)) > 0) or (Length(Trim(RealICQUser.Mobile)) > 0);
Employee.TelephoneHint := '';
if Length(Trim(ARemarkTel)) > 0 then
begin
Employee.TelephoneHint := Employee.TelephoneHint + '备注:' + Trim(ARemarkTel);
end;
if Length(Trim(RealICQUser.Tel)) > 0 then
begin
if Length(Trim(Employee.TelephoneHint)) > 0 then
Employee.TelephoneHint := Employee.TelephoneHint + ' ';
Employee.TelephoneHint := Employee.TelephoneHint + '电话:' + Trim(RealICQUser.Tel);
end;
if Length(Trim(RealICQUser.Mobile)) > 0 then
begin
if Length(Trim(Employee.TelephoneHint)) > 0 then
Employee.TelephoneHint := Employee.TelephoneHint + ' ';
Employee.TelephoneHint := Employee.TelephoneHint + '手机:' + Trim(RealICQUser.Mobile);
end;
Employee.HasMobilePhone := False;
Employee.HasSMS := (Length(Trim(RealICQUser.Mobile)) > 0);
Employee.Tel := Trim(RealICQUser.Tel);
Employee.Mobile := Trim(RealICQUser.Mobile);
if Length(Trim(ARemarkMobile)) > 0 then
Employee.MobilePhoneHint := Trim(ARemarkMobile)
else
Employee.MobilePhoneHint := Trim(RealICQUser.Mobile);
Employee.HeadImageHint := '单击显示联系人卡片';
Employee.TelephoneHint := Trim(Employee.TelephoneHint);
Employee.AddFriendHint := '双击添加好友';
Employee.EmailHint := Trim(RealICQUser.Email) + '(双击发送邮件)';
Employee.SMSHint := Employee.MobilePhoneHint + '(双击发送手机短信息)';
Employee.CameraHint := '双击发送视频对话邀请';
if (RealICQClient.EnableSecretLevel) and (RealICQUser.Secret = slAllCannotSee) and (Employee.LoginName <> MainForm.RealICQClient.Me.LoginName) then
begin
Employee.TelephoneHint := '*';
Employee.MobilePhoneHint := '*';
Employee.SMSHint := '*';
end;
if (RealICQClient.EnableSecretLevel) and (RealICQUser.Secret = slOnlyFriendCanSee) and not (TUsersService.GetUsersService.IsWorkmateOrFriend(Employee.LoginName)) then
begin
Employee.TelephoneHint := '*';
Employee.MobilePhoneHint := '*';
Employee.SMSHint := '*';
end;
if FileExists(RealICQUser.HeadImageFile) then
begin
try
if (RealICQUser.HeadImageFileType = htGIF) then
begin
GIFImage := TGIFImage.Create;
GIFImage.Animate := False;
try
GIFImage.LoadFromFile(RealICQUser.HeadImageFile);
Employee.HeadImagePicture.Bitmap.Assign(GIFImage);
finally
GIFImage.Free;
end;
end
else
Employee.HeadImagePicture.LoadFromFile(RealICQUser.HeadImageFile);
except
Employee.HeadImagePicture.Graphic := nil;
end;
end
else
Employee.HeadImagePicture.Graphic := nil;
Employee.DisplayName := RealICQUser.DisplayName;
Employee.LoginState := RealICQUser.LoginState;
Employee.Data := RealICQUser;
if (FMeUserType = lbutCompany) and (TLBUserViewService.GetService.GetUserType(RealICQUser.LoginName) = lbutCompany) then
begin
Employee.TelephoneHint := '*';
Employee.MobilePhoneHint := '*';
Employee.SMSHint := '*';
end;
if ANeedFlash then
Employee.Update;
end;
//------------------------------------------------------------------------------
procedure TMainForm.BindUserDataToItem(RealICQContacterListItem: TRealICQContacterListItem; RealICQUser: TRealICQUser; ANeedFlash: Boolean = True);
var
GIFImage: TGIFImage;
jo: ISuperObject;
ARemarkTel, ARemarkMobile, ARemark: string;
begin
jo := TUserRemarkService.GetService.GetUserRemark(RealICQUser.LoginName);
if jo <> nil then
begin
ARemark := jo.S['Remark'];
ARemarkTel := jo.S['Phone'];
ARemarkMobile := jo.S['Mobile'];
end;
RealICQContacterListItem.HasCamera := RealICQUser.InstalledCamera;
RealICQContacterListItem.Watchword := RealICQUser.Watchword;
RealICQContacterListItem.LeaveMessage := RealICQUser.LeaveMessage;
RealICQContacterListItem.Branch := RealICQUser.Branch;
RealICQContacterListItem.HasTelephone := (Length(Trim(ARemarkTel)) > 0) or (Length(Trim(RealICQUser.Tel)) > 0) or (Length(Trim(RealICQUser.Mobile)) > 0);
RealICQContacterListItem.TelephoneHint := '';
if Length(Trim(ARemarkTel)) > 0 then
begin
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '备注:' + Trim(ARemarkTel);
end;
if Length(Trim(RealICQUser.Tel)) > 0 then
begin
if Length(Trim(RealICQContacterListItem.TelephoneHint)) > 0 then
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + ' ';
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '电话:' + Trim(RealICQUser.Tel);
end;
if Length(Trim(RealICQUser.Mobile)) > 0 then
begin
if Length(Trim(RealICQContacterListItem.TelephoneHint)) > 0 then
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + ' ';
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '手机:' + Trim(RealICQUser.Mobile);
end;
RealICQContacterListItem.HasMobilePhone := (Length(Trim(RealICQUser.Mobile)) > 0) or (Length(Trim(ARemarkMobile)) > 0);
RealICQContacterListItem.HasEmail := (Length(Trim(RealICQUser.Email)) > 0);
RealICQContacterListItem.HasSMS := RealICQContacterListItem.HasMobilePhone;
RealICQContacterListItem.HeadImageHint := '单击显示联系人卡片';
if Length(Trim(ARemarkMobile)) > 0 then
RealICQContacterListItem.MobilePhoneHint := Trim(ARemarkMobile)
else
RealICQContacterListItem.MobilePhoneHint := Trim(RealICQUser.Mobile);
RealICQContacterListItem.Mobile := Trim(RealICQUser.Mobile);
RealICQContacterListItem.Tel := Trim(RealICQUser.Tel);
RealICQContacterListItem.HasMobilePhone := False;
RealICQContacterListItem.MobilePhoneHint := RealICQContacterListItem.MobilePhoneHint + '(双击发送手机短信息)';
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint;
RealICQContacterListItem.EmailHint := Trim(RealICQUser.Email) + '(双击发送邮件)';
RealICQContacterListItem.SMSHint := RealICQContacterListItem.MobilePhoneHint;
RealICQContacterListItem.CameraHint := '双击发送视频对话邀请';
RealICQContacterListItem.HasTelephone := RealICQContacterListItem.HasTelephone and RealICQContacterListItem.ListView.ShowTelButton;
RealICQContacterListItem.HasMobilePhone := RealICQContacterListItem.HasMobilePhone and RealICQContacterListItem.ListView.ShowMobileButton;
RealICQContacterListItem.HasEmail := RealICQContacterListItem.HasEmail and RealICQContacterListItem.ListView.ShowEmailButton;
RealICQContacterListItem.HasSMS := RealICQContacterListItem.HasSMS and RealICQContacterListItem.ListView.ShowSMSButton;
if FileExists(RealICQUser.HeadImageFile) then
begin
try
if (RealICQUser.HeadImageFileType = htGIF) then
begin
GIFImage := TGIFImage.Create;
GIFImage.Animate := False;
try
GIFImage.LoadFromFile(RealICQUser.HeadImageFile);
RealICQContacterListItem.HeadImagePicture.Bitmap.Assign(GIFImage);
finally
GIFImage.Free;
end;
end
else
RealICQContacterListItem.HeadImagePicture.LoadFromFile(RealICQUser.HeadImageFile);
except
RealICQContacterListItem.HeadImagePicture.Graphic := nil;
end;
end
else
RealICQContacterListItem.HeadImagePicture.Graphic := nil;
RealICQContacterListItem.DisplayName := RealICQUser.DisplayName;
RealICQContacterListItem.LoginState := RealICQUser.LoginState;
RealICQContacterListItem.Data := RealICQUser;
if ANeedFlash then
RealICQContacterListItem.ReDrawItem;
end;
procedure TMainForm.BindUserDataToItemForGroup(RealICQContacterListItem: TRealICQContacterListItem; RealICQUser: TRealICQUser; AGroupAlias: string; ANeedFlash: Boolean);
var
GIFImage: TGIFImage;
jo: IsuperObject;
ARemarkTel, ARemarkMobile, ARemark: string;
begin
jo := TUserRemarkService.GetService.GetUserRemark(RealICQUser.LoginName);
if jo <> nil then
begin
ARemark := jo.S['Remark'];
ARemarkTel := jo.S['Phone'];
ARemarkMobile := jo.S['Mobile'];
end;
RealICQContacterListItem.HasCamera := RealICQUser.InstalledCamera;
RealICQContacterListItem.Watchword := RealICQUser.Watchword;
RealICQContacterListItem.LeaveMessage := RealICQUser.LeaveMessage;
RealICQContacterListItem.Branch := RealICQUser.Branch;
RealICQContacterListItem.HasTelephone := (Length(Trim(ARemarkTel)) > 0) or (Length(Trim(RealICQUser.Tel)) > 0) or (Length(Trim(RealICQUser.Mobile)) > 0);
RealICQContacterListItem.TelephoneHint := '';
if Length(Trim(ARemarkTel)) > 0 then
begin
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '备注:' + Trim(ARemarkTel);
end;
if Length(Trim(RealICQUser.Tel)) > 0 then
begin
if Length(Trim(RealICQContacterListItem.TelephoneHint)) > 0 then
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + ' ';
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '电话:' + Trim(RealICQUser.Tel);
end;
if Length(Trim(RealICQUser.Mobile)) > 0 then
begin
if Length(Trim(RealICQContacterListItem.TelephoneHint)) > 0 then
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + ' ';
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint + '手机:' + Trim(RealICQUser.Mobile);
end;
RealICQContacterListItem.HasMobilePhone := (Length(Trim(RealICQUser.Mobile)) > 0) or (Length(Trim(ARemarkMobile)) > 0);
RealICQContacterListItem.HasEmail := (Length(Trim(RealICQUser.Email)) > 0);
RealICQContacterListItem.HasSMS := RealICQContacterListItem.HasMobilePhone;
RealICQContacterListItem.HeadImageHint := '单击显示联系人卡片';
if Length(Trim(ARemarkMobile)) > 0 then
RealICQContacterListItem.MobilePhoneHint := Trim(ARemarkMobile)
else
RealICQContacterListItem.MobilePhoneHint := Trim(RealICQUser.Mobile);
RealICQContacterListItem.Mobile := Trim(RealICQUser.Mobile);
RealICQContacterListItem.Tel := Trim(RealICQUser.Tel);
RealICQContacterListItem.HasMobilePhone := False;
RealICQContacterListItem.MobilePhoneHint := RealICQContacterListItem.MobilePhoneHint + '(双击发送手机短信息)';
RealICQContacterListItem.TelephoneHint := RealICQContacterListItem.TelephoneHint;
RealICQContacterListItem.EmailHint := Trim(RealICQUser.Email) + '(双击发送邮件)';
RealICQContacterListItem.SMSHint := RealICQContacterListItem.MobilePhoneHint;
RealICQContacterListItem.CameraHint := '双击发送视频对话邀请';
RealICQContacterListItem.HasTelephone := RealICQContacterListItem.HasTelephone and RealICQContacterListItem.ListView.ShowTelButton;
RealICQContacterListItem.HasMobilePhone := RealICQContacterListItem.HasMobilePhone and RealICQContacterListItem.ListView.ShowMobileButton;
RealICQContacterListItem.HasEmail := RealICQContacterListItem.HasEmail and RealICQContacterListItem.ListView.ShowEmailButton;
RealICQContacterListItem.HasSMS := RealICQContacterListItem.HasSMS and RealICQContacterListItem.ListView.ShowSMSButton;
if FileExists(RealICQUser.HeadImageFile) then
begin
try
if (RealICQUser.HeadImageFileType = htGIF) then
begin
GIFImage := TGIFImage.Create;
GIFImage.Animate := False;
try
GIFImage.LoadFromFile(RealICQUser.HeadImageFile);
RealICQContacterListItem.HeadImagePicture.Bitmap.Assign(GIFImage);
finally
GIFImage.Free;
end;
end
else
RealICQContacterListItem.HeadImagePicture.LoadFromFile(RealICQUser.HeadImageFile);
except
RealICQContacterListItem.HeadImagePicture.Graphic := nil;
end;
end
else
RealICQContacterListItem.HeadImagePicture.Graphic := nil;
RealICQContacterListItem.DisplayName := AGroupAlias; //RealICQUser.DisplayName;
RealICQContacterListItem.LoginState := RealICQUser.LoginState;
RealICQContacterListItem.Data := RealICQUser;
if ANeedFlash then
RealICQContacterListItem.ReDrawItem;
end;
}
//------------------------------------------------------------------------------
procedure TMainForm.btCloseTopMessageClick(Sender: TObject);
begin
pnlForTopMessage.Visible := False;
FTopSystemMessage := nil;
end;
procedure TMainForm.btCustomerDisplayNameClick(Sender: TObject);
var
Point: TPoint;
begin
Point.X := 0;
Point.Y := btCustomerDisplayName.Height + 1;
Point := btCustomerDisplayName.ClientToScreen(Point);
ppChangeCustomerState.Popup(Point.X, Point.Y);
end;
procedure TMainForm.btLoginClick(Sender: TObject);
var
ca: ICAClient;
b: Boolean;
begin
if RealICQClient.Logining then
RealICQClient.CancelLogin
else if RealICQClient.ReConnectExecuting then
RealICQClient.CancelReConnectAndLogin
else if actLoginAs.Visible and actLoginAs.Enabled and FLoginAsSavePassword then
begin
actLoginAs.Execute
end
else if RealICQClient.Logined then
begin
RealICQClient.Logout;
end
else
begin
if RealICQClient.CaEnable and RealICQClient.CALogin then
begin
b := actLoginAs.Enabled;
actLoginAs.Enabled := true;
actLoginAs.Execute;
actLoginAs.Enabled := b;
Exit;
end;
if Length(Trim(edLoginName.Text)) = 0 then
begin
MessageBox(Handle, '请输入用户名！', '提示', MB_ICONINFORMATION);
Exit;
end;
if Length(edPassword.Text) = 0 then
begin
MessageBox(Handle, '请输入密码！', '提示', MB_ICONINFORMATION);
Exit;
end;
RealICQClient.AutoLogin := FAutoLogin;
RealICQClient.Login(Trim(edLoginName.Text), edPassword.Text, FLoginState, FLeaveMessage, FSavePassword, False, False);
end;
end;
procedure TMainForm.btMainMenuClick(Sender: TObject);
var
Point: TPoint;
begin
edtSearchMoreUser.Text := '';
Point.X := 24;
Point.Y := btMainMenu.top;
Point := btMainMenu.ClientToScreen(Point);
ppMainMenu.Popup(Point.X, Point.Y - GetSystemMetrics(SM_CYMENU) * 8);
end;
procedure TMainForm.btnCALoginClick(Sender: TObject);
begin
RealICQClient.CALogin := not RealICQClient.CALogin;
// if RealICQClient.CALogin then
// begin
// ImgLstCheckStates.GetIcon(1, btnCaLogin.Icon);
//// edLoginName.Text := CA_TEXT;
// edLoginName.Enabled := False;
// edPassword.Enabled := False;
// spbChangeLoginName.Enabled := False;
// end
// else
// begin
// ImgLstCheckStates.GetIcon(0, btnCaLogin.Icon);
//// edLoginName.Text := '';
// edLoginName.Enabled := True;
// edPassword.Enabled := True;
// spbChangeLoginName.Enabled := True;
// end;
SetLoginStateControlState;
end;
//------------------------------------------------------------------------------
procedure TMainForm.cbxURLInputerDropDown(Sender: TObject);
var
iLoop: Integer;
Items: TStringList;
begin
Items := TStringList.Create;
try
GetIEHistory(Items);
cbxURLInputer.ItemsEx.Clear;
for iLoop := 0 to Items.Count - 1 do
begin
with cbxURLInputer.ItemsEx.Add do
begin
Caption := Items.Strings[iLoop];
if (Copy(Caption, 1, 5) = 'file:') or (Copy(Caption, 2, 1) = ':') then
ImageIndex := 2
else if Copy(Caption, 1, 4) = 'ftp:' then
ImageIndex := 1
else
ImageIndex := 0;
end;
end;
finally
Items.Free;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.cbxURLInputerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = 13 then
spbGoClick(spbGo);
end;
//------------------------------------------------------------------------------
procedure TMainForm.cbxURLInputerSelect(Sender: TObject);
begin
spbGoClick(spbGo);
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetStyleMenuChecked;
begin
case FLVStyle of
lsBigHeadImage:
actShowBigHeadImage.Checked := True;
lsMiddleHeadImage:
actShowMiddleHeadImage.Checked := True;
lsSmallHeadImage:
actShowSmallHeadImage.Checked := True;
lsNoHeadImage:
actShowNormalHeadImage.Checked := True;
end;
case FLVCaptionStyle of
csDisplayName:
actShowDisplayName.Checked := True;
csLoginName:
actShowLoginName.Checked := True;
csDisplayNameAndLoginName:
actShowAllName.Checked := True;
end;
actShowRemark.Checked := RealICQClient.ShowRemark;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetLoginStateMenuChecked;
var
LeaveMsg: string;
begin
actOnline.Checked := False;
actHidden.Checked := False;
actOffline.Checked := False;
actBusy.Checked := False;
actMute.Checked := False;
actLeave.Checked := False;
actRepast.Checked := False;
actPhone.Checked := False;
actMeeting.Checked := False;
actOtherState.Checked := False;
if RealICQClient.Me = nil then
begin
actOffline.Checked := True;
Exit;
end;
LeaveMsg := RealICQClient.Me.LeaveMessage;
if RealICQClient.Me.LoginState = stOnline then
actOnline.Checked := True
else if RealICQClient.Me.LoginState = stHidden then
actHidden.Checked := True
else if RealICQClient.Me.LoginState = stLeave then
begin
if AnsiSameText(actLeave.Caption, LeaveMsg) then
actLeave.Checked := True
else if AnsiSameText(actRepast.Caption, LeaveMsg) then
actRepast.Checked := True
else if AnsiSameText(actMeeting.Caption, LeaveMsg) then
actMeeting.Checked := True
else
actOtherState.Checked := True;
end
else if RealICQClient.Me.LoginState = stBusy then
begin
if AnsiSameText(actBusy.Caption, LeaveMsg) then
actBusy.Checked := True
else if AnsiSameText(actPhone.Caption, LeaveMsg) then
actPhone.Checked := True
else
actOtherState.Checked := True;
end
else if RealICQClient.Me.LoginState = stMute then
actMute.Checked := True
else
actOtherState.Checked := True;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ShowMeInformation;
var
ADisplayName, ATrueDisplayName, AWatchword, AStateMsg: WideString;
HeadPic: TPicture;
GIFImage: TGIFImage;
begin
if RealICQClient.Me = nil then
Exit;
if FNotReadMessages.Count = 0 then
begin
case RealICQClient.Me.LoginState of
stOffline:
TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Offline.ico');
stOnline:
TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Online.ico');
stLeave:
TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\leave.ico');
stBusy:
TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Busy.ico');
stMute:
TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\Mute.ico');
stHidden:
TrayIcon.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\TrayIcon\invisible.ico');
end;
TrayIcon.SetDefaultIcon;
end;
if FileExists(RealICQClient.Me.HeadImageFile) then
begin
try
if (RealICQClient.Me.HeadImageFileType = htGIF) then
begin
GIFImage := TGIFImage.Create;
GIFImage.Animate := FShowGIFInMailForm and (RealICQClient.Me.LoginState <> stHidden);
try
GIFImage.LoadFromFile(RealICQClient.Me.HeadImageFile);
if GIFImage.Animate then
imgHead.Picture.Assign(GIFImage)
else
imgHead.Picture.Bitmap.Assign(GIFImage);
finally
GIFImage.Free;
end;
end
else
imgHead.Picture.LoadFromFile(RealICQClient.Me.HeadImageFile);
except
imgHead.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBig);
end;
end
else
begin
imgHead.Picture.LoadFromFile(ExtractFilePath(Application.ExeName) + DefaultPictureBig);
end;
{if RealICQClient.Me.LoginState = stHidden then
begin
HeadPic := TPicture.Create;
try
HeadPic.Bitmap.Assign(imgHead.Picture.Graphic);
Grayscale(HeadPic.Bitmap);
imgHead.Picture.Bitmap.Assign(HeadPic.Bitmap);
finally
HeadPic.Free;
end;
end;
imgLeave.Visible := False;}
case RealICQClient.Me.LoginState of
stOffline:
spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\Offline.ico');
stOnline:
spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\Online.ico');
stLeave:
spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\away.ico');
stBusy:
spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\Busy.ico');
stMute:
spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\Mute.ico');
stHidden:
spbDisplayName.Icon.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Images\State\Big\invisible.ico');
end;
if (RealICQClient.Me.LoginState = stLeave) or (RealICQClient.Me.LoginState = stBusy) then
AStateMsg := RealICQClient.Me.LeaveMessage
else
begin
if RealICQClient.Me.LoginState = stMobileOnline then
AStateMsg := StateValues[Integer(RealICQClient.Me.LoginState)]
else
AStateMsg := StateValues[Integer(RealICQClient.Me.LoginState) mod 5];
end;
ATrueDisplayName := RealICQClient.Me.Nickname;
ADisplayName := ATrueDisplayName + '（' + AStateMsg + '）';
spbDisplayName.Hint := ADisplayName;
spbDisplayName.ShowHint := False;
TrayIcon.Hint := Application.Title + ' - ' + ADisplayName;
AWatchword := RealICQClient.Me.Watchword;
if Length(Trim(AWatchword)) = 0 then
AWatchword := '在此键入您的个性签名';
spbWatchword.Hint := AWatchword;
spbWatchword.ShowHint := False;
btn_lock_DisplayName.Caption := ADisplayName; // + Format('(%s)', [StateValues[Integer(RealICQClient.Me.LoginState)]]);
btn_lock_DisplayName.AutoSize := False;
btn_lock_DisplayName.AutoSize := True;
btn_lock_DisplayName.Update;
img_lock_HeadPrev.Picture := imgHead.Picture;
//字符串长度过长时,截短字符串并在后面显示“...”
while spbDisplayName.Canvas.TextWidth(ADisplayName) > pnlTop.Width - 86 do
begin
if Length(ATrueDisplayName) > 3 then
begin
if Copy(ATrueDisplayName, Length(ATrueDisplayName) - 2, Length(ATrueDisplayName)) = '...' then
ATrueDisplayName := Copy(ATrueDisplayName, 1, Length(ATrueDisplayName) - 3);
ATrueDisplayName := Copy(ATrueDisplayName, 1, Length(ATrueDisplayName) - 1) + '...';
end
else if Length(AStateMsg) > 3 then
begin
if Copy(AStateMsg, Length(AStateMsg) - 2, Length(AStateMsg)) = '...' then
AStateMsg := Copy(AStateMsg, 1, Length(AStateMsg) - 3);
AStateMsg := Copy(AStateMsg, 1, Length(AStateMsg) - 1) + '...';
end
else
break;
ADisplayName := ATrueDisplayName + '（' + AStateMsg + '）';
spbDisplayName.ShowHint := True;
end;
//字符串长度过长时,截短字符串并在后面显示“...”
while spbWatchword.Canvas.TextWidth(AWatchword) > pnlTop.Width - 86 do
begin
if Length(AWatchword) > 3 then
begin
if Copy(AWatchword, Length(AWatchword) - 2, Length(AWatchword)) = '...' then
AWatchword := Copy(AWatchword, 1, Length(AWatchword) - 3);
AWatchword := Copy(AWatchword, 1, Length(AWatchword) - 1) + '...';
end
else
break;
spbWatchword.ShowHint := True;
end;
spbDisplayName.Caption := ADisplayName;
spbWatchword.Caption := AWatchword;
edWatchword.Text := RealICQClient.Me.Watchword;
if OptionsForm <> nil then
begin
OptionsForm.ShowHeadImage;
OptionsForm.GetSets;
//OptionsForm.GetPersonalSet;
end;
SetLoginStateMenuChecked;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGetDBProcedureResult(Sender: TObject; DBProcedureName, ArgIn, ArgOut: string);
var
WebPanel: TWebPanel;
WebTabAcount: TWebTabAcount;
StrList1, StrList2: TStringList;
iLoop, iIndex: Integer;
begin
if AnsiSameText(DBProcedureName, 'YJ_AddTempRemark') then
begin
ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(MainForm.RealICQClient.WebAppBaseURL + LoginURL, [StrToBase64(MainForm.RealICQClient.LoginName), StrToBase64(MD5En(MainForm.RealICQClient.Password)), StrToBase64(Format(AddRemarkURL, [ArgOut]))])), '', SW_SHOWDEFAULT);
end;
if AnsiSameText(DBProcedureName, 'GetWebTabAcounts') then
begin
StrList1 := SplitString(ArgOut, Chr(13));
for iLoop := 0 to StrList1.Count - 1 do
begin
if StrList1.Strings[iLoop] = '' then
Continue;
StrList2 := SplitString(StrList1.Strings[iLoop], Chr(10));
WebTabAcount := TWebTabAcount.Create;
try
WebTabAcount.FWebTabID := StrToInt(StrList2.Strings[0]);
WebTabAcount.FTitle := StrList2.Strings[1];
WebTabAcount.LoginName := StrList2.Strings[2];
WebTabAcount.FPassword := StrList2.Strings[3];
WebTabAcount.FExplain := StrList2.Strings[4];
iIndex := FWebPanels.IndexOf(IntToStr(WebTabAcount.FWebTabID));
if iIndex >= 0 then
begin
WebPanel := FWebPanels.Objects[iIndex] as TWebPanel;
WebPanel.FAcounts.Add(WebTabAcount);
end;
except
FreeAndNil(WebTabAcount);
end;
end;
end;
end;
procedure TMainForm.RealICQClientGetNotReadMessageCount(Sender: TObject; iCount: Integer);
begin
spbShowNotReadMessage.Caption := Format('(%d)', [iCount]);
end;
procedure TMainForm.RealICQClientGetSystemNoticesCount(Sender: TObject; iCount: Integer; NoticesRecords: array of TSystemNotices);
var
iLoop: Integer;
ANoticesRecord: TSystemNotices;
begin
FLastGetSystemNoticesTicket := GetTickCount;
while FSystemNotices.Count > 0 do
begin
ANoticesRecord := FSystemNotices[0];
FSystemNotices.Delete(0);
try
FreeAndNil(ANoticesRecord);
except
end;
end;
for iLoop := Low(NoticesRecords) to High(NoticesRecords) do
begin
ANoticesRecord := NoticesRecords[iLoop];
FSystemNotices.Add(ANoticesRecord);
end;
pnlForTopMessage.Visible := iCount > 0;
TimerForShowSystemNotices.Enabled := pnlForTopMessage.Visible;
FSystemNoticeIndex := 0;
if pnlForTopMessage.Visible then
begin
ShowSystemNotices;
end;
end;
procedure TMainForm.TimerForShowSystemNoticesTimer(Sender: TObject);
begin
TimerForShowSystemNotices.Enabled := pnlForTopMessage.Visible;
btNextLogClick(nil);
if GetTickCount - FLastGetSystemNoticesTicket > 60000 * 30 then
begin
TimerForShowSystemNotices.Enabled := False;
RealICQClient.SendGetNewInformation(1);
end;
end;
procedure TMainForm.ShowSystemNotices;
var
ANoticesRecord: TSystemNotices;
begin
ANoticesRecord := FSystemNotices[FSystemNoticeIndex];
while ANoticesRecord.EndDate < Now do
begin
FSystemNotices.Delete(FSystemNoticeIndex);
FreeAndNil(ANoticesRecord);
if FSystemNotices.Count > 0 then
begin
if FSystemNoticeIndex >= FSystemNotices.Count then
FSystemNoticeIndex := FSystemNotices.Count - 1;
if FSystemNoticeIndex < 0 then
FSystemNoticeIndex := 0;
ANoticesRecord := FSystemNotices[FSystemNoticeIndex];
end
else
begin
pnlForTopMessage.Visible := False;
TimerForShowSystemNotices.Enabled := False;
Exit;
end;
end;
lblLogsTitle.Caption := Format('系统公告(%d/%d)', [FSystemNoticeIndex + 1, FSystemNotices.Count]);
lblLogs.Caption := ANoticesRecord.Title;
lblLogs.Hint := ANoticesRecord.Title + '(有效期：' + DateTimeToStr(ANoticesRecord.EndDate) + ')';
TimerForShowSystemNotices.Enabled := False;
TimerForShowSystemNotices.Enabled := FSystemNotices.Count > 0;
end;
procedure TMainForm.btNextLogClick(Sender: TObject);
begin
Inc(FSystemNoticeIndex, 1);
if FSystemNoticeIndex >= FSystemNotices.Count then
FSystemNoticeIndex := 0;
ShowSystemNotices;
end;
procedure TMainForm.btn_lockClick(Sender: TObject);
var
iLoop: Integer;
AForm: TSMSForm;
begin
if Assigned(MessageBoxForm) then
MessageBoxForm.Hide;
if Assigned(MessagesManagerForm) then
MessagesManagerForm.Visible := False;
if Assigned(SearchForm) then
SearchForm.Visible := False;
for iLoop := SMSForms.Count - 1 downto 0 do
begin
AForm := SMSForms[iLoop];
AForm.Visible := False;
end;
pnlLocked.Visible := True;
pnlLocked.BringToFront;
ChangeTalkingFormVisible(False);
end;
procedure TMainForm.btn_unlockClick(Sender: TObject);
var
APassword: string;
iLoop: Integer;
AForm: TSMSForm;
begin
actOpenMainForm.Execute;
APassword := ShowMyInputBox(PChar('解锁'), PChar('请输入您的登录密码以解除锁定状态！ '), '', 32);
if Trim(APassword) = '' then
Exit;
if AnsiSameText(APassword, MainForm.RealICQClient.Password) then
begin
ChangeTalkingFormVisible(True);
pnlLocked.Visible := False;
pnlMiddleClient.Visible := RealICQClient.Logined and RealICQClient.Connected;
if Assigned(MessagesManagerForm) then
MessagesManagerForm.Visible := True;
if Assigned(SearchForm) then
SearchForm.Visible := True;
for iLoop := SMSForms.Count - 1 downto 0 do
begin
AForm := SMSForms[iLoop];
AForm.Visible := True;
end;
end
else
begin
showmessage('您输入的密码有误! ');
end;
end;
procedure TMainForm.btPrevLogClick(Sender: TObject);
begin
Dec(FSystemNoticeIndex, 1);
if FSystemNoticeIndex < 0 then
FSystemNoticeIndex := FSystemNotices.Count - 1;
ShowSystemNotices;
end;
procedure TMainForm.spbShowNotReadMessageClick(Sender: TObject);
begin
{ if MessageBoxForm=nil then
begin
MessageBoxForm:=TMessageBoxForm.Create(self);
end;
MessageBoxForm.Show; }
if FNewConsole then
ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + NewBaseURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(InBoxURL)])), '', SW_SHOWDEFAULT)
else
ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + BaseURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(InBoxURL)])), '', SW_SHOWDEFAULT);
end;
//----------------------------------------------
procedure TMainForm.OpenNewWorkDisk(Path: string);
var
UserInfo: string;
C: TCopyDataStruct;
hwnd: THandle;
begin
WinExec(PChar(ExtractFilePath(Application.ExeName) + Path), sw_show);
UserInfo := RealICQClient.LoginName + #10 + RealICQClient.Password;
with c do
begin
dwData := WM_COPYDATA;
lpData := PChar(UserInfo + #0);
cbData := Length(UserInfo) + 2;
end;
hWnd := FindWindow(pchar('TMainForm'), pchar('网络存储'));
if hWnd <> 0 then
SendMessage(hwnd, WM_COPYDATA, 0, integer(@c));
end;
//---------------------------------------------------
procedure TMainForm.SaveBranchUserDataToXML(FileName: string);
var
iLoop: Integer;
XMLDocument: TXMLDocument;
Nodes, BranchsNode, BranchNode, UsersNode, UserNode: IXMLNode;
BranchInfo: TRealICQBranchInfo;
RealICQUser: TRealICQUser;
LoginName: string;
AUsers: TStringList;
begin
XMLDocument := TXMLDocument.Create(Self);
try
try
XMLDocument.Active := True;
if not FileExists(FileName) then
begin
XMLDocument.XML.Text := '' + '' + '' + '' + '';
XMLDocument.Active := True;
end
else
begin
XMLDocument.LoadFromFile(FileName);
end;
Nodes := XMLDocument.DocumentElement;
BranchsNode := Nodes.ChildNodes.Get(0);
UsersNode := Nodes.ChildNodes.Get(1);
BranchsNode.ChildNodes.Clear;
UsersNode.ChildNodes.Clear;
for iLoop := 0 to self.RealICQClient.Branchs.Count - 1 do
begin
BranchInfo := RealICQClient.Branchs.Objects[iLoop] as TRealICQBranchInfo;
BranchNode := BranchsNode.AddChild('Branch');
BranchNode.Attributes['ID'] := BranchInfo.ID;
BranchNode.Attributes['Name'] := BranchInfo.BranchName;
BranchNode.Attributes['ParentID'] := BranchInfo.ParentID;
end;
AUsers := TUsersService.GetUsersService.GetWorkmatesAndFriends;
try
for iLoop := 0 to AUsers.Count - 1 do
begin
RealICQUser := AUsers.Objects[iLoop] as TRealICQUser;
LoginName := RealICQUser.LoginName;
if AnsiPos('+', LoginName) > 0 then
LoginName := Copy(LoginName, AnsiPos('+', LoginName) + 1, Length(LoginName) - AnsiPos('+', LoginName));
UserNode := UsersNode.AddChild('User');
UserNode.Attributes['LoginName'] := LoginName;
UserNode.Attributes['DisplayName'] := RealICQUser.DisplayName;
UserNode.Attributes['BranchID'] := RealICQUser.BranchID;
end;
finally
FreeAndNil(AUsers);
end;
XMLDocument.SaveToFile(FileName);
except
on E: Exception do
showmessage(e.Message);
end;
finally
XMLDocument.Free;
end;
end;
//------网络存储-------------------------------------
procedure TMainForm.spbNetworkBackupClick(Sender: TObject);
var
UserInfo, LoginName: string;
C: TCopyDataStruct;
hwnd: THandle;
FilePath: string;
begin
FilePath := ExtractFilePath(paramstr(0)) + 'NetworkBackup\';
SaveBranchUserDataToXml(FilePath + 'BranchUsers.XML');
LoginName := RealICQClient.LoginName;
if AnsiPos('+', LoginName) > 0 then
LoginName := Copy(LoginName, AnsiPos('+', LoginName) + 1, Length(LoginName) - AnsiPos('+', LoginName));
WinExec(PChar(FilePath + 'NetworkBackup.exe ' + LoginName + ' ' + RealICQClient.Password), sw_show);
end;
procedure TMainForm.RealICQClientGettedAudioTransmiteConnectted(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowGettedAudioTransmiteConnectted;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedAudioTransmiteRequest(Sender: TObject; ALoginName: string);
var
AShowActive: Boolean;
TalkingForm: TTalkingForm;
iWaitTimes: Integer;
begin
AShowActive := (RealICQClient.IsAutoState = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌');
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
begin
TalkingForm := OpenTalkingForm(ALoginName, not AShowActive, Sender as TRealICQClient);
end;
iWaitTimes := 0;
while not TalkingForm.CanWriteMessage do
begin
Application.ProcessMessages;
Inc(iWaitTimes);
if iWaitTimes > 1000 then
break;
Sleep(10);
end;
if (GetForegroundWindow <> TalkingForm.Handle) then
begin
FlashWindow(TalkingForm.Handle, True);
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
TalkingForm.ShowGettedAudioTransmiteRequest;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedAudioTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowGettedAudioTransmiteResponse(AAcceptted);
end;
//------显示全市页面查询结果------------------------------------------------------------------------
procedure TMainForm.RealICQClientSearchUserResult(Sender: TObject);
var
iIndex, iLoop: Integer;
ListItem: TRealICQContacterListItem;
RealICQUser: TRealICQUser;
Branch: TRealICQBranch;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
iIndex := FContacterListViews.IndexOf(LVMoreUsers);
FSearchMoreUserListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
for iLoop := 0 to RealICQClient.SearchUsers.Count - 1 do
begin
RealICQUser := RealICQClient.SearchUsers.Objects[iLoop] as TRealICQUser;
iIndex := FSearchMoreUserListView.Items.IndexOf(RealICQUser.LoginName);
if iIndex = -1 then
begin
iIndex := FSearchMoreUserListView.Items.Add(RealICQUser.LoginName);
ListItem := FSearchMoreUserListView.Items.Objects[iIndex] as TRealICQContacterListItem;
ListItem.DisplayName := RealICQUser.DisplayName;
ListItem.LoginState := RealICQUser.LoginState;
ListItem.Data := RealICQUser;
Application.ProcessMessages;
end;
end;
RealICQContacterTreeView := FContacterTreeViews.Objects[FContacterTreeViews.IndexOf(LVMoreUsers)] as TRealICQContacterTreeView;
for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
begin
Branch := RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
if (AnsiPos(UpperCase(RealICQClient.KeyWord), UpperCase(Branch.BranchName)) > 0) or (AnsiPos(UpperCase(RealICQClient.KeyWord), GetPYIndexString(Branch.BranchName)) > 0) then
begin
iIndex := FSearchMoreUserListView.Items.Add(Branch.BranchName);
ListItem := FSearchMoreUserListView.Items.Objects[iIndex] as TRealICQContacterListItem;
ListItem.DisplayName := Branch.BranchName;
ListItem.LoginState := stOnline;
ListItem.StateIndex := 0;
ListItem.Data := Branch;
ListItem.HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + BranchCollapsedBMP);
end;
end;
PostMessage(FSearchMoreUserListView.Handle, WM_SIZE, 0, 0);
ImgLogining.Visible := False;
ScrollBoxSearchMoreUser.Visible := FSearchMoreUserListView.Items.Count > 0;
LblSearchHint.Visible := not ScrollBoxSearchMoreUser.Visible;
LblSearchHint.Caption := '没有找到相关记录';
end;
procedure TMainForm.RealICQClientSendedAudioTransmiteRequest(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowSendedAudioTransmiteRequest;
end;
procedure TMainForm.RealICQClientSendedRemoteControlTransmiteControlRequest(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowSendedRemoteControlTransmiteControlRequest;
end;
procedure TMainForm.RealICQClientSendedRemoteControlTransmiteRequest(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowSendedRemoteControlTransmiteRequest;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedCancelAudioTransmite(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowCanceledAudioTransmite;
end;
procedure TMainForm.RealICQClientGettedCancelRemoteControlTransmite(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowCanceledRemoteControlTransmite;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedStopAudioTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowStoppedAudioTransmite(AIsStopper);
end;
procedure TMainForm.RealICQClientGettedStopRemoteControlTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowStoppedRemoteControlTransmite(AIsStopper);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedVideoTransmiteConnectted(Sender: TObject; ALoginName: string; ASendBigBmp, ARecvBigBmp: Boolean);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowGettedVideoTransmiteConnectted(ASendBigBmp, ARecvBigBmp);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedVideoTransmiteRequest(Sender: TObject; ALoginName: string);
var
AShowActive: Boolean;
TalkingForm: TTalkingForm;
iWaitTimes: Integer;
begin
AShowActive := (RealICQClient.IsAutoState = True) and (RealICQClient.Me.LoginState = stBusy) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌');
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
begin
TalkingForm := OpenTalkingForm(ALoginName, not AShowActive, Sender as TRealICQClient);
end;
iWaitTimes := 0;
while not TalkingForm.CanWriteMessage do
begin
Application.ProcessMessages;
Inc(iWaitTimes);
if iWaitTimes > 1000 then
break;
Sleep(10);
end;
if (GetForegroundWindow <> TalkingForm.Handle) then
begin
FlashWindow(TalkingForm.Handle, True);
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
TalkingForm.ShowGettedVideoTransmiteRequest;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedVideoTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowGettedVideoTransmiteResponse(AAcceptted);
end;
procedure TMainForm.RealICQClientGettedWebUrl(Sender: TObject);
begin
// if trim(RealICQClient.WeatherUrl)<>'' then
// begin
// FDownFile.OnComplete:=DownFileComplete;
// FDownFile.ThreadDownFile(RealICQClient.WeatherUrl,ExtractFilePath(Application.ExeName)+'Weather.txt');
// end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientSendedVideoTransmiteRequest(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowSendedVideoTransmiteRequest;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedCancelVideoTransmite(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowCanceledVideoTransmite;
end;
procedure TMainForm.RealICQClientGettedCanSendSMSCount(Sender: TObject);
begin
UpdateCanSendSMSCount;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedStopVideoTransmite(Sender: TObject; ALoginName: string; AIsStopper: Boolean);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowStoppedVideoTransmite(AIsStopper);
end;
//---显示黑名单-------------------------------------------------------------
procedure TMainForm.ShowBlacklists;
var
iLoop, ItemIndex: Integer;
RealICQUser: TRealICQUser;
FriendTreeView: TRealICQContacterTreeView;
Friend: TRealICQEmployee;
begin
SetFlashCaptionOnOnlineValue(False);
try
ItemIndex := FContacterTreeViews.IndexOf(LvFriends);
FriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
for iLoop := 0 to RealICQClient.Blacklists.Count - 1 do
begin
RealICQUser := RealICQClient.Blacklists.Objects[iLoop] as TRealICQUser;
if trim(RealICQUser.DisplayName) = '' then
TUsersService.GetUsersService.GetOrRequestUser(RealICQUser.LoginName, RealICQClient);
if (FriendTreeView.EmployeeItems.IndexOf(RealICQUser.LoginName)) >= 0 then
Continue;
Friend := TRealICQEmployee.Create(RealICQUser.LoginName);
Friend.BranchID := LVBlackLists;
FriendTreeView.AddEmployee(Friend);
//UpdateFriendNode(Friend, RealICQUser, False);
TUsersService.GetUsersService.UpdateTreeNode(FriendTreeView, Friend, RealICQUser, False);
end;
finally
SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedBlacklists(Sender: TObject);
begin
ShowBlacklists;
end;
//-------显示与自己不同部门的联系人------------------------------
procedure TMainForm.RealICQClientGettedBranchUser(Sender: TObject);
var
iLoop, ItemIndex: Integer;
RealICQUser: TRealICQUser;
RealICQContacterTreeView: TRealICQContacterTreeView;
Employee: TRealICQEmployee;
TmpBranch, RootBranch: TRealICQBranch;
OnlineEmployee: Integer;
begin
// TmpBranch:=nil;
// RootBranch:=nil;
// ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
// RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
// RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
// RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
// RealICQContacterTreeView.AdjustPosition :=False;
// RealICQContacterTreeView.HideSystemScrollBar;
// pgcMainWorkArea.DisableAlign;
// RealICQContacterTreeView.BeginUpdate;
// try
// ItemIndex := RealICQContacterTreeView.EmployeeItems.IndexOf('正在下载用户');
// if ItemIndex>=0 then
// RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
// OnlineEmployee:=0;
//
// for iLoop:=0 to RealICQContacterTreeView.EmployeeItems.Count-1 do
// begin
// Employee:=RealICQContacterTreeView.EmployeeItems.Objects[iLoop] as TRealICQEmployee;
// if (Employee.LoginState <> stOffline) and (Employee.LoginState <> stHidden) then
// OnlineEmployee := OnlineEmployee + 1;
// end;
// for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
// begin
// TmpBranch:=RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
// if not TmpBranch.IsGetUserList then
// begin
// TmpBranch.OnlineEmployee:=0;
// TmpBranch.EmployeeCount:=0;
// TmpBranch.IsGetUserList:=True;
// end;
// if (TmpBranch.ParentID='0') then
// RootBranch:=TmpBranch
// end;
// if RootBranch<>nil then
// begin
// RootBranch.OnlineEmployee:=OnlineEmployee;
// RootBranch.EmployeeCount:= RealICQContacterTreeView.EmployeeItems.Count;
// end;
// {$region '添加联系人'}
// for iLoop := RealICQClient.Friends.Count - 1 downto 0 do
// begin
// RealICQUser := RealICQClient.Friends.Objects[iLoop] as TRealICQUser;
// if (RealICQContacterTreeView.EmployeeItems.IndexOf(RealICQUser.LoginName)) >= 0 then Continue;
// if AnsiSameText(RealICQUser.BranchID, 'U') then Continue;
//
// Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
// Employee.BranchID := RealICQUser.BranchID;
// Employee.HasAddFriend:=False;
// Employee.HasEmail :=False;
// RealICQContacterTreeView.AddEmployee(Employee);
// if Assigned(Employee.Node.Parent) then
// begin
// UpdateEmployeeNode(Employee, RealICQUser, False);
// end
// else
// FreeAndNil(Employee);
// end;
// {$endregion}
// PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
// finally
// RealICQContacterTreeView.EndUpdate;
// pgcMainWorkArea.EnableAlign;
// end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.LoadLatests;
var
FLatestUsers: TStringList;
RealICQUser: TRealICQUser;
RealICQContacterListItem: TRealICQContacterListItem;
iLoop, ItemIndex: Integer;
LoginName: string;
begin
FLatestUsers := DBHistory.GetLatests(RealICQClient.LoginName);
try
for iLoop := 0 to FLatestUsers.Count - 1 do
begin
if iLoop >= 20 then
Break;
LoginName := FLatestUsers[iLoop];
if (AnsiPos('+', LoginName) <= 0) and (trim(RealICQClient.CenterServerID) <> '') then
LoginName := RealICQClient.CenterServerID + '+' + LoginName;
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(LoginName);
if RealICQUser = nil then
Continue;
if not AnsiSameText(RealICQUser.LoginName, RealICQClient.LoginName) then
begin
ItemIndex := FLVLatests.Items.IndexOf(RealICQUser.LoginName);
if ItemIndex = -1 then
ItemIndex := FLVLatests.Items.Add(RealICQUser.LoginName);
RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
//BindUserDataToItem(RealICQContacterListItem, RealICQUser);
TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
end;
end;
finally
FreeAndNil(FLatestUsers);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.GetOtherBranchs;
var
iLoop: Integer;
RealICQUser: TRealICQUser;
ALoginNames: string;
begin
ALoginNames := '';
for iLoop := 0 to FNotAddedEmployeeList.Count - 1 do
begin
RealICQUser := FNotAddedEmployeeList.Objects[iLoop] as TRealICQUser;
ALoginNames := ALoginNames + RealICQUser.LoginName;
if (iLoop < FNotAddedEmployeeList.Count - 1) then
ALoginNames := ALoginNames + Chr(10);
end;
if (Length(Trim(ALoginNames)) > 0) then
RealICQClient.SendGetFriendsInfo(ALoginNames);
end;
//-----计算某个部门的总上线人数和总用户数-----------------------------------
procedure TMainForm.GetBranchEmpOnlineAndSum(Branchs: TStringList; BranchInfo: TRealICQBranchInfo; var OnlineEmployee, EmployeeCount: Integer);
var
iLoop: Integer;
TmpBranchInfo: TRealICQBranchInfo;
begin
OnlineEmployee := OnlineEmployee + BranchInfo.OnlineEmployee;
EmployeeCount := EmployeeCount + BranchInfo.EmployeeCount;
for iLoop := 0 to Branchs.Count - 1 do
begin
TmpBranchInfo := Branchs.Objects[iLoop] as TRealICQBranchInfo;
if TmpBranchInfo.ParentID = BranchInfo.ID then
begin
GetBranchEmpOnlineAndSum(Branchs, TmpBranchInfo, OnlineEmployee, EmployeeCount);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ShowBranchAndUsers(ExpandSelfNode: Boolean = False);
var
iLoop, ItemIndex: Integer;
OnlineEmployee, EmployeeCount: Integer;
RealICQUser: TRealICQUser;
RealICQContacterTreeView: TRealICQContacterTreeView;
BranchInfo: TRealICQBranchInfo;
Branch: TRealICQBranch;
Employee: TRealICQEmployee;
ParentNode: TTreeNode;
begin
ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
RealICQContacterTreeView.AdjustPosition := False;
RealICQContacterTreeView.HideSystemScrollBar;
//pgcMainWorkArea.DisableAlign;
{ TODO -olqq -c : 添加部门和用户 2015/3/14 17:03:49 }
{ TODO -olqq -c : 需要考虑 2015/3/14 17:05:43 }
RealICQContacterTreeView.BeginUpdate;
try
{$region '添加部门'}
for iLoop := 0 to RealICQClient.Branchs.Count - 1 do
begin
BranchInfo := RealICQClient.Branchs.Objects[iLoop] as TRealICQBranchInfo;
if (RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)) >= 0 then
Continue;
OnlineEmployee := 0;
EmployeeCount := 0;
GetBranchEmpOnlineAndSum(RealICQClient.Branchs, BranchInfo, OnlineEmployee, EmployeeCount);
Branch := TRealICQBranch.Create(BranchInfo.BranchName);
Branch.BranchID := BranchInfo.ID;
Branch.ParentID := BranchInfo.ParentID;
Branch.IsGetUserList := False;
Branch.OnlineEmployee := OnlineEmployee;
Branch.EmployeeCount := EmployeeCount;
RealICQContacterTreeView.AddBranch(Branch);
end;
// RealICQContacterTreeView.ReAlignBranchs;
{$endregion}
// {$region '添加联系人'}
// for iLoop := RealICQClient.Friends.Count - 1 downto 0 do
// begin
// RealICQUser := RealICQClient.Friends.Objects[iLoop] as TRealICQUser;
// if AnsiSameText(RealICQUser.LoginName, RealICQClient.LoginName) then
// begin
// ShowMeInformation;
// end;
// //if (RealICQContacterTreeView.EmployeeItems.IndexOf(RealICQUser.LoginName)) >= 0 then Continue;
// Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
// Employee.BranchID := RealICQUser.BranchID;
// Employee.HasEmail :=False;// (Length(Trim(RealICQUser.Email)) > 0);
// Employee.HasAddFriend:=False;
// if not AnsiSameText(Employee.BranchID, 'U') then
// begin
// RealICQContacterTreeView.AddEmployee(Employee);
// if Assigned(Employee.Node.Parent) then
// begin
// UpdateEmployeeNode(Employee, RealICQUser, False);
// end
// else
// begin
// FreeAndNil(Employee);
// if AnsiPos('-',RealICQUser.LoginName)>0 then
// begin
// // RealICQClient.GetUserInformation(RealICQUser.LoginName,True);
// if (FNotAddedEmployeeList.IndexOf(RealICQUser.LoginName)) < 0 then
// FNotAddedEmployeeList.AddObject(RealICQUser.LoginName, RealICQUser);
// end;
// end;
// end
// else
// begin
// if AnsiPos('-',RealICQUser.LoginName)>0 then
// begin
// TUsersService.GetUsersService.RequestUserInformation(RealICQUser.LoginName, RealICQClient);
// if (FNotAddedEmployeeList.IndexOf(RealICQUser.LoginName)) < 0 then
// FNotAddedEmployeeList.AddObject(RealICQUser.LoginName, RealICQUser);
// end;
// end;
// end;
// {$endregion}
{
Employee := RealICQContacterTreeView.GetEmployee(RealICQUser.LoginName);
if Employee <> nil then
begin
UpdateEmployeeNode(Employee, RealICQUser, True);
end;
}
{$region '展开自己所在的部门树'}
if ExpandSelfNode then
begin
Employee := RealICQContacterTreeView.GetEmployee(RealICQClient.Me.LoginName);
ParentNode := Employee.Node.Parent;
while ParentNode <> nil do
begin
ParentNode.Expanded := True;
Branch := ParentNode.Data;
Branch.IsGetUserList := True;
ParentNode := ParentNode.Parent;
end;
RealICQContacterTreeView.MoveScrollBarToTop;
PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
end;
{$endregion}
finally
RealICQContacterTreeView.EndUpdate;
//pgcMainWorkArea.EnableAlign;
end;
GetOtherBranchs;
end;
//-------------
procedure TMainForm.ShowBranchAndFriends;
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientUsersBranchReady(Sender: TObject);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedFriendList(Sender: TObject);
begin
RealICQClient.OnGetCanSendSMSCount := Self.RealICQClientGettedCanSendSMSCount;
lblLoginState.Caption := '载入联系人列表...';
lblLoginState.Refresh;
try
if tsCustomers.Parent <> nil then
begin
tsCustomers.Parent := nil;
tsCustomers.PageControl := nil;
pgcMainWorkArea.RemoveControl(tsCustomers);
end;
except
end;
{ TODO -olqq -c : 需要考虑 2015/3/14 17:06:30 }
//读取最近的联系人列表
try
LoadLatests;
except
end;
{$region '读取配置信息'}
try
//读取组配置信息
LoadGroupConfigs;
except
DeleteFile(TRealICQClient.GetUserDir + GroupConfigXMLFile);
LoadGroupConfigs;
end;
try
//读取样式
LoadStyleConfigs;
except
DeleteFile(TRealICQClient.GetUserDir + StyleConfigXMLFile);
LoadStyleConfigs;
end;
try
//读取热键设置
LoadHotKeyConfigs;
except
DeleteFile(TRealICQClient.GetUserDir + HotKeyConfigXMLFile);
LoadHotKeyConfigs;
end;
try
//读取消息提示和声音配置信息
LoadHintAndSoundConfigs;
except
DeleteFile(TRealICQClient.GetUserDir + HintAndSoundConfigXMLFile);
LoadHintAndSoundConfigs;
end;
try
//读取文件传输配置选项
LoadReceiveFileConfigs;
except
DeleteFile(TRealICQClient.GetUserDir + ReceiveFileConfigXMLFile);
LoadReceiveFileConfigs;
end;
try
//读取安全配置选项
LoadSafeConfigs;
except
DeleteFile(TRealICQClient.GetUserDir + SafeConfigXMLFile);
LoadSafeConfigs;
end;
try
//读取字体,表情等信息
LoadInputConfigs;
except
DeleteFile(TRealICQClient.GetUserDir + InputConfigXMLFile);
LoadInputConfigs;
end;
try
//读取出差设置
LoadOfflineAutoResponseSets;
except
DeleteFile(TRealICQClient.GetUserDir + OfflineAutoResponseConfigXMLFile);
LoadOfflineAutoResponseSets;
end;
{$endregion}
SetFlashCaptionOnOnlineValue(False);
FCanAlert := False;
// ShowBranchAndUsers(True);
try
//重新保存组成员列表
SaveGroupConfigs;
except
end;
FCanAlert := True;
ChangeUIColor(FUIMainColor);
SetFlashCaptionOnOnlineValue(FFlashCaptionOnOnline);
try
CheckCacheDir;
except
end;
try
ShowGroupInterface;
except
end;
spbShowNotReadMessage.Caption := Format('(%d)', [0]);
RealICQClient.SendGetNewInformation(0);
Sleep(50);
pnlForTopMessage.Visible := False;
RealICQClient.SendGetNewInformation(1);
if ScrollBoxTeam.Visible or PnlMoreUser.Visible or ScrollBoxMyFriend.Visible or ScrollBoxLatests.Visible then
else
SetToolBarState(MyContacters);
try
RealICQClientReceivedAdversement(nil);
except
end;
RealICQClient.SendGetMoreServerList;
// PostMessage(Handle, WM_SIZE, 0, 0);
//Application.ProcessMessages;
RealICQClient.SendGetWebUrl;
if FIsLogout then
RealICQClient.SendGetMoreServerList;
MainForm.RealICQClient.OnGettedAddrBookGroups := GettedAddrBookGroups;
MainForm.RealICQClient.OnManageAddrBookResult := GettedManageAddrBookResult;
RealICQClient.SendGetAddrBookGroup;
// if RealICQClient.ShowMiniPage then
// RealICQClient.SendGetNewInformation(2);
if TCustomerConfig.GetConfig.ShowGuideView then
btShowMiniPageClick(nil);
try
pgcMainWorkArea.ActivePageIndex := 0;
except
end;
end;
procedure TMainForm.TimerForGetBranchOnlineStatesTimer(Sender: TObject);
begin
miChangeServerClick(nil);
TimerForGetBranchUsersOnlineStates.Enabled := False;
TimerForGetBranchUsersOnlineStates.Enabled := True;
end;
procedure TMainForm.TimerForGetBranchUsersOnlineStatesTimer(Sender: TObject);
var
iLoop, ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
Branch: TRealICQBranch;
StrBranchs: string;
begin
TimerForGetBranchUsersOnlineStates.Enabled := False;
ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
if ItemIndex >= 0 then
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
StrBranchs := '';
for iLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
begin
Branch := RealICQContacterTreeView.BranchItems.Objects[iLoop] as TRealICQBranch;
if Branch.Node.Expanded then
begin
StrBranchs := StrBranchs + Branch.BranchID + ',';
end;
end;
miChangeServerClick(nil);
if Length(StrBranchs) > 0 then
RealICQClient.SendGetMoreUser(StrBranchs, FCurrentServerID);
end;
end;
procedure TMainForm.btShowMiniPageClick(Sender: TObject);
var
AShowMiniPageSet, AShowMiniPageWhenEverLoginSet: Boolean;
jo: ISuperObject;
begin
jo := SO();
// if TConditionConfig.GetConfig.RemoteUI then
// begin
// jo.S['url'] := Format('%s/guideview/index.html?v=%d', [TConditionConfig.GetConfig.RemoteUIHost, GetTickCount]);
// end
// else
// jo.S['url'] := ExtractFilePath(paramstr(0)) + 'html/guideview/#/';
jo.S['caption'] := '引导页';
jo.B['center'] := True;
jo.B['unsizeable'] := True;
// if not Assigned(AGuideViewForm) then
AGuideViewForm := TGuideViewForm.Create(Self);
AGuideViewForm.SetFormInfo(jo.AsString);
AGuideViewForm.Show;
// AShowMiniPageSet := RealICQClient.ShowMiniPageSet;
// AShowMiniPageWhenEverLoginSet := RealICQClient.ShowMiniPageWhenEverLoginSet;
// try
// RealICQClient.ShowMiniPageSet := True;
// RealICQClient.ShowMiniPageWhenEverLoginSet := True;
// RealICQClientGettedMiniPageSets(nil);
// finally
// RealICQClient.ShowMiniPageSet := AShowMiniPageSet;
// RealICQClient.ShowMiniPageWhenEverLoginSet := AShowMiniPageWhenEverLoginSet;
// end;
end;
procedure TMainForm.RealICQClientGettedMiniPageSets(Sender: TObject);
var
SystemMessage: TRealICQSystemMessage;
UserLoginName: string;
begin
//if (Sender <> nil) then
if not RealICQClient.ShowMiniPageSet then
Exit;
SystemMessage := TRealICQSystemMessage.Create;
SystemMessage.MessageID := 10000;
SystemMessage.MessageType := mtAdvertisement;
SystemMessage.AutoOpenWindow := True;
SystemMessage.Position := mpCenter;
SystemMessage.Left := 0;
SystemMessage.Top := 0;
SystemMessage.Width := 618;
SystemMessage.Height := 465;
SystemMessage.Delay := 0;
SystemMessage.MaxShowTimes := 0;
SystemMessage.Title := '每日新闻';
SystemMessage.Content := '';
UserLoginName := MainForm.RealICQClient.LoginName;
if Pos('+', UserLoginName) > 0 then
UserLoginName := Copy(UserLoginName, Pos('+', UserLoginName) + 1, Length(UserLoginName));
//SystemMessage.URL := Format(MiniPageURL, [UserLoginName]);
SystemMessage.URL := Format(RealICQClient.WebAppBaseURL + MiniPageURL, [UserLoginName]);
SystemMessage.AutoCloseTime := 0;
if RealICQClient.ShowMiniPageWhenEverLoginSet then
SystemMessage.MaxShowTimes := 0
else
SystemMessage.MaxShowTimes := 1;
RealICQClientReceivedSystemMessage(RealICQClient, SystemMessage);
end;
procedure TMainForm.RealICQClientGettedMoreBranchList(Sender: TObject);
var
iLoop, jLoop, ItemIndex: Integer;
RealICQContacterTreeView: TRealICQContacterTreeView;
BranchInfo: TRealICQBranchInfo;
Branch, TopBranch: TRealICQBranch;
OnlineEmployee, EmployeeCount: Integer;
AFinded: Boolean;
Employee: TRealICQEmployee;
begin
//debug('RealICQClientGettedMoreBranchList','mainform');
AFinded := False;
ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
if ItemIndex >= 0 then
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
for iLoop := 0 to RealICQClient.MoreBranchs.Count - 1 do
begin
BranchInfo := RealICQClient.MoreBranchs.Objects[iLoop] as TRealICQBranchInfo;
if BranchInfo.ParentID = '0' then
begin
for jLoop := 0 to RealICQContacterTreeView.BranchItems.Count - 1 do
begin
Branch := RealICQContacterTreeView.BranchItems.Objects[jLoop] as TRealICQBranch;
if (Branch.ParentID = '0') and AnsiSameText(Branch.BranchID, BranchInfo.ID) then
begin
AFinded := True;
Break;
end;
end;
Break;
end;
end;
if not AFinded then
begin
try
RealICQContacterTreeView.Clear;
FreeAndNil(RealICQContacterTreeView);
FContacterTreeViews.Delete(ItemIndex);
except
Exit;
end;
end;
end;
if not AFinded then
ItemIndex := AddContacterTreeView(ScrollBoxMoreUser, LVMoreUsers)
else
ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
RealICQContacterTreeView.AdjustPosition := False;
RealICQContacterTreeView.AutoChangeOnlineNumeric := False;
RealICQContacterTreeView.AutoCalculate := False;
if not AFinded then
begin
RealICQContacterTreeView.HideSystemScrollBar;
tsContacters.DisableAlign;
RealICQContacterTreeView.BeginUpdate;
end;
try
{$region '添加部门'}
for iLoop := 0 to RealICQClient.MoreBranchs.Count - 1 do
begin
BranchInfo := RealICQClient.MoreBranchs.Objects[iLoop] as TRealICQBranchInfo;
OnlineEmployee := 0;
EmployeeCount := 0;
GetBranchEmpOnlineAndSum(RealICQClient.MoreBranchs, BranchInfo, OnlineEmployee,EmployeeCount);
if (RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)) >= 0 then
begin
Branch := RealICQContacterTreeView.BranchItems.Objects[RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)] as TRealICQBranch;
Branch.OnlineEmployee := BranchInfo.OnlineEmployee;
//Branch.EmployeeCount := EmployeeCount;
Branch.EmployeeCount := BranchInfo.EmployeeCount;
Branch.Update;
Continue;
end;
//-----------------------------------------------------------------
Branch := TRealICQBranch.Create(BranchInfo.BranchName);
Branch.BranchID := BranchInfo.ID;
Branch.ParentID := BranchInfo.ParentID;
if Branch.ParentID = '0' then
begin
TopBranch := Branch;
//EmployeeCount:=EmployeeCount-BranchInfo.EmployeeCount;
if BranchInfo.EmployeeCount > 0 then
begin
RealICQClient.SendGetMoreUser(TopBranch.BranchID, FCurrentServerID);
end;
end;
Branch.OnlineEmployee := BranchInfo.OnlineEmployee;
//Branch.EmployeeCount:=EmployeeCount;
Branch.EmployeeCount := BranchInfo.EmployeeCount;
RealICQContacterTreeView.AddBranch(Branch);
Application.ProcessMessages;
end;
{$endregion}
if not AFinded then
begin
RealICQContacterTreeView.ReAlignBranchs;
if Assigned(TopBranch) then
TopBranch.Node.Expanded := True;
PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
RealICQContacterTreeView.MoveScrollBarToTop;
end;
finally
if not AFinded then
begin
RealICQContacterTreeView.EndUpdate;
tsContacters.EnableAlign;
end;
end;
ImgLoadingMoreBranchs.Visible := False;
ScrollBoxMoreUser.Visible := True;
{TimerForGetBranchOnlineStates.Enabled := False;
TimerForGetBranchOnlineStates.Enabled := True;}
end;
//----用户单击部门------------------------------------
procedure TMainForm.NodeBranchClick(Sender: TObject; Branch: TRealICQBranch);
var
RealICQContacterTreeView: TRealICQContacterTreeView;
ItemIndex: Integer;
Employee: TRealICQEmployee;
BranchInfo: TRealICQBranchInfo;
begin
//-------获取指定部门下的用户------------------------------------------------
if (not Branch.IsGetUserList) then// and (FGetUsersTask.IndexOf(Branch.BranchID) < 0) then
begin
ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
// BranchInfo := MainForm.RealICQClient.MoreBranchs.Objects[MainForm.RealICQClient.MoreBranchs.IndexOf(Branch.BranchID)] as TRealICQBranchInfo;
// FGetUsersTask.AddObject(Branch.BranchID, Branch);
// if (BranchInfo.IsGetUserList) then
// begin
// //RealICQContacterTreeView.ReCalculateEmployeeCount(Branch);
// RealICQClientGettedMoreUserList(nil)
// end
// else
if RealICQContacterTreeView.EmployeeItems.IndexOf('正在下载用户') < 0 then
begin
Employee := TRealICQEmployee.Create('正在下载用户');
Employee.BranchID := Branch.BranchID;
RealICQContacterTreeView.AddEmployee(Employee);
Branch.Node.Expanded := True;
GetBranchUser(Branch);
Branch.IsGetUserList := True;
end;
end;
end;
//----------------------------------------------------------------------------
procedure TMainForm.GetBranchUser(Branch: TRealICQBranch);
var
RealICQContacterTreeView: TRealICQContacterTreeView;
iIndex: Integer;
begin
//debug(Branch.BranchName,'GetBranchUser');
SetGetMoreUserEvent;
//iIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
//RealICQContacterTreeView := FContacterTreeViews.Objects[iIndex] as TRealICQContacterTreeView;
//RealICQContacterTreeView.ReCalculateEmployeeCount(Branch);
RealICQClient.SendGetBranchs(FCurrentServerID, StrToInt(Branch.BranchID));
Sleep(5);
RealICQClient.SendGetMoreUser(Branch.BranchID, FCurrentServerID);
end;
//----------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedMoreUserList(Sender: TObject);
var
iLoop, ItemIndex: Integer;
RealICQUser: TRealICQUser;
RealICQContacterTreeView: TRealICQContacterTreeView;
Employee: TRealICQEmployee;
TmpBranch, Branch, TopBranch: TRealICQBranch;
ParentNode: TTreeNode;
BranchInfo: TRealICQBranchInfo;
begin
TmpBranch := nil;
ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.AdjustPosition := False;
RealICQContacterTreeView.HideSystemScrollBar;
RealICQContacterTreeView.AutoChangeOnlineNumeric := True;
RealICQContacterTreeView.OnItemOnline := nil;
RealICQContacterTreeView.OnItemOffline := nil;
tsContacters.DisableAlign;
RealICQContacterTreeView.BeginUpdate;
try
ItemIndex := RealICQContacterTreeView.EmployeeItems.IndexOf('正在下载用户');
if ItemIndex >= 0 then
begin
Employee := RealICQContacterTreeView.GetEmployee('正在下载用户');
ParentNode := Employee.Node.Parent;
TmpBranch := TRealICQBranch(ParentNode.Data);
TmpBranch.IsGetUserList := True;
RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
end;
{$region '添加联系人'}
for iLoop := RealICQClient.MoreUsers.Count - 1 downto 0 do
begin
RealICQUser := RealICQClient.MoreUsers.Objects[iLoop] as TRealICQUser;
ItemIndex := RealICQContacterTreeView.BranchItems.IndexOf(RealICQUser.BranchID);
if ItemIndex < 0 then
Continue;
ItemIndex := RealICQContacterTreeView.EmployeeItems.IndexOf(RealICQUser.LoginName);
if ItemIndex >= 0 then
RealICQContacterTreeView.EmployeeItems.Delete(ItemIndex);
Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
Employee.BranchID := RealICQUser.BranchID; //很重要
RealICQContacterTreeView.AddEmployee(Employee);
//UpdateEmployeeNode(Employee, RealICQUser, False);
TUsersService.GetUsersService.UpdateTreeNode(RealICQContacterTreeView, Employee, RealICQUser);
end;
{$endregion}
{$region '添加部门'}
for iLoop := RealICQClient.MoreBranchs2.Count - 1 downto 0 do
begin
BranchInfo := RealICQClient.MoreBranchs2.Objects[iLoop] as TRealICQBranchInfo;
if (RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)) >= 0 then
begin
Branch := RealICQContacterTreeView.BranchItems.Objects[RealICQContacterTreeView.BranchItems.IndexOf(BranchInfo.ID)] as TRealICQBranch;
Branch.OnlineEmployee := BranchInfo.OnlineEmployee;
Branch.EmployeeCount := BranchInfo.EmployeeCount;
Branch.Update;
Continue;
end;
Branch := TRealICQBranch.Create(BranchInfo.BranchName);
Branch.BranchID := BranchInfo.ID;
Branch.ParentID := BranchInfo.ParentID;
if Branch.ParentID = '0' then
begin
TopBranch := Branch;
if BranchInfo.EmployeeCount > 0 then
begin
RealICQClient.SendGetMoreUser(TopBranch.BranchID, FCurrentServerID);
end;
end;
Branch.OnlineEmployee := BranchInfo.OnlineEmployee;
Branch.EmployeeCount := BranchInfo.EmployeeCount;
RealICQContacterTreeView.AddBranch(Branch);
Application.ProcessMessages;
end;
{$endregion}
// PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
finally
RealICQContacterTreeView.EndUpdate;
if TmpBranch <> nil then
begin
PostMessage(RealICQContacterTreeView.Handle, WM_SIZE, 0, 0);
Debug(TmpBranch.BranchName, '添加全市用户列表');
TmpBranch.Node.Expanded := True;
end;
tsContacters.EnableAlign;
end;
end;
//-------------------桌面备份---------------------------------------------------
procedure TMainForm.RealICQClientGettedPermission(Sender: TObject);
begin
spbNetworkBackup.Visible := RealICQClient.UserPermission.EnableBackup;
end;
//----------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedRemoteControlTransmiteBeControlResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowGettedRemoteControlTransmiteControlBeControlResponse(AAcceptted);
end;
procedure TMainForm.RealICQClientGettedRemoteControlTransmiteConnectted(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowGettedRemoteControlTransmiteConnectted;
end;
procedure TMainForm.RealICQClientGettedRemoteControlTransmiteControlRequest(Sender: TObject; ALoginName: string);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowGettedRemoteControlTransmiteControlRequest;
end;
procedure TMainForm.RealICQClientGettedRemoteControlTransmiteControlResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowGettedRemoteControlTransmiteControlControlResponse(AAcceptted);
end;
procedure TMainForm.RealICQClientGettedRemoteControlTransmiteRequest(Sender: TObject; ALoginName: string);
var
AShowActive: Boolean;
TalkingForm: TTalkingForm;
iWaitTimes: Integer;
begin
AShowActive := (RealICQClient.IsAutoState = True) and (RealICQClient.Me.LoginState = stLeave) and AnsiSameText(RealICQClient.Me.LeaveMessage, '忙碌');
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
begin
TalkingForm := OpenTalkingForm(ALoginName, not AShowActive, Sender as TRealICQClient);
end;
iWaitTimes := 0;
while not TalkingForm.CanWriteMessage do
begin
Application.ProcessMessages;
Inc(iWaitTimes);
if iWaitTimes > 1000 then
break;
Sleep(10);
end;
if (GetForegroundWindow <> TalkingForm.Handle) then
begin
FlashWindow(TalkingForm.Handle, True);
if PlaySoundOnGetMessage then
PlayEventSound(FMessageEventSound);
end;
TalkingForm.ShowGettedRemoteControlTransmiteRequest;
end;
procedure TMainForm.RealICQClientGettedRemoteControlTransmiteResponse(Sender: TObject; ALoginName: string; AAcceptted: Boolean);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
if TalkingForm.CanWriteMessage then
TalkingForm.ShowGettedRemoteControlTransmiteResponse(AAcceptted);
end;
procedure TMainForm.RealICQClientGettedRemoteControlTransmiteScreenImage(Sender: TObject; ALoginName: string; ALeft, ATop, AWidth, AHeight: Integer; AP: TPoint; ABitmap: TBitmap);
begin
if RemoteControlForm = nil then
Exit;
RemoteControlForm.imgRCScreen.Picture.Bitmap.Canvas.CopyRect(Rect(ALeft, ATop, ALeft + AWidth, ATop + AHeight), ABitmap.canvas, Rect(0, 0, ABitmap.width, ABitmap.height)); //拷贝
end;
procedure TMainForm.RealICQClientGettedRemoteControlTransmiteScreenSize(Sender: TObject; ALoginName: string; AWidth, AHeight: Integer);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
TalkingForm.ShowGettedRemoteControlTransmiteRecvedScreenSize(AWidth, AHeight);
end;
//------------------------------------------------------------------------------
procedure TMainForm.CheckCacheDir;
var
DSearchRec: TSearchRec;
FindResult: Integer;
begin
FindResult := FindFirst(CacheDir + '*' + CacheFileExt, faAnyFile, DSearchRec);
while FindResult = 0 do
begin
if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
begin
try
if Date - StrToDateTime(GetFileTimeInfo(CacheDir + ExtractFileName(DSearchRec.Name), 2)) > AudoDeleteCacheFileDate then
DeleteFile(CacheDir + ExtractFileName(DSearchRec.Name));
except
if Date - StrToDateTime(AnsiReplaceStr(GetFileTimeInfo(CacheDir + ExtractFileName(DSearchRec.Name), 2), '-', '/')) > AudoDeleteCacheFileDate then
DeleteFile(CacheDir + ExtractFileName(DSearchRec.Name));
end;
end;
FindResult := FindNext(DSearchRec);
end;
FindResult := FindFirst(CacheDir + '*' + CacheResumeSizeFileExt, faAnyFile, DSearchRec);
while FindResult = 0 do
begin
if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
begin
try
if Date - StrToDateTime(GetFileTimeInfo(CacheDir + ExtractFileName(DSearchRec.Name), 2)) > AudoDeleteCacheFileDate then
DeleteFile(CacheDir + ExtractFileName(DSearchRec.Name));
except
if Date - StrToDateTime(AnsiReplaceStr(GetFileTimeInfo(CacheDir + ExtractFileName(DSearchRec.Name), 2), '-', '/')) > AudoDeleteCacheFileDate then
DeleteFile(CacheDir + ExtractFileName(DSearchRec.Name));
end;
end;
FindResult := FindNext(DSearchRec);
end;
if GetDirectorySize(CacheDir) > MaxCacheDirSize * 1024 * 1024 then
begin
if MessageBox(Handle, PChar('Cache目录的大小已经超过 ' + IntToStr(MaxCacheDirSize) + 'MB，是否打开Cache目录进行管理？'), '提示', MB_ICONINFORMATION or MB_OKCANCEL) = ID_OK then
WinExec(PChar('explorer "' + CacheDir + '"'), SW_SHOWNORMAL);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ShowWebTabs;
var
iLoop: Integer;
TabSheet: TTabSheet;
Bitmap: TBitmap;
WebPanel: TWebPanel;
EUser, EPass: string;
begin
//先删除
try
for iLoop := 0 to FWebTabs.Count - 1 do
begin
TabSheet := FWebTabs[iLoop];
TabSheet.OnShow := nil;
TabSheet.PageControl := nil;
FreeAndNil(TabSheet);
end;
except
end;
FWebTabs.Clear;
//显示
pgcMainWorkArea.DisableAlign;
try
for iLoop := 0 to FWebPanels.Count - 1 do
begin
WebPanel := FWebPanels.Objects[iLoop] as TWebPanel;
if (not WebPanel.Show) and (not WebPanel.MustShow) then
Continue;
if ((AnsiPos('邮件', WebPanel.FName) > 0) or (AnsiPos('邮箱', WebPanel.FName) > 0) or (AnsiPos('信箱', WebPanel.FName) > 0)) and (WebPanel.MustShow) then
begin
if WebPanel.UserIMLoginName then
EUser := RealICQClient.LoginName
else
EUser := WebPanel.CustomLoginName;
if WebPanel.UserIMPassword then
EPass := RealICQClient.Password
else
EPass := WebPanel.CustomPassword;
//WebBrowserForEMail.Navigate(Format('http://mail.lishui.gov.cn/web_email/modules/i_login.phtml?field_ouser=%s&field_ovdomain=%s&field_opass=%s', [EUser, 'lishui.gov.cn', EPass]));
end;
TabSheet := TTabSheet.Create(pgcMainWorkArea);
TabSheet.Parent := pgcMainWorkArea;
TabSheet.DoubleBuffered := True;
TabSheet.Caption := WebPanel.Name;
TabSheet.ShowHint := False;
if FileExists(WebPanel.Image) then
begin
Bitmap := GetSamllBitmap(WebPanel.Image, 32, 32, False);
try
try
Bitmap.LoadFromFile(WebPanel.Image);
Bitmap.SetSize(ImgLstPageControl.Width, ImgLstPageControl.Height);
ImgLstPageControl.Add(Bitmap, nil);
TabSheet.ImageIndex := ImgLstPageControl.Count - 1;
except
//
end;
finally
FreeAndNil(Bitmap);
end;
end
else
TabSheet.ImageIndex := 2; //?号图标
TabSheet.OnShow := WebTabShow;
TabSheet.Tag := iLoop;
TabSheet.PageControl := pgcMainWorkArea;
FWebTabs.Add(TabSheet);
end;
finally
pgcMainWorkArea.EnableAlign;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGetWebTabs(Sender: TObject; ATabCount: Integer; WebTabRecords: array of TWebTabRecord);
var
iLoop, jLoop: Integer;
WebTabRecord: TWebTabRecord;
WebPanel: TWebPanel;
FFinded: Boolean;
AWebPanels: TStringList;
begin
LoadWebPanelsFromXML;
AWebPanels := TStringList.Create;
for iLoop := 0 to FWebPanels.Count - 1 do
begin
WebPanel := FWebPanels.Objects[iLoop] as TWebPanel;
AWebPanels.AddObject(WebPanel.ID, WebPanel);
end;
FWebPanels.Clear;
for iLoop := Low(WebTabRecords) to High(WebTabRecords) do
begin
WebTabRecord := WebTabRecords[iLoop];
if AWebPanels.IndexOf(WebTabRecord.ID) < 0 then
begin
WebPanel := TWebPanel.Create;
//FWebPanels.AddObject(WebTabRecord.Name, WebPanel);
WebPanel.FUserIMLoginName := True;
WebPanel.FUserIMPassword := True;
WebPanel.FCustomLoginName := '';
WebPanel.FCustomPassword := '';
WebPanel.FShow := False;
end
else
begin
WebPanel := AWebPanels.Objects[AWebPanels.IndexOf(WebTabRecord.ID)] as TWebPanel;
end;
WebPanel.MustShow := WebTabRecord.MustShow;
if WebPanel.MustShow then
WebPanel.FShow := True;
WebPanel.FID := WebTabRecord.ID;
WebPanel.FName := WebTabRecord.Name;
WebPanel.FURL := WebTabRecord.URL;
WebPanel.FImage := WebTabRecord.IconFile;
WebPanel.Content := WebTabRecord.Content;
if AnsiSameText(WebTabRecord.Method, 'GET') then
WebPanel.FNavigateType := ntGET
else if AnsiSameText(WebTabRecord.Method, 'POST') then
WebPanel.FNavigateType := ntPOST
else
WebPanel.FNavigateType := ntFill;
WebPanel.FPostFields := WebTabRecord.PostFields;
FWebPanels.AddObject(WebPanel.FID, WebPanel);
end;
{for iLoop := FWebPanels.Count - 1 downto 0 do
begin
WebPanel := FWebPanels.Objects[iLoop] as TWebPanel;
//if WebPanel.MustShow then
begin
FFinded := False;
for jLoop := Low(WebTabRecords) to High(WebTabRecords) do
begin
WebTabRecord := WebTabRecords[jLoop];
if AnsiSameStr(WebTabRecord.ID, WebPanel.ID) then
begin
FFinded := True;
Break;
end;
end;
if not FFinded then
begin
FreeAndNil(WebPanel);
FWebPanels.Delete(iLoop);
end;
end;
end; }
SaveWebPanelsToXML;
DisplayWebs := False;
ShowWebTabs;
DisplayWebs := True;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientInputting(Sender: TObject; ALoginName: string; AInputting: Boolean);
var
TalkingForm: TTalkingForm;
begin
TalkingForm := GetTalkingForm(ALoginName, Sender as TRealICQClient);
if TalkingForm = nil then
Exit;
TalkingForm.ShowInputting(AInputting);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientJoinedTeam(Sender: TObject; ARealICQTeam: TRealICQTeam);
var
AlertMessage: string;
RealICQUser: TRealICQUser;
begin
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ARealICQTeam.TeamCreater);
if RealICQUser.DisplayName = '' then
AlertMessage := RealICQUser.LoginName
else
AlertMessage := RealICQUser.DisplayName;
if ARealICQTeam.IsTempTeam then
AlertMessage := AlertMessage + ' 将您添加进了 临时多人会话'
else
AlertMessage := AlertMessage + ' 将您添加进了群组: ' + ARealICQTeam.TeamCaption;
ShowNotifyAlertForm(AlertMessage);
AddMessageHistory(smSimple, AlertMessage, nil);
UpdateTeamTalkingForm(ARealICQTeam);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientJoinTeamRequest(Sender: TObject; ARealICQTeam: TRealICQTeam; ALoginName, ATag: string);
begin
AddMessageHistory(smSimple, Format('%s 请求加入群组 %s<%s>。', [ALoginName, ARealICQTeam.TeamCaption, ARealICQTeam.TeamID]), nil);
ShowJoinTeamRequestWindow(Self, ARealICQTeam.TeamID, ARealICQTeam.TeamCaption, ALoginName, ATag);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientJoinTeamResponse(Sender: TObject; ATeamID: string; ALoginName: string; ATag: string; AAcceptted: Boolean);
var
ATeam: TRealICQTeam;
begin
ATeam := TTeamsAdapter.GetTeam(ATeamID);
if ATeam = nil then
Exit;
if AAcceptted then
begin
AddMessageHistory(smSimple, ALoginName + ' 接受了您加入群组 ' + ATeam.TeamCaption + ' 的请求', nil);
ShowNotifyAlertForm(ALoginName + ' 接受您加入群组 ' + ATeam.TeamCaption + ' 的请求');
end
else
begin
if Length(ATag) = 0 then
ATag := '无';
AddMessageHistory(smSimple, ALoginName + ' 拒绝您加入群组 ' + ATeam.TeamCaption, nil);
ShowNotifyAlertForm(ALoginName + ' 拒绝您加入群组 ' + ATeam.TeamCaption + #$D#$A + '附言 ：' + ATag);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientTeamDisbanded(Sender: TObject; ARealICQTeam: TRealICQTeam);
var
iIndex: Integer;
AlertMessage: string;
RealICQUser: TRealICQUser;
begin
iIndex := FLVTeams.Items.IndexOf(ARealICQTeam.TeamID);
if iIndex >= 0 then
begin
FLVTeams.Items.Delete(iIndex);
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ARealICQTeam.TeamCreater);
if RealICQUser = RealICQClient.Me then
AlertMessage := '您'
else if RealICQUser.DisplayName = '' then
AlertMessage := RealICQUser.LoginName
else
AlertMessage := RealICQUser.DisplayName;
if ARealICQTeam.IsTempTeam then
AlertMessage := AlertMessage + ' 解散了 多人对话'
else
AlertMessage := AlertMessage + ' 解散了群组: ' + ARealICQTeam.TeamCaption;
ShowNotifyAlertForm(AlertMessage);
AddMessageHistory(smSimple, AlertMessage, nil);
CloseTeamOptionsForm(ARealICQTeam.TeamID);
CloseJoinTeamRequestWindow(ARealICQTeam.TeamID);
UpdateTeamTalkingForm(ARealICQTeam);
end;
end;
procedure TMainForm.RealICQClientTeamQuitted(Sender: TObject; ARealICQTeam: TRealICQTeam; ALoginName: string);
var
iIndex: Integer;
AlertMessage: string;
begin
iIndex := FLVTeams.Items.IndexOf(ARealICQTeam.TeamID);
if iIndex >= 0 then
begin
FLVTeams.Items.Delete(iIndex);
if ARealICQTeam.IsTempTeam then
AlertMessage := '您 退出了 多人对话'
else
AlertMessage := '您 退出了群组: ' + ARealICQTeam.TeamCaption;
ShowNotifyAlertForm(AlertMessage);
AddMessageHistory(smSimple, AlertMessage, nil);
CloseTeamOptionsForm(ARealICQTeam.TeamID);
CloseJoinTeamRequestWindow(ARealICQTeam.TeamID);
UpdateTeamTalkingForm(ARealICQTeam);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.SetFlashCaptionOnOnlineValue(Value: Boolean);
var
iLoop: Integer;
GroupName: string;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
GroupName := FContacterListViews[iLoop];
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
RealICQContacterListView.FlashCaptionOnOnline := Value and (GroupName <> LVStrangers) and (GroupName <> LVBlacklists) and (GroupName <> LVLatests);
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
RealICQContacterTreeView.FlashCaptionOnOnline := Value;
RealICQContacterTreeView.ReDrawAll;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientUserExInformationChanged(Sender: TObject; RealICQUser: TRealICQUser);
begin
if (OptionsForm <> nil) and (RealICQUser = RealICQClient.Me) then
begin
OptionsForm.GetSets;
end;
UpdateSeeInformationForm(RealICQUser);
UpdateTalkingForm(RealICQUser);
UpdateSMSForm(RealICQUser);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientUserInformationReady(Sender: TObject; RealICQUser: TRealICQUser);
var
ItemIndex: Integer;
RealICQContacterListItem: TRealICQContacterListItem;
RealICQContacterListView: TRealICQContacterListView;
RealICQFriendTreeView: TRealICQContacterTreeView;
RealICQContacterTreeView: TRealICQContacterTreeView;
Employee: TRealICQEmployee;
Friend: TRealICQEmployee;
iIndex, iLoop, jLoop: Integer;
GroupName: string;
GroupMembers: TStringList;
begin
if UserCardForm <> nil then
begin
if AnsiSameText(UserCardForm.LoginName, RealICQUser.LoginName) then
UserCardForm.LoginName := RealICQUser.LoginName;
end;
{$region '如果正处于过滤用户的状态,则同时也更新FSearchListView中的数据'}
if FSearchListViewInVisible then
begin
ItemIndex := FSearchListView.Items.IndexOf(RealICQUser.LoginName);
if ItemIndex >= 0 then
begin
RealICQContacterListItem := FSearchListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
//BindUserDataToItem(RealICQContacterListItem, RealICQUser);
TUsersService.GetUsersService.UpdateListItem(FSearchListView, RealICQContacterListItem, RealICQUser);
end;
end;
{$endregion}
{$region '更新“最近联系人列表”中的数据'}
ItemIndex := FLVLatests.Items.IndexOf(RealICQUser.LoginName);
if ItemIndex >= 0 then
begin
RealICQContacterListItem := FLVLatests.Items.Objects[ItemIndex] as TRealICQContacterListItem;
//BindUserDataToItem(RealICQContacterListItem, RealICQUser);
TUsersService.GetUsersService.UpdateListItem(FLVLatests, RealICQContacterListItem, RealICQUser);
end;
{$endregion}
{$region 'wmCorporation工作模式或采用了树型方式组织好友列表'}
if TUsersService.GetUsersService.IsWorkmateOrFriend(RealICQUser.LoginName) then
begin
if AnsiSameText(RealICQUser.LoginName, RealICQClient.LoginName) then
ShowMeInformation;
ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
Employee := RealICQContacterTreeView.GetEmployee(RealICQUser.LoginName);
if Employee <> nil then
//UpdateEmployeeNode(Employee, RealICQUser, True);
TUsersService.GetUsersService.UpdateTreeNode(RealICQContacterTreeView, Employee, RealICQUser);
ItemIndex := FContacterTreeViews.IndexOf(LvFriends);
RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Friend := RealICQFriendTreeView.GetEmployee(RealICQUser.LoginName);
if Friend <> nil then
//UpdateFriendNode(Friend, RealICQUser, True);
TUsersService.GetUsersService.UpdateTreeNode(RealICQFriendTreeView, Friend, RealICQUser);
{$region '更新自定义组中的信息'}
if RealICQClient.WorkingMode = wmCorporation then
begin
for iLoop := 0 to FGroups.Count - 1 do
begin
GroupName := FGroups[iLoop];
GroupMembers := FGroups.Objects[iLoop] as TStringList;
for jLoop := 0 to GroupMembers.Count - 1 do
begin
if AnsiSameText(GroupMembers[jLoop], RealICQClient.LoginName) then
begin
iIndex := FContacterListViews.IndexOf(GroupName);
if iIndex >= 0 then
begin
RealICQContacterListView := FContacterListViews.Objects[iIndex] as TRealICQContacterListView;
if RealICQContacterListView.Items.IndexOf(RealICQClient.LoginName) = -1 then
RealICQContacterListView.Items.Add(RealICQClient.LoginName);
ItemIndex := RealICQContacterListView.Items.IndexOf(RealICQUser.LoginName);
if ItemIndex >= 0 then
begin
RealICQContacterListItem := RealICQContacterListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
//BindUserDataToItem(RealICQContacterListItem, RealICQUser);
TUsersService.GetUsersService.UpdateListItem(RealICQContacterListView, RealICQContacterListItem, RealICQUser);
end;
end; //if
end; //if
end; //for jLoop
end; //for iLoop
{$endregion}
end;
{$endregion}
end;
{$region '更新“全市”中的数据'}
if RealICQClient.MoreUsers.IndexOf(RealICQUser.LoginName) >= 0 then
begin
ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
RealICQContacterTreeView.OnHeadImageMouseEnter := NodeOnHeadImageMouseEnter;
RealICQContacterTreeView.OnHeadImageMouseLeave := NodeOnHeadImageMouseLeave;
RealICQContacterTreeView.OnItemOnline := nil;
RealICQContacterTreeView.OnItemOffline := nil;
RealICQContacterTreeView.AutoChangeOnlineNumeric := True;
Employee := RealICQContacterTreeView.GetEmployee(RealICQUser.LoginName);
if Employee <> nil then
//UpdateEmployeeNode(Employee, RealICQUser, True);
TUsersService.GetUsersService.UpdateTreeNode(RealICQContacterTreeView, Employee, RealICQUser);
end;
{$endregion}
UpdateSeeInformationForm(RealICQUser);
UpdateTalkingForm(RealICQUser);
//debug('8','RealICQClientUserInformationReady');
UpdateSMSForm(RealICQUser);
UpdateMemberInfoOfTeamOptionsForm(RealICQUser);
UpdateAddrBookInfo(RealICQUser);
end;
procedure TMainForm.UpdateAddrBookInfo(RealICQUser: TRealICQUser);
var
iLoop, ItemIndex: Integer;
Employee: TRealICQEmployee;
TmpRealICQUser: TRealICQUser;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVAddrBook);
if ItemIndex < 0 then
Exit;
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Employee := RealICQContacterTreeView.GetEmployee(RealICQUser.LoginName);
if (Employee <> nil) then
begin
Employee.Mobile := RealICQUser.Mobile;
Employee.SMSHint := RealICQUser.Mobile;
Employee.Tel := RealICQUser.Tel;
Employee.Update;
end
else
Exit;
ItemIndex := MainForm.RealICQClient.AddrBookUsers.IndexOf(RealICQUser.LoginName);
if ItemIndex < 0 then
Exit;
TmpRealICQUser := MainForm.RealICQClient.AddrBookUsers.Objects[ItemIndex] as TRealICQUser;
TmpRealICQUser.Mobile := RealICQUser.Mobile;
TmpRealICQUser.Tel := RealICQUser.Tel;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ShowNetWorkDiskSpaceInfo;
begin
lblNDSpaceSize.Caption := Format('%0fM/%dM', [RealICQNetWorkDiskClient.UsedSpaceSize / (1024 * 1024), RealICQNetWorkDiskClient.MaxSpaceSize div (1024 * 1024)]);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientConnectStateChanged(Sender: TObject);
begin
if tsNetWorkDisk.Parent = nil then
Exit;
try
FConfirmReplaceResult := -1;
if RealICQNetWorkDiskClient.Connectting then
begin
lblNDState.Caption := '正在连接...';
lblNDSpaceSize.Caption := '';
end
else if RealICQNetWorkDiskClient.Connected then
begin
lblNDState.Caption := '已连接';
ShowNetWorkDiskSpaceInfo;
end
else
begin
lblNDState.Caption := '连接已断开';
lblNDSpaceSize.Caption := '';
try
if FLVNetWorkDisk <> nil then
begin
FLVNetWorkDisk.Items.Clear;
FLVNetWorkDisk.ReDrawAll;
end;
except
end;
try
spbNDCancelAllClick(spbNDCancelAll);
except
end;
end;
spbNDMoveUp.Enabled := RealICQNetWorkDiskClient.Connected;
spbNDRefresh.Enabled := spbNDMoveUp.Enabled;
spbNDNewDir.Enabled := spbNDMoveUp.Enabled;
spbNDDelete.Enabled := spbNDMoveUp.Enabled;
shpNDDirBorder.Enabled := spbNDMoveUp.Enabled;
edNDDir.Enabled := spbNDMoveUp.Enabled;
spbNDUpload.Enabled := spbNDMoveUp.Enabled;
spbNDDownload.Enabled := spbNDMoveUp.Enabled;
spbNDCancelAll.Enabled := pnlNDMissions.Visible;
spbNDConnect.Enabled := (not RealICQNetWorkDiskClient.Connected) and (not RealICQNetWorkDiskClient.Connectting) and (RealICQClient.Connected);
spbNDDisconnect.Enabled := not spbNDConnect.Enabled and not RealICQNetWorkDiskClient.Connectting;
if not edNDDir.Enabled then
edNDDir.Text := '';
except
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.ItemShowHint(Sender: TObject; Item: TRealICQContacterListItem; var HintStr: string);
var
AFile: TRealICQNetWorkDiskFile;
ADirectory: TRealICQNetWorkDiskDirectory;
AUploadMission: TUploadMission;
ADownloadMission: TDownloadMission;
begin
if Item = nil then
Exit;
if Sender = FLVNetWorkDisk then
begin
if Copy(Item.LoginName, 1, 1) = 'D' then
begin
ADirectory := TRealICQNetWorkDiskDirectory(Item.Data);
HintStr := '目录名称: ' + Trim(ADirectory.Name) + #$D#$A;
HintStr := HintStr + '创建时间: ' + DateTimeToStr(ADirectory.CreateDate);
end
else if Copy(Item.LoginName, 1, 1) = 'F' then
begin
AFile := TRealICQNetWorkDiskFile(Item.Data);
HintStr := '文件名称: ' + Trim(AFile.Name) + #$D#$A;
HintStr := HintStr + '创建时间: ' + Trim(DateTimeToStr(AFile.CreateDate)) + #$D#$A;
HintStr := HintStr + '修改时间: ' + Trim(DateTimeToStr(AFile.ModifyDate)) + #$D#$A;
HintStr := HintStr + '大小: ' + Trim(Item.Watchword);
end;
end;
if Sender = FLVNetWorkDiskUploadingFiles then
begin
if AnsiSameText(HintStr, '取消') then
Exit;
AUploadMission := TUploadMission(Item.Data);
HintStr := AUploadMission.Name;
end;
if Sender = FLVNetWorkDiskDownloadingFiles then
begin
if AnsiSameText(HintStr, '取消') then
Exit;
ADownloadMission := TDownloadMission(Item.Data);
if ADownloadMission.FDownloadMissionType = mtDir then
HintStr := ADownloadMission.DirectoryName
else
HintStr := ADownloadMission.FileName;
end;
end;
procedure TMainForm.LblHintClick(Sender: TObject);
var
FAutoSaveMessage: Boolean;
begin
FAutoSaveMessage := AutoSaveMessage;
AutoSaveMessage := False;
try
RealICQClientReceivedSystemMessage(RealICQClient, FTopSystemMessage);
finally
btCloseTopMessageClick(nil);
AutoSaveMessage := FAutoSaveMessage;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.NDSelectItemChanged(Item: TRealICQContacterListItem);
begin
if not pnlNDMissions.Visible then
begin
spbNDDelete.Enabled := (FLVNetWorkDisk <> nil) and (FLVNetWorkDisk.SelCount > 0);
spbNDDownload.Enabled := spbNDDelete.Enabled;
end;
spbNDCancelAll.Enabled := pnlNDMissions.Visible;
end;
//------------------------------------------------------------------------------
procedure TMainForm.NDItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.NDMissionItemIconButtonClick(Sender: TObject; Item: TRealICQContacterListItem; IconButtonType: TRealICQContacterListItemIconButtonType);
var
UploadMission: TUploadMission;
DownloadMission: TDownloadMission;
AMissionID: string;
begin
if Sender = FLVNetWorkDiskUploadingFiles then
begin
try
if not Assigned(Item) then
Exit;
UploadMission := TUploadMission(Item.Data);
if not Assigned(UploadMission) then
Exit;
AMissionID := UploadMission.FID;
try
FLVNetWorkDiskUploadingFiles.Items.Delete(Item.ItemIndex);
FreeAndNil(UploadMission);
except
end;
RealICQNetWorkDiskClient.CancelUploadingFile(AMissionID);
finally
CheckUploadMissions
end;
end;
if Sender = FLVNetWorkDiskDownloadingFiles then
begin
try
if not Assigned(Item) then
Exit;
FLVNetWorkDiskDownloadingFiles.Items.Delete(Item.ItemIndex);
DownloadMission := TDownloadMission(Item.Data);
FreeAndNil(DownloadMission);
RealICQNetWorkDiskClient.StopDownloader;
finally
CheckDownloadMissions
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.NDMissionDropFiles(Sender: TObject; var Message: TMessage);
var
i: Integer;
p: array[0..1023] of Char;
AName: string;
begin
try
if (FLVNetWorkDiskUploadingFiles.Items.Count > 0) or (FLVNetWorkDiskDownloadingFiles.Items.Count > 0) or (FSavedUploadMissions.Count > 0) then
begin
MessageBox(Handle, '抱歉，系统正忙!', '提示', MB_ICONINFORMATION);
Exit;
end;
i := DragQueryFile(Message.wParam, $FFFFFFFF, nil, 0);
for i := 0 to i - 1 do
begin
DragQueryFile(Message.wParam, i, p, 1024);
AName := StrPas(p);
if FileExists(AName) then
begin
AddUploadMission(mtFile, RealICQNetWorkDiskClient.CurrentDirectory.ID, AName, False);
end
else if DirectoryExists(AName) then
begin
AddUploadMission(mtDir, RealICQNetWorkDiskClient.CurrentDirectory.ID, AName, False);
end;
end;
finally
CheckUploadMissions;
DragFinish(Message.wParam);
Message.Result := 1;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miNDCancelClick(Sender: TObject);
var
ListItem: TRealICQContacterListItem;
UploadMission: TUploadMission;
DownloadMission: TDownloadMission;
iLoop: Integer;
begin
if TabSetNDMissions.TabIndex = 0 then
begin
for iLoop := FLVNetWorkDiskUploadingFiles.Items.Count - 1 downto 0 do
begin
ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
UploadMission := TUploadMission(ListItem.Data);
if ListItem.LoginState = stOnline then
begin
if UploadMission.FUploadMissionType = mtFile then
begin
RealICQNetWorkDiskClient.CancelUploadingFile(UploadMission.FID);
Continue;
end;
end;
FLVNetWorkDiskUploadingFiles.Items.Delete(iLoop);
FreeAndNil(UploadMission);
end;
end;
CheckUploadMissions;
end;
if TabSetNDMissions.TabIndex = 1 then
begin
for iLoop := FLVNetWorkDiskDownloadingFiles.Items.Count - 1 downto 0 do
begin
ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
DownloadMission := TDownloadMission(ListItem.Data);
FLVNetWorkDiskUploadingFiles.Items.Delete(iLoop);
FreeAndNil(DownloadMission);
if ListItem.LoginState = stOnline then
begin
RealICQNetWorkDiskClient.StopDownloader;
end;
end;
end;
CheckDownloadMissions;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbNDMoveUpClick(Sender: TObject);
begin
if RealICQNetWorkDiskClient.CurrentDirectory.Parent <> nil then
begin
lblNDState.Caption := '正在载入...';
RealICQNetWorkDiskClient.GetDirectory(RealICQNetWorkDiskClient.CurrentDirectory.Parent);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.miNDRenameClick(Sender: TObject);
var
DirectoryName, FileName: string;
AFile: TRealICQNetWorkDiskFile;
ADirectory: TRealICQNetWorkDiskDirectory;
ListItem, ListItem1: TRealICQContacterListItem;
iLoop, jLoop: Integer;
begin
for iLoop := FLVNetWorkDisk.Items.Count - 1 downto 0 do
begin
ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
if Copy(ListItem.LoginName, 1, 1) = 'D' then
begin
ADirectory := TRealICQNetWorkDiskDirectory(ListItem.Data);
DirectoryName := Trim(ShowMyInputBox('重命名目录', '请输入新的目录名称', ADirectory.Name, 200));
if AnsiSameStr(DirectoryName, ADirectory.Name) then
Exit;
if Length(DirectoryName) > 0 then
begin
if (Pos('\', DirectoryName) > 0) or (Pos('/', DirectoryName) > 0) or (Pos(':', DirectoryName) > 0) or (Pos('*', DirectoryName) > 0) or (Pos('"', DirectoryName) > 0) or (Pos('<', DirectoryName) > 0) or (Pos('>', DirectoryName) > 0) or (Pos('|', DirectoryName) > 0) then
begin
MessageBox(Handle, '目录名中不能出现下列任何字符之一'#$D#$A'\ / : * " < > |', '错误', MB_OK or MB_ICONINFORMATION);
Exit;
end;
for jLoop := 0 to FLVNetWorkDisk.Items.Count - 1 do
begin
ListItem1 := FLVNetWorkDisk.Items.Objects[jLoop] as TRealICQContacterListItem;
if ListItem1 = ListItem then
continue;
if Copy(ListItem1.LoginName, 1, 1) = 'D' then
begin
if AnsiSameText(DirectoryName, ListItem1.DisplayName) then
begin
MessageBox(Handle, '指定的目录已存在！', '提示', MB_OK or MB_ICONINFORMATION);
Exit;
end;
end;
end;
RealICQNetWorkDiskClient.Rename(rtDir, ADirectory.ID, DirectoryName);
end;
end
else if Copy(ListItem.LoginName, 1, 1) = 'F' then
begin
AFile := TRealICQNetWorkDiskFile(ListItem.Data);
FileName := Trim(ShowMyInputBox('重命名文件', '请输入新的文件名称', AFile.Name, 200));
if AnsiSameStr(FileName, AFile.Name) then
Exit;
if Length(FileName) > 0 then
begin
if (Pos('\', FileName) > 0) or (Pos('/', FileName) > 0) or (Pos(':', FileName) > 0) or (Pos('*', FileName) > 0) or (Pos('"', FileName) > 0) or (Pos('<', FileName) > 0) or (Pos('>', FileName) > 0) or (Pos('|', FileName) > 0) then
begin
MessageBox(Handle, '文件名中不能出现下列任何字符之一'#$D#$A'\ / : * " < > |', '错误', MB_OK or MB_ICONINFORMATION);
Exit;
end;
for jLoop := 0 to FLVNetWorkDisk.Items.Count - 1 do
begin
ListItem1 := FLVNetWorkDisk.Items.Objects[jLoop] as TRealICQContacterListItem;
if ListItem1 = ListItem then
continue;
if Copy(ListItem1.LoginName, 1, 1) = 'F' then
begin
if AnsiSameText(FileName, ListItem1.DisplayName) then
begin
MessageBox(Handle, '指定的文件已存在！', '提示', MB_OK or MB_ICONINFORMATION);
Exit;
end;
end;
end;
RealICQNetWorkDiskClient.Rename(rtFile, AFile.ID, FileName);
end;
end;
Exit;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbNDNewDirClick(Sender: TObject);
var
DirectoryName: string;
iLoop: Integer;
ListItem: TRealICQContacterListItem;
begin
DirectoryName := Trim(ShowMyInputBox('新建目录', '请输入目录名称', '', 200));
if Length(DirectoryName) > 0 then
begin
if (Pos('\', DirectoryName) > 0) or (Pos('/', DirectoryName) > 0) or (Pos(':', DirectoryName) > 0) or (Pos('*', DirectoryName) > 0) or (Pos('"', DirectoryName) > 0) or (Pos('<', DirectoryName) > 0) or (Pos('>', DirectoryName) > 0) or (Pos('|', DirectoryName) > 0) then
begin
MessageBox(Handle, '目录名中不能出现下列任何字符之一'#$D#$A'\ / : * " < > |', '错误', MB_OK or MB_ICONINFORMATION);
Exit;
end;
for iLoop := FLVNetWorkDisk.Items.Count - 1 downto 0 do
begin
ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
if Copy(ListItem.LoginName, 1, 1) = 'D' then
begin
if AnsiSameText(DirectoryName, ListItem.DisplayName) then
begin
MessageBox(Handle, '指定的目录已存在！', '提示', MB_OK or MB_ICONINFORMATION);
Exit;
end;
end;
end;
RealICQNetWorkDiskClient.NewDirectory(DirectoryName);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbNDRefreshClick(Sender: TObject);
begin
RealICQNetWorkDiskClient.Refresh;
end;
//------------------------------------------------------------------------------
procedure TMainForm.GoNextLevelUploadMissions(UploadMission: TUploadMission);
var
iLoop: Integer;
Missions: TStringList;
ListItem: TRealICQContacterListItem;
AUploadMission: TUploadMission;
DSearchRec: TSearchRec;
FindResult: Integer;
begin
if UploadMission.FUploadMissionType <> mtDir then
Exit;
Missions := TStringList.Create;
for iLoop := 0 to FLVNetWorkDiskUploadingFiles.Items.Count - 1 do
begin
ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[iLoop] as TRealICQContacterListItem;
AUploadMission := TUploadMission(ListItem.Data);
Missions.AddObject(AUploadMission.FID, AUploadMission);
try
FUploadMissions.Delete(FUploadMissions.IndexOf(AUploadMission.ID));
except
end;
end;
FSavedUploadMissions.Add(Missions);
FLVNetWorkDiskUploadingFiles.Items.Clear;
FindResult := FindFirst(UploadMission.FName + '\*.*', faDirectory, DSearchRec);
while FindResult = 0 do
begin
if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
begin
if DirectoryExists(UploadMission.FName + '\' + DSearchRec.Name) then
begin
AddUploadMission(mtDir, RealICQNetWorkDiskClient.CurrentDirectory.ID, UploadMission.FName + '\' + DSearchRec.Name, False);
end;
end;
FindResult := FindNext(DSearchRec);
end;
FindResult := FindFirst(UploadMission.FName + '\*.*', faAnyFile - faDirectory, DSearchRec);
while FindResult = 0 do
begin
if (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
begin
if FileExists(UploadMission.FName + '\' + DSearchRec.Name) then
begin
AddUploadMission(mtFile, RealICQNetWorkDiskClient.CurrentDirectory.ID, UploadMission.FName + '\' + DSearchRec.Name, False);
end;
end;
FindResult := FindNext(DSearchRec);
end;
CheckUploadMissions;
end;
//------------------------------------------------------------------------------
procedure TMainForm.CheckUploadMissions;
var
ListItem: TRealICQContacterListItem;
UploadMission: TUploadMission;
Missions: TStringList;
iLoop: Integer;
ADirectory: TRealICQNetWorkDiskDirectory;
AFile: TRealICQNetWorkDiskFile;
Finded: Boolean;
MessageBoxResult: Integer;
ConfirmReplaceNDFileForm: TConfirmReplaceNDFileForm;
begin
if FLVNetWorkDiskUploadingFiles.OnlineNumeric = 0 then
begin
if FLVNetWorkDiskUploadingFiles.Items.Count > 0 then
begin
ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[0] as TRealICQContacterListItem;
UploadMission := TUploadMission(ListItem.Data);
if UploadMission.UploadMissionType = mtFile then
begin
with ListItem do
begin
LoginState := stOnline;
HasSMS := True;
Watchword := '';
SMSHint := '取消';
HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + UpBMP);
ReDrawItem;
end;
for iLoop := RealICQNetWorkDiskClient.CurrentDirectory.Files.Count - 1 downto 0 do
begin
AFile := RealICQNetWorkDiskClient.CurrentDirectory.Files[iLoop];
if AnsiSameText(ExtractFileName(AFile.Name), ExtractFileName(UploadMission.Name)) then
begin
if FConfirmReplaceResult <> mrYesToAll then
begin
ConfirmReplaceNDFileForm := TConfirmReplaceNDFileForm.Create(Self);
ConfirmReplaceNDFileForm.Label1.Caption := Format(ConfirmReplaceNDFileForm.Label1.Caption, [ExtractFileName(AFile.Name)]);
try
FConfirmReplaceResult := ConfirmReplaceNDFileForm.ShowModal;
finally
FreeAndNil(ConfirmReplaceNDFileForm);
end;
end;
if (FConfirmReplaceResult = mrYES) or (FConfirmReplaceResult = mrYesToAll) then
begin
//FreeAndNil(AFile);
RealICQNetWorkDiskClient.Delete('F' + IntToStr(AFile.ID));
Sleep(100);
Application.ProcessMessages;
Break;
end
else if FConfirmReplaceResult = mrNO then
begin
FLVNetWorkDiskUploadingFiles.Items.Delete(0);
FreeAndNil(UploadMission);
CheckUploadMissions;
Exit;
end
else if FConfirmReplaceResult = mrCancel then
begin
spbNDCancelAllClick(spbNDCancelAll);
Exit;
end;
end;
end;
while True do
begin
try
RealICQNetWorkDiskClient.UploadFile(UploadMission.Name, UploadMission.DirectoryID, UploadMission.ID);
Break;
except
on E: Exception do
begin
MessageBoxResult := MessageBox(Handle, PChar('上传文件时出错：'#$D#$A#$D#$A + E.Message), '提示', MB_ICONERROR or MB_ABORTRETRYIGNORE);
if MessageBoxResult = ID_ABORT then
begin
spbNDCancelAllClick(spbNDCancelAll);
Exit;
end
else if MessageBoxResult = ID_RETRY then
begin
Continue;
end
else if MessageBoxResult = ID_IGNORE then
begin
FLVNetWorkDiskUploadingFiles.Items.Delete(ListItem.ItemIndex);
FreeAndNil(UploadMission);
CheckUploadMissions;
Exit;
end;
end;
end; //try
end; //while
end
else
begin
with ListItem do
begin
LoginState := stOnline;
HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + UpBMP);
ReDrawItem;
end;
Finded := False;
for iLoop := 0 to RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count - 1 do
begin
ADirectory := RealICQNetWorkDiskClient.CurrentDirectory.Directories[iLoop];
if Length(ExtractFileName(UploadMission.Name)) > 0 then
begin
if AnsiSameText(ADirectory.Name, ExtractFileName(UploadMission.Name)) then
begin
RealICQNetWorkDiskClient.GetDirectory(ADirectory);
Finded := True;
end;
end
else
begin
if AnsiSameText(ADirectory.Name, '[' + Copy(UploadMission.Name, 1, 1) + ']') then
begin
RealICQNetWorkDiskClient.GetDirectory(ADirectory);
Finded := True;
end;
end;
end;
if not Finded then
begin
if Length(ExtractFileName(UploadMission.Name)) = 0 then
RealICQNetWorkDiskClient.NewDirectory('[' + Copy(UploadMission.Name, 1, 1) + ']')
else
RealICQNetWorkDiskClient.NewDirectory(ExtractFileName(UploadMission.Name));
end;
end;
end;
end;
TabSetNDMissions.Tabs.Strings[0] := Format('上传(%d)', [FLVNetWorkDiskUploadingFiles.Items.Count]);
if FLVNetWorkDiskUploadingFiles.Items.Count = 0 then
begin
if FSavedUploadMissions.Count > 0 then
begin
if (RealICQNetWorkDiskClient.CurrentDirectory.Parent <> nil) then
begin
if (RealICQNetWorkDiskClient.CurrentDirectory.Parent.FromServerVersion) then
begin
RealICQNetWorkDiskClient.GetDirectory(RealICQNetWorkDiskClient.CurrentDirectory.Parent);
Missions := TStringList(FSavedUploadMissions[FSavedUploadMissions.Count - 1]);
FSavedUploadMissions.Remove(Missions);
for iLoop := 0 to Missions.Count - 1 do
begin
UploadMission := Missions.Objects[iLoop] as TUploadMission;
AddUploadMission(UploadMission.UploadMissionType, UploadMission.DirectoryID, UploadMission.Name, False);
FreeAndNil(UploadMission);
end;
Missions.Clear;
FreeAndNil(Missions);
CheckUploadMissions;
Exit;
end;
end;
end
else
begin
RealICQNetWorkDiskClient.GetUsedSpaceSize;
end;
end;
CheckNDControlState;
end;
//------------------------------------------------------------------------------
procedure TMainForm.CheckNDControlState;
begin
if (FLVNetWorkDiskUploadingFiles <> nil) and (FLVNetWorkDiskUploadingFiles.Items.Count = 0) and (FLVNetWorkDiskDownloadingFiles.Items.Count = 0) and (FSavedUploadMissions.Count = 0) and (FSavedDownloadMissions.Count = 0) then
begin
pnlNDMissions.Visible := False;
SplitterNDMissions.Visible := pnlNDMissions.Visible;
end;
spbNDMoveUp.Enabled := not pnlNDMissions.Visible;
spbNDNewDir.Enabled := not pnlNDMissions.Visible;
spbNDDelete.Enabled := not pnlNDMissions.Visible;
spbNDUpload.Enabled := not pnlNDMissions.Visible;
spbNDDownload.Enabled := not pnlNDMissions.Visible;
spbNDRefresh.Enabled := not pnlNDMissions.Visible;
spbNDCancelAll.Enabled := pnlNDMissions.Visible;
spbNDMoveUp.Enabled := (not pnlNDMissions.Visible) and (RealICQNetWorkDiskClient <> nil) and (RealICQNetWorkDiskClient.CurrentDirectory <> nil) and (RealICQNetWorkDiskClient.CurrentDirectory.Parent <> nil) and (RealICQNetWorkDiskClient.Connected);
if not pnlNDMissions.Visible then
begin
FConfirmReplaceResult := -1;
FLastDownloadDirectory := '';
NDSelectItemChanged(nil);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.AddUploadMission(AUploadMissionType: TNDMissionType; ADirectoryID: Integer; AName: string; CheckMission: Boolean = True);
var
UploadMission: TUploadMission;
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
begin
UploadMission := TUploadMission.Create(AUploadMissionType, ADirectoryID, AName);
if FUploadMissions.IndexOf(UploadMission.ID) >= 0 then
begin
MessageBox(Handle, PChar(AName + ' 已在任务队列中！'), '提示', MB_ICONINFORMATION);
Exit;
end;
FUploadMissions.AddObject(UploadMission.ID, UploadMission);
if not pnlNDMissions.Visible then
pnlNDMissions.Visible := True;
TabSetNDMissions.TabIndex := 0;
SplitterNDMissions.Visible := pnlNDMissions.Visible;
SplitterNDMissions.Top := pnlNDMissions.Top - 10;
ItemIndex := FLVNetWorkDiskUploadingFiles.Items.IndexOf(UploadMission.ID);
if ItemIndex >= 0 then
FLVNetWorkDiskUploadingFiles.Items.Delete(ItemIndex);
ItemIndex := FLVNetWorkDiskUploadingFiles.Items.Add(UploadMission.ID);
ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[ItemIndex] as TRealICQContacterListItem;
with ListItem do
begin
LoginState := stOffline;
Data := UploadMission;
DisplayName := (UploadMission.Name);
Watchword := '队列中';
if UploadMission.UploadMissionType = mtFile then
begin
try
HeadImagePicture.LoadFromFile(GetBitmapFromFileExt(UploadMission.Name));
except
end;
end;
ReDrawItem;
end;
TabSetNDMissions.Tabs.Strings[0] := Format('上传(%d)', [FLVNetWorkDiskUploadingFiles.Items.Count]);
if CheckMission then
CheckUploadMissions;
end;
//------------------------------------------------------------------------------
procedure TMainForm.AddDownloadMission(ADownloadMissionType: TNDMissionType; ADirectoryName: string; AFileID: Integer = 0; AFileName: string = ''; CheckMission: Boolean = True);
var
DownloadMission: TDownloadMission;
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
begin
DownloadMission := TDownloadMission.Create(ADownloadMissionType, ADirectoryName, AFileID, AFileName);
if not pnlNDMissions.Visible then
pnlNDMissions.Visible := True;
TabSetNDMissions.TabIndex := 1;
SplitterNDMissions.Visible := pnlNDMissions.Visible;
SplitterNDMissions.Top := pnlNDMissions.Top - 10;
ItemIndex := FLVNetWorkDiskDownloadingFiles.Items.Add(DownloadMission.ID);
ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[ItemIndex] as TRealICQContacterListItem;
with ListItem do
begin
LoginState := stOffline;
Data := DownloadMission;
Watchword := '队列中';
if DownloadMission.DownloadMissionType = mtFile then
begin
DisplayName := (DownloadMission.FileName);
try
HeadImagePicture.LoadFromFile(GetBitmapFromFileExt(DownloadMission.FileName));
except
end;
end
else
begin
DisplayName := (DownloadMission.DirectoryName);
end;
ReDrawItem;
end;
TabSetNDMissions.Tabs.Strings[1] := Format('下载(%d)', [FLVNetWorkDiskDownloadingFiles.Items.Count]);
if CheckMission then
CheckDownloadMissions;
end;
//------------------------------------------------------------------------------
procedure TMainForm.CheckDownloadMissions;
var
iLoop, jLoop: Integer;
ListItem: TRealICQContacterListItem;
DownloadMission: TDownloadMission;
ADownloadMission: TDownloadMission;
ADirectory: TRealICQNetWorkDiskDirectory;
Missions: TStringList;
begin
if FLVNetWorkDiskDownloadingFiles.OnlineNumeric = 0 then
begin
if FLVNetWorkDiskDownloadingFiles.Items.Count > 0 then
begin
ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[0] as TRealICQContacterListItem;
DownloadMission := TDownloadMission(ListItem.Data);
if DownloadMission.DownloadMissionType = mtFile then
begin
with ListItem do
begin
LoginState := stOnline;
HasSMS := True;
Watchword := '';
SMSHint := '取消';
HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + DownBMP);
ReDrawItem;
end;
if FileExists(DownloadMission.FFileName) then
begin
if FConfirmReplaceResult <> mrYesToAll then
begin
ConfirmReplaceNDFileForm := TConfirmReplaceNDFileForm.Create(Self);
ConfirmReplaceNDFileForm.Label1.Caption := Format(ConfirmReplaceNDFileForm.Label1.Caption, [ExtractFileName(DownloadMission.FFileName)]);
try
FConfirmReplaceResult := ConfirmReplaceNDFileForm.ShowModal;
finally
FreeAndNil(ConfirmReplaceNDFileForm);
end;
end;
if (FConfirmReplaceResult = mrYES) or (FConfirmReplaceResult = mrYesToAll) then
begin
end
else if FConfirmReplaceResult = mrNO then
begin
FLVNetWorkDiskDownloadingFiles.Items.Delete(0);
FreeAndNil(DownloadMission);
CheckDownloadMissions;
Exit;
end
else if FConfirmReplaceResult = mrCancel then
begin
spbNDCancelAllClick(spbNDCancelAll);
Exit;
end;
end;
try
RealICQNetWorkDiskClient.DownloadFile(DownloadMission.FFileID, DownloadMission.FFileName);
except
FLVNetWorkDiskDownloadingFiles.Items.Delete(0);
FreeAndNil(DownloadMission);
CheckDownloadMissions;
Exit;
end;
end
else
begin
with ListItem do
begin
LoginState := stOnline;
HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + DownBMP);
ReDrawItem;
end;
for iLoop := 0 to RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count - 1 do
begin
ADirectory := TRealICQNetWorkDiskDirectory(RealICQNetWorkDiskClient.CurrentDirectory.Directories[iLoop]);
if AnsiSameText(ExtractFileName(ADirectory.Name), ExtractFileName(DownloadMission.DirectoryName)) then
begin
if not DirectoryExists(DownloadMission.DirectoryName) then
CreateDir(DownloadMission.DirectoryName);
FLastDownloadDirectory := DownloadMission.DirectoryName;
FLVNetWorkDiskDownloadingFiles.Items.Delete(0);
FreeAndNil(DownloadMission);
Missions := TStringList.Create;
for jLoop := 0 to FLVNetWorkDiskDownloadingFiles.Items.Count - 1 do
begin
ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[jLoop] as TRealICQContacterListItem;
ADownloadMission := TDownloadMission(ListItem.Data);
Missions.AddObject(ADownloadMission.FID, ADownloadMission);
end;
FSavedDownloadMissions.Add(Missions);
FLVNetWorkDiskDownloadingFiles.Items.Clear;
RealICQNetWorkDiskClient.GetDirectory(ADirectory);
Exit;
end;
end;
end;
end;
end;
TabSetNDMissions.Tabs.Strings[1] := Format('下载(%d)', [FLVNetWorkDiskDownloadingFiles.Items.Count]);
if FLVNetWorkDiskDownloadingFiles.Items.Count = 0 then
begin
if FSavedDownloadMissions.Count > 0 then
begin
if (RealICQNetWorkDiskClient.CurrentDirectory.Parent <> nil) then
begin
if (RealICQNetWorkDiskClient.CurrentDirectory.Parent.FromServerVersion) then
begin
FLastDownloadDirectory := '';
RealICQNetWorkDiskClient.GetDirectory(RealICQNetWorkDiskClient.CurrentDirectory.Parent);
Missions := TStringList(FSavedDownloadMissions[FSavedDownloadMissions.Count - 1]);
FSavedDownloadMissions.Remove(Missions);
for iLoop := 0 to Missions.Count - 1 do
begin
DownloadMission := Missions.Objects[iLoop] as TDownloadMission;
AddDownloadMission(DownloadMission.DownloadMissionType, DownloadMission.DirectoryName, DownloadMission.FileID, DownloadMission.FileName, False);
FreeAndNil(DownloadMission);
end;
Missions.Clear;
FreeAndNil(Missions);
CheckDownloadMissions;
Exit;
end;
end;
end;
end;
CheckNDControlState;
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbNDUploadClick(Sender: TObject);
var
iLoop: Integer;
begin
MainForm.FormStyle := fsNormal;
try
if UploadFileOpenDialog.Execute then
begin
for iLoop := 0 to UploadFileOpenDialog.Files.Count - 1 do
begin
AddUploadMission(mtFile, RealICQNetWorkDiskClient.CurrentDirectory.ID, UploadFileOpenDialog.Files.Strings[iLoop], False);
end;
end;
finally
// if MainForm.AlwaysOnTop then
// MainForm.FormStyle := fsStayOnTop
// else
// MainForm.FormStyle := fsNormal;
CheckUploadMissions;
end;
end;
procedure TMainForm.spbNextClick(Sender: TObject);
var
TabSheet: TTabSheet;
WebBrowser: TWebBrowser;
begin
try
TabSheet := pgcMultiWeb.ActivePage;
WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
if WebBrowser.Busy then
WebBrowser.Stop;
WebBrowser.GoForward;
except
end;
end;
//function TMainForm.GetDefaultBrowser: string;//获取默认浏览器
//var
// reg: TRegistry;
//begin
// reg := TRegistry.Create;
// try
// {reg.RootKey := HKEY_CLASSES_ROOT;
// reg.OpenKey('HTTP\shell\open\ddeexec\Application',false);
// result:=reg.ReadString('');
// reg.CloseKey; }
// reg.RootKey := HKEY_CLASSES_ROOT;
// reg.OpenKey('http\\shell\\open\\command', false);
// result := reg.ReadString('');
// result := Copy(result, Pos('"', result) + 1, Length(result) - 1);
// result := Copy(result, 1, Pos('"', result) - 1);
// reg.CloseKey;
// finally
// if (result = '') then
// result := 'IEXPLORE.EXE';
// reg.Free;
// end;
//end;
//---用户自助管理平台--------------------------------------
procedure TMainForm.spbPersonManageClick(Sender: TObject);
//var
// EncryptStr,
// Md5Pwd,
// Url,
// TmpStr:String;
begin
//Md5Pwd:=Md5En(RealICQClient.Password);
//TmpStr:='{'+RealICQClient.Me.LoginName+'}{'+Md5Pwd+'}';
//EncryptStr:=StrToBase64(Encrypt(TmpStr,'B77A5C561934E089'));
//Url:=RealICQClient.PersonManageUrl+'?'+ EncryptStr;
//ShellExecute(handle,'open', 'IEXPLORE.EXE', 'http://www.baidu.com', nil,SW_SHOWNORMAL);//
// ShellExecute(handle, 'open','http://220.191.210.103:8080/Default.aspx?url=', '','',SW_SHOWDEFAULT);
//MessageBox(Handle, PChar(RealICQClient.WebAppBaseURL), '提示', MB_ICONQUESTION);
//MessageBox(Handle, PChar(LoginURL), '提示', MB_ICONQUESTION);
//ShellExecute(handle, 'open', PChar(GetDefaultBrowser),PChar(Format(RealICQClient.WebAppBaseURL + LoginURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), ''])), '',SW_SHOWDEFAULT);
if FNewConsole then
ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + NewBaseURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(LoginURL)])), '', SW_SHOWDEFAULT)
else
ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(Format(RealICQClient.WebAppBaseURL + BaseURL, [StrToBase64(RealICQClient.LoginName), StrToBase64(MD5En(RealICQClient.Password)), StrToBase64(LoginURL)])), '', SW_SHOWDEFAULT);
end;
procedure TMainForm.spbPrevClick(Sender: TObject);
var
TabSheet: TTabSheet;
WebBrowser: TWebBrowser;
begin
try
TabSheet := pgcMultiWeb.ActivePage;
WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
if WebBrowser.Busy then
WebBrowser.Stop;
WebBrowser.GoBack;
except
end;
end;
procedure TMainForm.spbPrintPrevClick(Sender: TObject);
var
TabSheet: TTabSheet;
WebBrowser: TWebBrowser;
begin
MainForm.FormStyle := fsNormal;
try
try
TabSheet := pgcMultiWeb.ActivePage;
WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
if WebBrowser.QueryStatusWB(OLECMDID_PRINTPREVIEW) = 3 then
WebBrowser.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT, EmptyParam, EmptyParam);
except
end;
finally
// if MainForm.AlwaysOnTop then
// MainForm.FormStyle := fsStayOnTop
// else
// MainForm.FormStyle := fsNormal;
end;
end;
procedure TMainForm.spbRefreshBranchUsersClick(Sender: TObject);
begin
//
{TimerForGetBranchOnlineStates.Enabled := False;
TimerForGetBranchOnlineStates.Enabled := True;}
miChangeServerClick(nil);
TimerForGetBranchUsersOnlineStates.Enabled := False;
TimerForGetBranchUsersOnlineStates.Enabled := True;
end;
procedure TMainForm.spbRefreshClick(Sender: TObject);
var
TabSheet: TTabSheet;
WebBrowser: TWebBrowser;
begin
try
TabSheet := pgcMultiWeb.ActivePage;
WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
if WebBrowser.Busy then
WebBrowser.Stop;
WebBrowser.Refresh;
except
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientNewDirResult(Sender: TObject; Directory: TRealICQNetWorkDiskDirectory);
var
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
UploadMission: TUploadMission;
NDDirName: string;
begin
if FLVNetWorkDiskUploadingFiles.Items.Count > 0 then
begin
ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[0] as TRealICQContacterListItem;
UploadMission := TUploadMission(ListItem.Data);
if UploadMission.UploadMissionType = mtDir then
begin
if Length(ExtractFileName(UploadMission.Name)) = 0 then
NDDirName := '[' + Copy(UploadMission.Name, 1, 1) + ']'
else
NDDirName := ExtractFileName(UploadMission.Name);
if AnsiSameText(NDDirName, Directory.Name) and (Directory.ParentID = UploadMission.DirectoryID) then
begin
RealICQNetWorkDiskClient.GetDirectory(Directory);
Exit;
end;
end;
end;
if Directory.Parent <> RealICQNetWorkDiskClient.CurrentDirectory then
Exit;
ItemIndex := FLVNetWorkDisk.Items.Add('D' + IntToStr(Directory.ID));
ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
with ListItem do
begin
LoginState := stOnline;
Data := Directory;
DisplayName := Directory.Name;
ReDrawItem;
end;
lblNDState.Caption := Format('目录: %d 文件: %d', [RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientNoSpace(Sender: TObject);
begin
ShowNetWorkDiskSpaceInfo;
spbNDCancelAllClick(spbNDCancelAll);
MessageBox(Handle, '抱歉！您的网络硬盘空间不足，任务已取消！', '提示', MB_ICONINFORMATION);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientRenamedDir(Sender: TObject; ADirectory: TRealICQNetWorkDiskDirectory);
var
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
begin
FLVNetWorkDisk.AdjustPosition := False;
try
if ADirectory.Parent <> RealICQNetWorkDiskClient.CurrentDirectory then
Exit;
ItemIndex := FLVNetWorkDisk.Items.IndexOf('D' + IntToStr(ADirectory.ID));
if ItemIndex < 0 then
Exit;
ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
with ListItem do
begin
LoginState := stOnline;
Data := ADirectory;
DisplayName := ADirectory.Name;
ReDrawItem;
end;
finally
FLVNetWorkDisk.AdjustPosition := True;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientRenamedFile(Sender: TObject; AFile: TRealICQNetWorkDiskFile);
var
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
begin
FLVNetWorkDisk.AdjustPosition := False;
try
if AFile.Parent <> RealICQNetWorkDiskClient.CurrentDirectory then
Exit;
ItemIndex := FLVNetWorkDisk.Items.IndexOf('F' + IntToStr(AFile.ID));
if ItemIndex < 0 then
Exit;
ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
with ListItem do
begin
LoginState := stLeave;
Data := AFile;
DisplayName := AFile.Name;
try
HeadImagePicture.LoadFromFile(GetBitmapFromFileExt(AFile.Name));
except
end;
ReDrawItem;
end;
finally
FLVNetWorkDisk.AdjustPosition := True;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientUploadedFile(Sender: TObject; AFile: TRealICQNetWorkDiskFile; AMissionID: string);
var
iLoop: Integer;
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
UploadMission: TUploadMission;
AFile1: TRealICQNetWorkDiskFile;
Finded: Boolean;
begin
try
ItemIndex := FLVNetWorkDiskUploadingFiles.Items.IndexOf(AMissionID);
if ItemIndex >= 0 then
begin
ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[ItemIndex] as TRealICQContacterListItem;
FLVNetWorkDiskUploadingFiles.Items.Delete(ItemIndex);
UploadMission := TUploadMission(ListItem.Data);
FreeAndNil(UploadMission);
end;
FLVNetWorkDisk.AdjustPosition := False;
try
if AFile.Parent <> RealICQNetWorkDiskClient.CurrentDirectory then
Exit;
Finded := False;
ListItem := nil;
for iLoop := FLVNetWorkDisk.Items.Count - 1 downto 0 do
begin
ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
if Copy(ListItem.LoginName, 1, 1) = 'F' then
begin
AFile1 := TRealICQNetWorkDiskFile(ListItem.Data);
if AnsiSameText(AFile1.Name, AFile.Name) then
begin
Finded := True;
Break;
end;
end;
end;
if not Finded then
begin
ItemIndex := FLVNetWorkDisk.Items.IndexOf('F' + IntToStr(AFile.ID));
if ItemIndex >= 0 then
begin
ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
Finded := True;
end;
end;
if not Finded then
begin
ItemIndex := FLVNetWorkDisk.Items.Add('F' + IntToStr(AFile.ID));
ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
end;
with ListItem do
begin
LoginState := stLeave;
Data := AFile;
DisplayName := AFile.Name;
if AFile.Size >= 1024 * 1024 then
Watchword := Format('%0.1fMB', [AFile.Size / (1024 * 1024)])
else if AFile.Size >= 1024 then
Watchword := IntToStr(AFile.Size div 1024) + 'KB'
else
Watchword := IntToStr(AFile.Size) + 'B';
try
HeadImagePicture.LoadFromFile(GetBitmapFromFileExt(AFile.Name));
except
end;
ReDrawItem;
end;
finally
FLVNetWorkDisk.AdjustPosition := True;
lblNDState.Caption := Format('目录: %d 文件: %d', [RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
ShowNetWorkDiskSpaceInfo;
end;
finally
CheckUploadMissions;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientUploadFileAborted(Sender: TObject; AMissionID: string);
var
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
UploadMission: TUploadMission;
begin
try
ItemIndex := FLVNetWorkDiskUploadingFiles.Items.IndexOf(AMissionID);
if ItemIndex >= 0 then
begin
ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[ItemIndex] as TRealICQContacterListItem;
FLVNetWorkDiskUploadingFiles.Items.Delete(ItemIndex);
UploadMission := TUploadMission(ListItem.Data);
FreeAndNil(UploadMission);
end;
finally
CheckUploadMissions;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientUploadingFile(Sender: TObject; ATransmitter: TResponsionStreamTransmitter; ATransmittedSize: Int64);
var
ItemIndex: Integer;
ListItem: TRealICQContacterListItem;
Completed: Integer;
ASpeed: Cardinal;
SpeedStr: string;
begin
ItemIndex := FLVNetWorkDiskUploadingFiles.Items.IndexOf((ATransmitter as TNetWorkFileTransmitter).MissionID);
if ItemIndex >= 0 then
begin
ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[ItemIndex] as TRealICQContacterListItem;
with ListItem do
begin
Completed := ATransmittedSize * 100 div ATransmitter.StreamLength;
try
ASpeed := Round(ATransmittedSize div ((GetTickCount - ATransmitter.StartTicket) div 1000) * 1.2);
except
Exit;
end;
if ASpeed > 1000 * 1000 then
SpeedStr := Format('%0.1fMB/秒', [ASpeed / (1000 * 1000)])
else if ASpeed > 1000 then
SpeedStr := Format('%0.1fKB/秒', [ASpeed / 1000])
else
SpeedStr := Format('%d字节/秒', [ASpeed]);
DisplayName := '(' + IntToStr(Completed) + '%，' + SpeedStr + ')';
DisplayName := DisplayName + ((ATransmitter as TNetWorkFileTransmitter).FileName);
ReDrawItem;
end;
end;
end;
function ServiceGetStatus(sMachine, sService: string): DWord;
var
//service control
//manager handle
schm,
//service handle
schs: SC_Handle;
//service status
ss: TServiceStatus;
//current service status
dwStat: DWord;
begin
dwStat := 0;
//connect to the service
//control manager
schm := OpenSCManager(pchar(sMachine), Nil, SC_MANAGER_CONNECT);
//if successful...
if (schm > 0) then
begin
//open a handle to
//the specified service
schs := OpenService(schm, PChar(sService), SERVICE_QUERY_STATUS);
//if successful...
if (schs > 0) then
begin
//retrieve the current status
//of the specified service
if (QueryServiceStatus(schs, ss)) then
begin
dwStat := ss.dwCurrentState;
end;
//close service handle
CloseServiceHandle(schs);
end;
// close service control
// manager handle
CloseServiceHandle(schm);
end;
Result := dwStat;
end;
function ServiceUninstalled(sMachine, sService: string): boolean;
begin
Result := 0 = ServiceGetStatus(sMachine, sService);
end;
//------------------------------------------------------------------------------
//调用360杀毒软件
//------------------------------------------------------------------------------
//procedure TMainForm.spb360SDClick(Sender: TObject);
//begin
// //
//
//
//
//end;
//------------------------------------------------------------------------------
//调用360安全卫士
//------------------------------------------------------------------------------
//
//procedure TMainForm.spb360SafeClick(Sender: TObject);
//var
// URL: string;
// TempReg: TRegistry;
// safePath: string;
//begin
//
// URL := 'http://' + self.RealICQClient.RemoteAddress + '/client/setup.exe';
//
// try
// TempReg := TRegistry.Create;
// try
// TempReg.RootKey := HKEY_LOCAL_MACHINE;
// if not TempReg.OpenKey('\Software\360Safe\menuext\LiveUpdate360', False) then
// //DownloadUpdate(URL)
//
//
// else
// begin
// safePath := ExtractFilePath(TempReg.ReadString('Application'));
// //WinExec(PChar(safePath+'\360Safe.exe'),SW_SHOW);
//
//
//
// end;
//
// finally
// TempReg.Free;
// end;
// except
// end;
//
//end;
//------------------------------------------------------------------------------
procedure TMainForm.spbNDDeleteClick(Sender: TObject);
var
ListItem: TRealICQContacterListItem;
iLoop: Integer;
AList: string;
begin
if FLVNetWorkDisk.SelCount <= 0 then
Exit;
if (GetKeyState(VK_Shift) and - 128) = 0 then
begin
if MessageBox(Handle, '确认要删除选中的文件吗？', '提示', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
Exit;
end;
AList := '';
for iLoop := FLVNetWorkDisk.Items.Count - 1 downto 0 do
begin
ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
AList := AList + ListItem.LoginName + Chr(10);
end;
if Length(AList) >= 1024 then
begin
RealICQNetWorkDiskClient.Delete(AList);
AList := '';
Sleep(1000);
end;
end;
if Length(AList) > 0 then
RealICQNetWorkDiskClient.Delete(AList);
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbNDDisconnectClick(Sender: TObject);
begin
RealICQNetWorkDiskClient.Logout;
end;
//------------------------------------------------------------------------------
procedure TMainForm.spbNDDownloadClick(Sender: TObject);
var
iLoop: Integer;
ListItem: TRealICQContacterListItem;
Dir: string;
AFile: TRealICQNetWorkDiskFile;
ADirectory: TRealICQNetWorkDiskDirectory;
begin
if FLVNetWorkDisk.SelCount = 0 then
Exit;
if FLVNetWorkDisk.SelCount = 1 then
begin
for iLoop := 0 to FLVNetWorkDisk.Items.Count - 1 do
begin
ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
if Copy(ListItem.LoginName, 1, 1) = 'F' then
begin
NDItemDoubleClick(ListItem);
Exit;
end;
end;
end;
end;
MainForm.FormStyle := fsNormal;
try
if SelectDirectory('请选择目录', '', Dir) then
begin
for iLoop := 0 to FLVNetWorkDisk.Items.Count - 1 do
begin
ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
if Copy(ListItem.LoginName, 1, 1) = 'D' then
begin
ADirectory := TRealICQNetWorkDiskDirectory(ListItem.Data);
AddDownloadMission(mtDir, Dir + '\' + ADirectory.Name, 0, '', False);
end
else
begin
AFile := TRealICQNetWorkDiskFile(ListItem.Data);
AddDownloadMission(mtFile, ExtractFilePath(Dir), AFile.ID, Dir + '\' + AFile.Name, False);
end;
end;
end; //for
CheckDownloadMissions;
end;
finally
// if MainForm.AlwaysOnTop then
// MainForm.FormStyle := fsStayOnTop
// else
// MainForm.FormStyle := fsNormal;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.NDItemDoubleClick(Item: TRealICQContacterListItem);
var
AFile: TRealICQNetWorkDiskFile;
ADirectory: TRealICQNetWorkDiskDirectory;
begin
if (FLVNetWorkDiskUploadingFiles.Items.Count > 0) or (FLVNetWorkDiskDownloadingFiles.Items.Count > 0) or (FSavedUploadMissions.Count > 0) then
begin
Exit;
end;
if Copy(Item.LoginName, 1, 1) = 'D' then
begin
ADirectory := TRealICQNetWorkDiskDirectory(Item.Data);
RealICQNetWorkDiskClient.GetDirectory(ADirectory);
end
else if Copy(Item.LoginName, 1, 1) = 'F' then
begin
AFile := TRealICQNetWorkDiskFile(Item.Data);
MainForm.FormStyle := fsNormal;
try
DownloadFileSaveDialog.FileName := AFile.Name;
if DownloadFileSaveDialog.Execute then
begin
AddDownloadMission(mtFile, ExtractFilePath(DownloadFileSaveDialog.FileName), AFile.ID, DownloadFileSaveDialog.FileName, True);
end;
finally
// if MainForm.AlwaysOnTop then
// MainForm.FormStyle := fsStayOnTop
// else
// MainForm.FormStyle := fsNormal;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientDeleteResult(Sender: TObject; AList: string);
var
AStringList: TStringList;
iLoop, iIndex: Integer;
begin
AStringList := SplitString(AList, Chr(10));
FLVNetWorkDisk.DisableAlign;
try
for iLoop := 0 to AStringList.Count - 1 do
begin
iIndex := FLVNetWorkDisk.Items.IndexOf(AStringList.Strings[iLoop]);
if iIndex >= 0 then
FLVNetWorkDisk.Items.Delete(iIndex);
end;
finally
FLVNetWorkDisk.EnableAlign;
FreeAndNil(AStringList);
lblNDState.Caption := Format('目录: %d 文件: %d', [RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
ShowNetWorkDiskSpaceInfo;
NDSelectItemChanged(nil);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientDirectoryListReady(Sender: TObject);
var
iLoop, ItemIndex: Integer;
AFile: TRealICQNetWorkDiskFile;
ADirectory: TRealICQNetWorkDiskDirectory;
ListItem: TRealICQContacterListItem;
Bitmap: TBitmap;
UploadMission: TUploadMission;
NDDirName: string;
begin
spbNDMoveUp.Enabled := (not pnlNDMissions.Visible) and (RealICQNetWorkDiskClient.CurrentDirectory.Parent <> nil) and (RealICQNetWorkDiskClient.Connected);
edNDDir.Text := '';
ADirectory := RealICQNetWorkDiskClient.CurrentDirectory;
while ADirectory <> nil do
begin
edNDDir.Text := ADirectory.Name + '\' + edNDDir.Text;
ADirectory := ADirectory.Parent;
end;
try
FLVNetWorkDisk.AdjustPosition := False;
FLVNetWorkDisk.DisableAlign;
FLVNetWorkDisk.Items.Clear;
NDSelectItemChanged(nil);
for iLoop := 0 to RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count - 1 do
begin
ADirectory := TRealICQNetWorkDiskDirectory(RealICQNetWorkDiskClient.CurrentDirectory.Directories[iLoop]);
ItemIndex := FLVNetWorkDisk.Items.Add('D' + IntToStr(ADirectory.ID));
ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
with ListItem do
begin
LoginState := stOnline;
Data := ADirectory;
DisplayName := ADirectory.Name;
end;
lblNDState.Caption := Format('载入... 目录: %d/%d 文件: %d/%d', [iLoop + 1, RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, 0, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
lblNDState.Update;
end;
for iLoop := 0 to RealICQNetWorkDiskClient.CurrentDirectory.Files.Count - 1 do
begin
AFile := TRealICQNetWorkDiskFile(RealICQNetWorkDiskClient.CurrentDirectory.Files[iLoop]);
ItemIndex := FLVNetWorkDisk.Items.Add('F' + IntToStr(AFile.ID));
ListItem := FLVNetWorkDisk.Items.Objects[ItemIndex] as TRealICQContacterListItem;
with ListItem do
begin
LoginState := stLeave;
Data := AFile;
DisplayName := AFile.Name;
if AFile.Size >= 1024 * 1024 then
Watchword := Format('%0.1fMB', [AFile.Size / (1024 * 1024)])
else if AFile.Size >= 1024 then
Watchword := IntToStr(AFile.Size div 1024) + 'KB'
else
Watchword := IntToStr(AFile.Size) + 'B';
try
HeadImagePicture.LoadFromFile(GetBitmapFromFileExt(AFile.Name));
except
end;
FreeAndNil(Bitmap);
end;
lblNDState.Caption := Format('载入... 目录: %d/%d 文件: %d/%d', [RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, iLoop + 1, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
lblNDState.Update;
end;
finally
FLVNetWorkDisk.ReDrawAll;
FLVNetWorkDisk.EnableAlign;
FLVNetWorkDisk.AdjustPosition := True;
lblNDState.Caption := Format('目录: %d 文件: %d', [RealICQNetWorkDiskClient.CurrentDirectory.Directories.Count, RealICQNetWorkDiskClient.CurrentDirectory.Files.Count]);
end;
if FLVNetWorkDiskUploadingFiles.Items.Count > 0 then
begin
ListItem := FLVNetWorkDiskUploadingFiles.Items.Objects[0] as TRealICQContacterListItem;
UploadMission := TUploadMission(ListItem.Data);
if UploadMission.UploadMissionType = mtDir then
begin
if Length(ExtractFileName(UploadMission.Name)) = 0 then
NDDirName := '[' + Copy(UploadMission.Name, 1, 1) + ']'
else
NDDirName := ExtractFileName(UploadMission.Name);
if AnsiSameText(NDDirName, RealICQNetWorkDiskClient.CurrentDirectory.Name) and (RealICQNetWorkDiskClient.CurrentDirectory.ParentID = UploadMission.DirectoryID) then
begin
try
FLVNetWorkDiskUploadingFiles.Items.Delete(0);
except
end;
try
GoNextLevelUploadMissions(UploadMission);
finally
FreeAndNil(UploadMission);
end;
Exit;
end;
end;
end;
if Length(Trim(FLastDownloadDirectory)) > 0 then
begin
if (DirectoryExists(FLastDownloadDirectory)) then
begin
for iLoop := 0 to FLVNetWorkDisk.Items.Count - 1 do
begin
ListItem := FLVNetWorkDisk.Items.Objects[iLoop] as TRealICQContacterListItem;
if Copy(ListItem.LoginName, 1, 1) = 'D' then
begin
ADirectory := TRealICQNetWorkDiskDirectory(ListItem.Data);
AddDownloadMission(mtDir, FLastDownloadDirectory + '\' + ADirectory.Name, 0, '', False);
end
else
begin
AFile := TRealICQNetWorkDiskFile(ListItem.Data);
AddDownloadMission(mtFile, ExtractFilePath(FLastDownloadDirectory), AFile.ID, FLastDownloadDirectory + '\' + AFile.Name, False);
end;
end; //for
CheckDownloadMissions;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientDownloadFileAborted(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
begin
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientDownloadFileCompleted(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
var
ListItem: TRealICQContacterListItem;
DownloadMission: TDownloadMission;
MessageBoxResult: Integer;
begin
if not RealICQNetWorkDiskClient.Connected then
Exit;
try
if FLVNetWorkDiskDownloadingFiles.Items.Count > 0 then
begin
ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[0] as TRealICQContacterListItem;
DownloadMission := TDownloadMission(ListItem.Data);
if DownloadMission.FFileID = AFileDownloader.FileID then
begin
if not AFileDownloader.Completed then
begin
if AFileDownloader.Exp <> nil then
begin
MessageBoxResult := MessageBox(Handle, PChar('下载文件时出错：'#$D#$A#$D#$A + AFileDownloader.Exp.Message), '提示', MB_ICONERROR or MB_ABORTRETRYIGNORE);
if MessageBoxResult = ID_ABORT then
begin
spbNDCancelAllClick(spbNDCancelAll);
Exit;
end
else if MessageBoxResult = ID_RETRY then
begin
CheckDownloadMissions;
Exit;
end
else if MessageBoxResult = ID_IGNORE then
begin
end;
end;
end;
FLVNetWorkDiskDownloadingFiles.Items.Delete(0);
FreeAndNil(DownloadMission);
end;
end;
except
end;
CheckDownloadMissions;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientDownloadFileTransmitting(Sender: TObject; AFileDownloader: TRealICQNWDFileDownloader);
var
ListItem: TRealICQContacterListItem;
Completed: Integer;
ASpeed: Cardinal;
SpeedStr: string;
begin
if FLVNetWorkDiskDownloadingFiles.Items.Count > 0 then
begin
ListItem := FLVNetWorkDiskDownloadingFiles.Items.Objects[0] as TRealICQContacterListItem;
with ListItem do
begin
Completed := AFileDownloader.RecvedSize * 100 div AFileDownloader.FileSize;
try
ASpeed := Round(AFileDownloader.RecvedSize div ((GetTickCount - AFileDownloader.StartTicket) div 1000) * 1.2);
except
Exit;
end;
if ASpeed > 1000 * 1000 then
SpeedStr := Format('%0.1fMB/秒', [ASpeed / (1000 * 1000)])
else if ASpeed > 1000 then
SpeedStr := Format('%0.1fKB/秒', [ASpeed / 1000])
else
SpeedStr := Format('%d字节/秒', [ASpeed]);
DisplayName := '(' + IntToStr(Completed) + '%，' + SpeedStr + ')';
DisplayName := DisplayName + (AFileDownloader.LocalFileName);
ReDrawItem;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientGettedUsedSpaceSize(Sender: TObject);
begin
ShowNetWorkDiskSpaceInfo;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientLoginFailed(Sender: TObject; E: Exception);
begin
lblNDState.Caption := '连接失败（' + E.Message + '）';
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQNetWorkDiskClientLoginResult(Sender: TObject; LoginResultType: Byte);
begin
if LoginResultType = 0 then
begin
RealICQNetWorkDiskClient.GetDirectory(RealICQNetWorkDiskClient.CurrentDirectory);
end
else if LoginResultType = 1 then
begin
lblNDState.Caption := '连接失败，服务器版本错误';
end
else if LoginResultType = 2 then
begin
lblNDState.Caption := '连接失败，用户验证错误';
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientBeDropped(Sender: TObject; Excuse: string);
begin
MessageBox(Handle, PChar(Excuse), '你已被强制下线', MB_ICONINFORMATION or MB_OK);
TTeamsAdapter.Stop;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientDownloadFile(Sender: TObject; AFileName: string);
var
iLoop: Integer;
WebPanel: TWebPanel;
TabSheet: TTabSheet;
Bitmap: TBitmap;
begin
for iLoop := 0 to FWebTabs.Count - 1 do
begin
TabSheet := FWebTabs[iLoop];
WebPanel := FWebPanels.Objects[iLoop] as TWebPanel;
if AnsiSameText(WebPanel.Image, AFileName) then
begin
Bitmap := TBitmap.Create;
try
try
Bitmap.LoadFromFile(AFileName);
Bitmap.SetSize(ImgLstPageControl.Width, ImgLstPageControl.Height);
ImgLstPageControl.Add(Bitmap, Bitmap);
TabSheet.ImageIndex := ImgLstPageControl.Count - 1;
except
end;
finally
FreeAndNil(Bitmap);
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientDownloadTeamFace(Sender: TObject; AFileName: string);
begin
ShowGettedFace(AFileName);
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientLoginFailed(Sender: TObject; E: Exception);
begin
TimerForLogining.Enabled := False;
SetUIState;
MessageBox(Handle, PChar('抱歉，您现在无法登录至服务器： ' + E.Message), '登录失败', MB_ICONINFORMATION or MB_OK);
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowLoginNameExecute(Sender: TObject);
var
iLoop: Integer;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
RealICQContacterListView.CaptionStyle := csLoginName;
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
RealICQContacterTreeView.CaptionStyle := csLoginName;
RealICQContacterTreeView.ReDrawAll;
end;
FLVCaptionStyle := csLoginName;
SaveStyleConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowDisplayNameExecute(Sender: TObject);
var
iLoop: Integer;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
RealICQContacterListView.CaptionStyle := csDisplayName;
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
RealICQContacterTreeView.CaptionStyle := csDisplayName;
RealICQContacterTreeView.ReDrawAll;
end;
FLVCaptionStyle := csDisplayName;
SaveStyleConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowGIFInMailFormExecute(Sender: TObject);
begin
actShowGIFInMailForm.Checked := not actShowGIFInMailForm.Checked;
FShowGIFInMailForm := actShowGIFInMailForm.Checked;
SaveStyleConfigs;
if RealICQClient.Me = nil then
Exit;
if RealICQClient.Me.HeadImageFileType = htGIF then
begin
ShowMeInformation;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowGIFInTalkingFormExecute(Sender: TObject);
begin
actShowGIFInTalkingForm.Checked := not actShowGIFInTalkingForm.Checked;
FShowGIFInTalkingForm := actShowGIFInTalkingForm.Checked;
SaveStyleConfigs;
UpdateAllTakingFormGIFHeadImage;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowGroupExecute(Sender: TObject);
begin
FShowGroup := not FShowGroup;
actShowGroup.Checked := FShowGroup;
SaveIfShowGroupConfig;
ShowGroupInterface;
end;
//------------------------------------------------------------------------------
function TMainForm.GetSelectedLoginName: string;
var
GroupIndex, iLoop: Integer;
GroupName: string;
ListView: TRealICQContacterListView;
ListItem: TRealICQContacterListItem;
ItemIndex: Integer;
RealICQFriendTreeView: TRealICQContacterTreeView;
RealICQContacterTreeView: TRealICQContacterTreeView;
Employee: TRealICQEmployee;
Friend: TRealICQEmployee;
begin
Result := '';
if FSearchListViewInVisible then
begin
for iLoop := 0 to FSearchListView.Items.Count - 1 do
begin
ListItem := FSearchListView.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
Result := ListItem.LoginName;
Exit;
end;
end;
end;
GroupName := GetActiveTabSheetName;
if GroupName = LVMyContacters then
begin
ItemIndex := FContacterTreeViews.IndexOf(LVMyContacters);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Employee := RealICQContacterTreeView.GetSelectedEmployee;
if Employee <> nil then
begin
Result := Employee.LoginName;
end;
Exit;
end;
if GroupName = LVMoreUsers then
begin
ItemIndex := FContacterTreeViews.IndexOf(LVMoreUsers);
RealICQContacterTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Employee := RealICQContacterTreeView.GetSelectedEmployee;
if Employee <> nil then
begin
Result := Employee.LoginName;
end;
Exit;
end;
if GroupName = LVFriends then
begin
ItemIndex := FContacterTreeViews.IndexOf(LVFriends);
RealICQFriendTreeView := FContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
Friend := RealICQFriendTreeView.GetSelectedEmployee;
if Friend <> nil then
begin
Result := Friend.LoginName;
end;
Exit;
end;
GroupIndex := FContacterListViews.IndexOf(GroupName);
ListView := FContacterListViews.Objects[GroupIndex] as TRealICQContacterListView;
for iLoop := 0 to ListView.Items.Count - 1 do
begin
ListItem := ListView.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
Result := ListItem.LoginName;
Break;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowHistoryExecute(Sender: TObject);
var
LoginName: string;
begin
LoginName := GetSelectedLoginName;
if LoginName <> '' then
begin
OpenMessagesManagerForm;
Application.ProcessMessages;
MessagesManagerForm.ShowUsersMessages(LoginName);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actSeeInformationExecute(Sender: TObject);
var
LoginName: string;
begin
LoginName := GetSelectedLoginName;
if LoginName <> '' then
begin
SeeUserInformation(LoginName);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actChangeRemarkExecute(Sender: TObject);
var
LoginName: string;
Remark: string;
RealICQUser: TRealICQUser;
begin
LoginName := GetSelectedLoginName;
if LoginName <> '' then
begin
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(LoginName);
if RealICQUser = nil then
Exit;
if (RealICQUser.LoginName = RealICQClient.Me.LoginName) then
begin
ShowMessage('不允许修改自己的备注名称！');
Exit;
end;
Remark := RealICQUser.Remark;
Remark := Trim(ShowMyInputBox('修改备注名称', '新备注名称', RealICQUser.Remark, 50));
if not AnsiSameStr(Remark, RealICQUser.Remark) then
RealICQClient.ChangeRemark(LoginName, Remark);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actSendMessageExecute(Sender: TObject);
var
LoginName: string;
begin
LoginName := GetSelectedLoginName;
if LoginName <> '' then
begin
if AnsiSameText(LoginName, RealICQClient.LoginName) then
begin
MessageBox(Handle, '对不起，不可以和自己对话！', '提示', MB_ICONINFORMATION);
Exit;
end;
//----------------------------------------
{if GetActiveTabSheetName=MoreUser then
begin
RealICQClient.GetUserInformation(LoginName,True);
end;}
OpenTalkingForm(LoginName);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actSendTeamMessageExecute(Sender: TObject);
var
iLoop: Integer;
ListItem: TRealICQContacterListItem;
RealICQTeam: TRealICQTeam;
begin
if FLVTeams.SelCount = 1 then
begin
for iLoop := 0 to FLVTeams.Items.Count - 1 do
begin
ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
RealICQTeam := ListItem.Data;
OpenTeamTalkingForm(RealICQTeam.TeamID);
Break;
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actSeeTeamInformationExecute(Sender: TObject);
var
iLoop: Integer;
ListItem: TRealICQContacterListItem;
RealICQTeam: TRealICQTeam;
begin
if FLVTeams.SelCount = 1 then
begin
for iLoop := 0 to FLVTeams.Items.Count - 1 do
begin
ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
RealICQTeam := ListItem.Data;
OpenTeamOptionsForm(RealICQTeam);
Break;
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actQuitTeamExecute(Sender: TObject);
var
iLoop: Integer;
ListItem: TRealICQContacterListItem;
RealICQTeam: TRealICQTeam;
begin
if FLVTeams.SelCount = 1 then
begin
for iLoop := 0 to FLVTeams.Items.Count - 1 do
begin
ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
RealICQTeam := ListItem.Data;
if MessageBox(Handle, '真的要退出该群组吗?', '提示', MB_ICONINFORMATION or MB_OKCANCEL) <> ID_OK then
Exit;
TTeamsAdapter.QuitTeam(RealICQTeam.TeamID);
Break;
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actDisbandTeamExecute(Sender: TObject);
var
iLoop: Integer;
ListItem: TRealICQContacterListItem;
RealICQTeam: TRealICQTeam;
begin
{if FLVTeams.SelCount = 1 then
begin
for iLoop := 0 to FLVTeams.Items.Count - 1 do
begin
ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
RealICQTeam := ListItem.Data;
if MessageBox(Handle, '真的要解散该群组吗?', '提示', MB_ICONINFORMATION or MB_OKCANCEL) <> ID_OK then Exit;
RealICQClient.DisbandTeam(RealICQTeam.TeamID);
Break;
end;
end;
end; }
if FLVTeams.SelCount = 1 then
begin
for iLoop := 0 to FLVTeams.Items.Count - 1 do
begin
ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
RealICQTeam := ListItem.Data;
if MessageBox(Handle, '真的要解散该群组吗?', '提示', MB_ICONINFORMATION or MB_OKCANCEL) <> ID_OK then
Exit;
TTeamsAdapter.DisbandTeam(RealICQTeam.TeamID);
Break;
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actQuitOrDisbandTeamsExecute(Sender: TObject);
var
iLoop: Integer;
ListItem: TRealICQContacterListItem;
RealICQTeam: TRealICQTeam;
begin
if MessageBox(Handle, '真的要退出 / 解散选中的群组吗?', '提示', MB_ICONINFORMATION or MB_OKCANCEL) <> ID_OK then
Exit;
for iLoop := 0 to FLVTeams.Items.Count - 1 do
begin
ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
RealICQTeam := ListItem.Data;
if AnsiSameText(RealICQTeam.TeamCreater, RealICQClient.LoginName) then
RealICQClient.DisbandTeam(RealICQTeam.TeamID)
else
RealICQClient.QuitTeam(RealICQTeam.TeamID);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowAllNameExecute(Sender: TObject);
var
iLoop: Integer;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
RealICQContacterListView.CaptionStyle := csDisplayNameAndLoginName;
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
RealICQContacterTreeView.CaptionStyle := csDisplayNameAndLoginName;
RealICQContacterTreeView.ReDrawAll;
end;
FLVCaptionStyle := csDisplayNameAndLoginName;
SaveStyleConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowBigHeadImageExecute(Sender: TObject);
var
iLoop: Integer;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
RealICQContacterListView.Style := lsBigHeadImage;
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
RealICQContacterTreeView.Style := lsBigHeadImage;
RealICQContacterTreeView.ReDrawAll;
end;
FLVStyle := lsBigHeadImage;
SaveStyleConfigs;
end;
procedure TMainForm.actShowMiddleHeadImageExecute(Sender: TObject);
var
iLoop: Integer;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
RealICQContacterListView.Style := lsMiddleHeadImage;
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
RealICQContacterTreeView.Style := lsMiddleHeadImage;
RealICQContacterTreeView.ReDrawAll;
end;
FLVStyle := lsMiddleHeadImage;
SaveStyleConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowSmallHeadImageExecute(Sender: TObject);
var
iLoop: Integer;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
RealICQContacterListView.Style := lsSmallHeadImage;
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
RealICQContacterTreeView.Style := lsSmallHeadImage;
RealICQContacterTreeView.ReDrawAll;
end;
FLVStyle := lsSmallHeadImage;
SaveStyleConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowStrangersExecute(Sender: TObject);
begin
// SaveStyleConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowBlacklistsExecute(Sender: TObject);
begin
// SaveStyleConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowTeamHistoryExecute(Sender: TObject);
var
iLoop: Integer;
ListItem: TRealICQContacterListItem;
RealICQTeam: TRealICQTeam;
begin
if FLVTeams.SelCount = 1 then
begin
for iLoop := 0 to FLVTeams.Items.Count - 1 do
begin
ListItem := FLVTeams.Items.Objects[iLoop] as TRealICQContacterListItem;
if ListItem.Selected then
begin
RealICQTeam := ListItem.Data;
OpenMessagesManagerForm;
Application.ProcessMessages;
MessagesManagerForm.ShowTeamsMessages(RealICQTeam.TeamID);
Break;
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowTeamsExecute(Sender: TObject);
begin
// SaveStyleConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowTreeExecute(Sender: TObject);
begin
FShowTree := not FShowTree;
actShowTree.Checked := FShowTree;
actShowBigHeadImage.Visible := not actShowTree.Checked;
actShowMiddleHeadImage.Visible := not actShowTree.Checked;
if FShowTree then
begin
if FLVStyle <> lsNoHeadImage then
begin
FLVStyle := lsSmallHeadImage;
actShowSmallHeadImage.Execute;
end;
end;
SaveStyleConfigs;
ShowGroupInterface;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure TMainForm.actAboutExecute(Sender: TObject);
begin
AboutForm := TAboutForm.Create(Self);
try
AboutForm.ShowModal;
finally
FreeAndNil(AboutForm);
end;
end;
procedure TMainForm.actAlwaysOnTopExecute(Sender: TObject);
begin
if FAlwaysOnTop then
SetOnTop(Handle, True)
else
SetOnTop(Handle, False);
actAlwaysOnTop.Checked := FAlwaysOnTop;
SaveDefaultConfigs;
end;
procedure TMainForm.actShowNormalHeadImageExecute(Sender: TObject);
var
iLoop: Integer;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
RealICQContacterListView.Style := lsNoHeadImage;
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
RealICQContacterTreeView.Style := lsNoHeadImage;
RealICQContacterTreeView.ReDrawAll;
end;
FLVStyle := lsNoHeadImage;
SaveStyleConfigs;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actShowRemarkExecute(Sender: TObject);
var
iLoop, jLoop: Integer;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterTreeView: TRealICQContacterTreeView;
RealICQContacterListItem: TRealICQContacterListItem;
RealICQUser: TRealICQUser;
Employee: TRealICQEmployee;
begin
actShowRemark.Checked := not actShowRemark.Checked;
RealICQClient.ShowRemark := actShowRemark.Checked;
for iLoop := 0 to FContacterListViews.Count - 1 do
begin
RealICQContacterListView := FContacterListViews.Objects[iLoop] as TRealICQContacterListView;
for jLoop := 0 to RealICQContacterListView.Items.Count - 1 do
begin
RealICQContacterListItem := RealICQContacterListView.Items.Objects[jLoop] as TRealICQContacterListItem;
RealICQUser := RealICQContacterListItem.Data;
//BindUserDataToItem(RealICQContacterListItem, RealICQUser);
TUsersService.GetUsersService.UpdateListItem(RealICQContacterListView, RealICQContacterListItem, RealICQUser);
end;
end;
for iLoop := 0 to FContacterTreeViews.Count - 1 do
begin
RealICQContacterTreeView := FContacterTreeViews.Objects[iLoop] as TRealICQContacterTreeView;
for jLoop := 0 to RealICQContacterTreeView.Count - 1 do
begin
Employee := RealICQContacterTreeView.EmployeeItems.Objects[jLoop] as TRealICQEmployee;
RealICQUser := Employee.Data;
//UpdateEmployeeNode(Employee, RealICQUser, False);
TUsersService.GetUsersService.UpdateTreeNode(RealICQContacterTreeView, Employee, RealICQUser, False);
end;
RealICQContacterTreeView.ReDrawAll;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actFindUsersExecute(Sender: TObject);
begin
//非办公助手企业用户无查找用户权限
if (FProductType <> ptBGZS) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
begin
ShowMessage('您没有查找用户权限! ');
Exit;
end;
if SearchForm <> nil then
begin
SearchForm.BringToFront;
Exit;
end;
SearchForm := TSearchForm.Create(Application);
SearchForm.Show;
end;
procedure TMainForm.actGroupManagerExecute(Sender: TObject);
begin
if GroupManagerForm <> nil then
Exit;
GroupManagerForm := TGroupManagerForm.Create(Self);
try
GroupManagerForm.ShowModal;
finally
FreeAndNil(GroupManagerForm);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.OpenMessagesManagerForm;
begin
actMsgManagerExecute(nil);
end;
//------------------------------------------------------------------------------
procedure TMainForm.pgcMainWorkAreaTabChanging(Sender: TObject; NewIndex: Integer; var AllowChanged: Boolean);
var
TabSheet: TTabSheet;
WebPanel: TWebPanel;
Point: TPoint;
begin
{if NewIndex = 1 then
begin
MainForm.RealICQClient.OnGettedAddrBookGroups:=GettedAddrBookGroups;
MainForm.RealICQClient.OnManageAddrBookResult:=GettedManageAddrBookResult;
RealICQClient.SendGetAddrBookGroup;
end;}
if NewIndex > 2 then
begin
AllowChanged := False;
//if not DisplayWebs then Exit;
TabSheet := pgcMainWorkArea.Pages[NewIndex];
WebPanel := FWebPanels.Objects[TabSheet.Tag] as TWebPanel;
//if WebPanel.FNavigateType = ntFill then AllowChanged := True;
if WebPanel.Acounts.Count > 1 then
begin
if not ((Pos('[%', WebPanel.URL) <= 0) and (Pos('%]', WebPanel.URL) <= 0) and (Pos('[%', WebPanel.PostFields) <= 0) and (Pos('%]', WebPanel.PostFields) <= 0)) then
begin
Point.X := Mouse.CursorPos.X;
Point.Y := Mouse.CursorPos.Y;
FreeAndNil(SelWebTabAcountsForm);
SelWebTabAcountsForm := TSelWebTabAcountsForm.Create(Self);
SelWebTabAcountsForm.WebPanel := WebPanel;
SelWebTabAcountsForm.TabSheet := TabSheet;
SelWebTabAcountsForm.Left := Point.X;
SelWebTabAcountsForm.Top := Point.Y - 20;
if Left <= SelWebTabAcountsForm.Width then
SelWebTabAcountsForm.Left := Left + Width
else
SelWebTabAcountsForm.Left := Left - SelWebTabAcountsForm.Width;
if WebPanel.Acounts.Count < 10 then
SelWebTabAcountsForm.pnlClient.Constraints.MinHeight := WebPanel.Acounts.Count * cntHeightOfBigHeadImage + 3
else
SelWebTabAcountsForm.pnlClient.Constraints.MinHeight := 10 * cntHeightOfBigHeadImage + 3;
SelWebTabAcountsForm.pnlClient.Constraints.MaxHeight := SelWebTabAcountsForm.pnlClient.Constraints.MinHeight;
SelWebTabAcountsForm.Show;
Exit;
end;
end;
WebTabShow(TabSheet);
end;
end;
procedure TMainForm.pgcMainWorkAreaWebPanelButtonClick(Sender: TObject);
begin
pgcMainWorkArea.OnWebPanelButtonClick := nil;
if OptionsForm = nil then
OptionsForm := TOptionsForm.Create(Self);
try
OptionsForm.PageIndex := 10;
OptionsForm.ShowModal;
finally
FreeAndNil(OptionsForm);
pgcMainWorkArea.OnWebPanelButtonClick := pgcMainWorkAreaWebPanelButtonClick;
end;
end;
//调整各标签位置
procedure TMainForm.pnlToolBarResize(Sender: TObject);
var
AvgWidth: Integer;
iLeft: Integer;
begin
//宁夏企业用户隐藏全市标签
//if (FProductType = ptNXSQ) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
if (FProductType = ptNXSQ) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
begin
SysMsg.Visible := False;
SysMsgIcon.Visible := False;
AvgWidth := (pnlToolBar.Width - 2) div 4;
iLeft := 1;
MyContacters.Left := iLeft;
MyContacters.Width := AvgWidth;
MyContactersIcon.Left := iLeft + (AvgWidth - MyContactersIcon.Width) div 2;
iLeft := iLeft + AvgWidth;
MyTeam.Left := iLeft;
MyTeam.Width := AvgWidth;
MyTeamIcon.Left := iLeft + (AvgWidth - MyTeamIcon.Width) div 2;
iLeft := iLeft + AvgWidth;
MyFriend.Left := iLeft;
MyFriend.Width := AvgWidth;
MyFriendIcon.Left := iLeft + (AvgWidth - MyFriendIcon.Width) div 2;
iLeft := iLeft + AvgWidth;
Latests.Left := iLeft;
Latests.Width := pnlToolBar.Width - (AvgWidth * 3);
LatestsIcon.Left := iLeft + (AvgWidth - LatestsIcon.Width) div 2;
iLeft := iLeft + AvgWidth;
end
else
begin
SysMsg.Visible := True;
SysMsgIcon.Visible := True;
AvgWidth := (pnlToolBar.Width - 2) div 5;
iLeft := 1;
MyContacters.Left := iLeft;
MyContacters.Width := AvgWidth;
MyContactersIcon.Left := iLeft + (AvgWidth - MyContactersIcon.Width) div 2;
iLeft := iLeft + AvgWidth;
SysMsg.Left := iLeft;
SysMsg.Width := AvgWidth;
SysMsgIcon.Left := iLeft + (AvgWidth - SysMsgIcon.Width) div 2;
iLeft := iLeft + AvgWidth;
MyTeam.Left := iLeft;
MyTeam.Width := AvgWidth;
MyTeamIcon.Left := iLeft + (AvgWidth - MyTeamIcon.Width) div 2;
iLeft := iLeft + AvgWidth;
MyFriend.Left := iLeft;
MyFriend.Width := AvgWidth;
MyFriendIcon.Left := iLeft + (AvgWidth - MyFriendIcon.Width) div 2;
iLeft := iLeft + AvgWidth;
Latests.Left := iLeft;
Latests.Width := pnlToolBar.Width - (AvgWidth * 4);
LatestsIcon.Left := iLeft + (AvgWidth - LatestsIcon.Width) div 2;
iLeft := iLeft + AvgWidth;
end;
end;
{设置WebBrowser的样式}
//------------------------------------------------------------------------------
procedure TMainForm.SetDOMStyle(Doc: IHTMLDocument2);
var
CurrentColor, CssColor: string;
begin
try
CurrentColor := IntToHex(ConvertColorToColor(FormColor, MainForm.UIMainColor), 6);
CssColor := '#' + Copy(CurrentColor, 5, 2) + Copy(CurrentColor, 3, 2) + Copy(CurrentColor, 1, 2);
Doc.body.style.cssText := 'word-break: break-all;';
Doc.body.style.border := '0px solid';
Doc.body.style.fontFamily := '宋体';
Doc.body.style.fontSize := '9pt';
Doc.body.style.margin := '0pt';
Doc.body.setAttribute('scroll', 'no', 0);
Doc.body.style.backgroundColor := CssColor;
except
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.WebBrowserRightStatusTextChange(ASender: TObject; const Text: WideString);
var
TabSheet: TTabSheet;
begin
try
TabSheet := ((ASender as TWebBrowser).Owner as TPanel).Owner as TTabSheet;
if pgcMultiWeb.ActivePage = TabSheet then
lblIEStatus.Caption := Text
else
lblIEStatus.Caption := '';
except
lblIEStatus.Caption := Text
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.WebBrowserRightTitleChange(ASender: TObject; const Text: WideString);
var
IETitle: WideString;
TabSheet: TTabSheet;
begin
TabSheet := ((ASender as TWebBrowser).Owner as TPanel).Owner as TTabSheet;
IETitle := Text;
//字符串长度过长时,截短字符串并在后面显示“...”
while TabSetMuiltWeb.Canvas.TextWidth(IETitle) > 138 do
begin
if Length(IETitle) > 3 then
begin
if Copy(IETitle, Length(IETitle) - 2, Length(IETitle)) = '...' then
IETitle := Copy(IETitle, 1, Length(IETitle) - 3);
IETitle := Copy(IETitle, 1, Length(IETitle) - 1) + '...';
end
else
begin
IETitle := '...';
end;
end;
while TabSetMuiltWeb.Canvas.TextWidth(IETitle) < 88 do
begin
IETitle := IETitle + ' ';
end;
TabSetMuiltWeb.Tabs.Strings[TabSheet.TabIndex] := IETitle + ' ';
end;
//------------------------------------------------------------------------------
procedure TMainForm.WebBrowserRightWindowClosing(ASender: TObject; IsChildWindow: WordBool; var Cancel: WordBool);
var
TabSheet: TTabSheet;
WebBrowser: TWebBrowser;
begin
CoInitialize(nil);
try
WebBrowser := ASender as TWebBrowser;
TabSheet := (WebBrowser.Owner as TPanel).Owner as TTabSheet;
if pgcMultiWeb.PageCount > 1 then
begin
try
if WebBrowser.Busy then
WebBrowser.Stop;
except
end;
TabSetMuiltWeb.Tabs.Delete(TabSheet.TabIndex);
TabSheet.PageControl := nil;
FreeAndNil(TabSheet);
end
else
begin
WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
WebBrowser.Navigate('about:blank');
end;
finally
CoUninitialize;
Cancel := True;
end;
end;
{procedure TMainForm.WebSocketBroadCastMesssage(var msg: TMessage);
var
pdata: PBroadCastMessage;
RealICQTeamMessage: TRealICQTeamMessage;
begin
showmessage(pdata.GroupID);
RealICQTeamMessage:= TRealICQTeamMessage.Create(pdata.GroupID,pdata.Sayer,{pdata.Style}//'"宋体",9,[],[clBlack]',pdata.Msg,False);
{ RealICQTeamMessage.MessageID := gettickcount();
RealICQTeamMessage.SendDateTime := pdata.timestamp;
ShowRealICQTeamMessage(RealICQTeamMessage, False);
end; }
{ TODO -olqq -c : WebSocket群通讯功能 2014/12/12 9:02:40 }
procedure TMainForm.WebSocketJionTeamRequest(TeamID, ALoginName, ATag: string);
var
ATeam: TRealICQTeam;
ATeamCaption: string;
begin
ATeam := TTeamsAdapter.GetTeam(TeamID);
if ATeam <> nil then
ATeamCaption := ATeam.TeamCaption;
AddMessageHistory(smSimple, Format('%s 请求加入群组 %s<%s>。', [ALoginName, ATeamCaption, TeamID]), nil);
ShowJoinTeamRequestWindow(Self, TeamID, ATeamCaption, ALoginName, ATag);
end;
procedure TMainForm.WebSocketQuitTeam(aTeamID: string);
var
iIndex: Integer;
AlertMessage: string;
ARealICQTeam: TRealICQTeam;
AForm: TForm;
begin
iIndex := FLVTeams.Items.IndexOf(aTeamID);
if iIndex >= 0 then
begin
ARealICQTeam := TTeamsAdapter.GetTeam(aTeamID);
if ARealICQTeam = nil then
Exit;
FLVTeams.Items.Delete(iIndex);
if ARealICQTeam.IsTempTeam then
AlertMessage := '您 退出了 多人对话'
else
AlertMessage := '您 退出了群组: ' + ARealICQTeam.TeamCaption;
ShowNotifyAlertForm(AlertMessage);
AddMessageHistory(smSimple, AlertMessage, nil);
CloseTeamOptionsForm(ARealICQTeam.TeamID);
AForm := GetTeamTalkingForm(aTeamID);
FreeAndNil(AForm);
CloseJoinTeamRequestWindow(ARealICQTeam.TeamID);
UpdateTeamTalkingForm(ARealICQTeam);
end;
end;
procedure TMainForm.WebSocketRecivedbroadcastmesssage(aID, aGroupID, aSayer, aStyle, aMsg: string; aTimesTamp: TDateTime);
var
RealICQTeamMessage: TRealICQTeamMessage;
aDateTime: TDateTime;
begin
RealICQTeamMessage := TRealICQTeamMessage.Create(aGroupID, aSayer, aStyle{'"宋体",9,[],[clBlack]'}, aMsg, False);
RealICQTeamMessage.MessageID := gettickcount();
RealICQTeamMessage.SendDateTime := aTimesTamp;
ShowRealICQTeamMessage(RealICQTeamMessage, False);
end;
procedure TMainForm.WebSocketRemoveTeamResponse(aTeamID: string);
var
iIndex: Integer;
AlertMessage: string;
RealICQUser: TRealICQUser;
ARealICQTeam: TRealICQTeam;
AForm: TForm;
begin
iIndex := FLVTeams.Items.IndexOf(aTeamID);
if iIndex >= 0 then
begin
FLVTeams.Items.Delete(iIndex);
FLVTeams.ReDrawAll;
ARealICQTeam := TTeamsAdapter.GetTeam(aTeamID);
if ARealICQTeam = nil then
Exit;
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ARealICQTeam.TeamCreater);
if RealICQUser = RealICQClient.Me then
AlertMessage := '您'
else if RealICQUser.DisplayName = '' then
AlertMessage := RealICQUser.LoginName
else
AlertMessage := RealICQUser.DisplayName;
if ARealICQTeam.IsTempTeam then
AlertMessage := AlertMessage + ' 解散了 多人对话'
else
AlertMessage := AlertMessage + ' 解散了群组: ' + ARealICQTeam.TeamCaption;
ShowNotifyAlertForm(AlertMessage);
AddMessageHistory(smSimple, AlertMessage, nil);
CloseTeamOptionsForm(ARealICQTeam.TeamID);
CloseJoinTeamRequestWindow(ARealICQTeam.TeamID);
AForm := GetTeamTalkingForm(aTeamID);
FreeAndNil(AForm);
end;
end;
procedure TMainForm.WebSocketSendReadTeamInfo(aTeamID: string);
var
iLoop, iIndex: Integer;
ListItem: TRealICQContacterListItem;
MemberList: TStringList;
ARealICQTeam: TRealICQTeam;
begin
ARealICQTeam := TTeamsAdapter.GetTeam(aTeamID);
iIndex := FLVTeams.Items.IndexOf(ARealICQTeam.TeamID);
if iIndex = -1 then
iIndex := FLVTeams.Items.Add(ARealICQTeam.TeamID);
ListItem := FLVTeams.Items.Objects[iIndex] as TRealICQContacterListItem;
if ARealICQTeam.IsTempTeam then
ListItem.Watchword := ''
else
ListItem.Watchword := ARealICQTeam.TeamIntro;
ListItem.LoginState := stLeave;
MemberList := SplitString(ARealICQTeam.TeamMembers, Chr(10));
try
for iLoop := MemberList.Count - 1 downto 0 do
begin
if Length(Trim(MemberList[iLoop])) = 0 then
MemberList.Delete(iLoop);
end;
ListItem.LeaveMessage := IntToStr(MemberList.Count) + '个成员';
finally
MemberList.Free;
end;
{try
ListItem.HeadImagePicture.LoadFromFile(ExtractFilePath(Application.ExeName) + TeamPicture);
except
ListItem.HeadImagePicture.Graphic := nil;
end; }
if ARealICQTeam.IsTempTeam then
ListItem.DisplayName := '多人对话'
else
ListItem.DisplayName := ARealICQTeam.TeamCaption;
ListItem.Data := ARealICQTeam;
ListItem.ReDrawItem;
UpdateTeamOptionsForm(ARealICQTeam);
UpdateTeamTalkingForm(ARealICQTeam);
end;
{ TODO -olqq -c : EndWebsocket 2014/12/12 9:05:23 }
//------------------------------------------------------------------------------
procedure TMainForm.WebBrowserRightNewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool);
var
WebBrowser1, WebBrowser: TWebBrowser;
begin
CoInitialize(nil);
try
try
WebBrowser1 := ASender as TWebBrowser;
if WebBrowser1.Busy then
begin
Cancel := True;
Exit;
end;
WebBrowser := AddWebBrowserToPageControl('about:blank', -3);
if WebBrowser = nil then
begin
Cancel := True;
Exit;
end;
try
if (WebBrowser.Busy) then
WebBrowser.Stop;
except
end;
ppDisp := WebBrowser.ControlInterface;
except
Cancel := True;
end;
finally
CoUninitialize;
end;
end;
//------------------------------------------------------------------------------
function TMainForm.AddWebBrowserToPageControl(AUrl: string; WebPanelTag: Integer = -1): TWebBrowser;
var
TabSheet: TTabSheet;
PanelForIE: TPanel;
WebBrowser: TWebBrowser;
begin
if (WebPanelTag = -1) or (WebPanelTag = -3) or (pgcMultiWeb.PageCount <= 0) then
begin
TabSheet := TTabSheet.Create(pgcMultiWeb);
try
TabSheet.Parent := pgcMultiWeb;
TabSheet.PageControl := pgcMultiWeb;
TabSheet.DoubleBuffered := True;
PanelForIE := TPanel.Create(TabSheet);
PanelForIE.Parent := TabSheet;
PanelForIE.DoubleBuffered := True;
PanelForIE.Color := clWhite;
PanelForIE.Align := alClient;
PanelForIE.BevelInner := bvNone;
PanelForIE.BevelOuter := bvNone;
PanelForIE.Visible := True;
PanelForIE.Padding.Left := 2;
PanelForIE.Padding.Top := 2;
PanelForIE.Padding.Right := 2;
PanelForIE.Padding.Bottom := 2;
WebBrowser := TWebBrowser.Create(PanelForIE);
WebBrowser.DoubleBuffered := True;
WebBrowser.ParentWindow := PanelForIE.Handle;
WebBrowser.Align := alClient;
WebBrowser.OnStatusTextChange := WebBrowserRightStatusTextChange;
WebBrowser.OnTitleChange := WebBrowserRightTitleChange;
WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
WebBrowser.OnNewWindow2 := WebBrowserRightNewWindow2;
WebBrowser.OnWindowClosing := WebBrowserRightWindowClosing;
WebBrowser.Tag := WebPanelTag;
PanelForIE.InsertControl(WebBrowser);
except
TabSheet.PageControl := nil;
FreeAndNil(TabSheet);
Result := nil;
Exit;
end;
TabSetMuiltWeb.Tabs.Add(AUrl + ' ');
try
TabSetMuiltWeb.TabIndex := TabSetMuiltWeb.Tabs.Count - 1;
except
end;
pgcMultiWeb.ActivePageIndex := pgcMultiWeb.PageCount - 1;
end
else
begin
TabSheet := pgcMultiWeb.Pages[0];
WebBrowser := (TabSheet.Controls[0] as TPanel).Controls[0] as TWebBrowser;
WebBrowser.Tag := WebPanelTag;
TabSetMuiltWeb.Tabs.Strings[0] := (AUrl + ' ');
TabSetMuiltWeb.TabIndex := 0;
pgcMultiWeb.ActivePageIndex := 0;
end;
{
if not pnlMiddleRight.Visible then
begin
if RealICQClient.Logined and RealICQClient.Connected then
begin
ShowOrHideMuiltiWeb;
end;
end;
try
if (WebBrowser.Busy) then WebBrowser.Stop;
except
end;
WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
//if not ((WebPanelTag = -3) and AnsiSameText(AUrl, 'about:blank')) then
try
WebBrowser.Navigate(AUrl);
except
end;
Result := WebBrowser;
}
end;
//------------------------------------------------------------------------------
{
procedure TMainForm.WebTabShow(Sender: TObject);
var
iIndex: Integer;
TabSheet: TTabSheet;
WebPanel: TWebPanel;
WebURL: String;
begin
TabSheet := Sender as TTabSheet;
//TabSheet.OnShow := nil;
iIndex := FWebTabs.IndexOf(TabSheet);
WebPanel := FWebPanels.Objects[iIndex] as TWebPanel;
while TabSheet.ControlCount > 0 do
begin
TabSheet.Controls[0].Free;
//TabSheet.RemoveControl(TabSheet.Controls[0]);
end;
if WebPanel.NavigateType = ntGET then
begin
WebURL := WebPanel.URL;
if WebPanel.UserIMLoginName then
WebURL := AnsiReplaceText(WebURL, '[%LoginName%]', RealICQClient.LoginName)
else
WebURL := AnsiReplaceText(WebURL, '[%LoginName%]', WebPanel.CustomLoginName);
if WebPanel.UserIMPassword then
WebURL := AnsiReplaceText(WebURL, '[%Password%]', RealICQClient.Password)
else
WebURL := AnsiReplaceText(WebURL, '[%Password%]', WebPanel.CustomPassword);
AddWebBrowserToPageControl(WebUrl, iIndex);
end
else
AddWebBrowserToPageControl('about:blank', iIndex);
end;
}
//------------------------------------------------------------------------------
//新Post方式
procedure TMainForm.WebBrowserRightDocumentCompleteForPost(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
var
WebBrowser: TWebBrowser;
WebPanel: TWebPanel;
WebTabAcount: TWebTabAcount;
FieldName, ALoginName, FieldValue: string;
PostFields, Field: TStringList;
iLoop, jLoop, kLoop: Integer;
WebItem: Olevariant;
WebItemChild: Olevariant;
WebItemForm: Olevariant;
AFindedForm: Boolean;
ASubmitID: string;
begin
WebBrowser := ASender as TWebBrowser;
WebBrowser.OnDocumentComplete := nil;
WebPanel := FWebPanels.Objects[WebBrowser.Tag] as TWebPanel;
if WebPanel.Acounts.Count > 0 then
WebTabAcount := WebPanel.Acounts[TabAcountIndex]
else
WebTabAcount := nil;
ASubmitID := '';
;
AFindedForm := False;
PostFields := SplitString(WebPanel.PostFields, ',');
try
for kLoop := 0 to PostFields.Count - 1 do
begin
Field := SplitStringEx(PostFields.Strings[kLoop], '=');
try
try
FieldName := Field.Strings[0];
FieldValue := Field.Strings[1];
if FieldName = 'LXTALK_SUBMIT_BTN' then
ASubmitID := FieldValue;
if WebTabAcount <> nil then
begin
FieldValue := AnsiReplaceText(FieldValue, '[%LoginName%]', WebTabAcount.LoginName);
FieldValue := AnsiReplaceText(FieldValue, '[%Password%]', WebTabAcount.Password);
FieldValue := AnsiReplaceText(FieldValue, '[%MD5_LoginName%]', MD5En(WebTabAcount.LoginName));
FieldValue := AnsiReplaceText(FieldValue, '[%MD5_Password%]', MD5En(WebTabAcount.Password));
end;
WebBrowser.OleObject.Document.getElementByID(FieldName).value := FieldValue;
//找到Form
if not AFindedForm then
begin
WebItem := WebBrowser.Document;
for iLoop := 0 to WebItem.Forms.length - 1 do
begin
//ShowMessage(WebItem.Forms.Item(iLoop, 0).name);
WebItemChild := WebItem.Forms.Item(iLoop, 0);
for jLoop := 0 to WebItemChild.all.length - 1 do
begin
if AnsiSameText(WebItemChild.all.item(jLoop).tagName, 'INPUT') then
begin
if AnsiSameText(WebItemChild.all.item(jLoop).name, FieldName) then
begin
AFindedForm := True;
WebItemForm := WebItemChild;
Break;
end;
//ShowMessage(WebItemChild.all.item(jLoop).tagName);
//ShowMessage(WebItemChild.all.item(jLoop).type);
//ShowMessage(WebItemChild.all.item(jLoop).name);
end;
end; //for
end; //for
end; //if
except
end;
finally
Field.Free;
end;
end;
finally
PostFields.Free;
end;
//ShowMessage(WebItemForm.Action);
//Exit;
WebItemForm.target := '_blank';
//Exit;
if ASubmitID <> '' then
begin
for jLoop := 0 to WebItemForm.all.length - 1 do
begin
if AnsiSameText(WebItemForm.all.item(jLoop).tagName, 'INPUT') then
begin
if AnsiSameText(WebItemForm.all.item(jLoop).name, ASubmitID) then
begin
WebItemForm.all.item(jLoop).click;
end;
end;
end;
end
else
begin
for jLoop := 0 to WebItemForm.all.length - 1 do
begin
if AnsiSameText(WebItemForm.all.item(jLoop).tagName, 'INPUT') then
begin
if AnsiSameText(WebItemForm.all.item(jLoop).type, 'submit') then
begin
WebItemForm.all.item(jLoop).click;
end;
end;
end;
end;
Application.ProcessMessages;
Sleep(100);
Application.ProcessMessages;
//FreeAndNil(WebBrowser);
end;
//------------------------------------------------------------------------------
//Get方式加旧版本Post方式
procedure TMainForm.WebBrowserRightDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
var
PanelForIE: TPanel;
WebBrowser: TWebBrowser;
WebPanel: TWebPanel;
v: Variant;
parameters: string;
OldTag, iLoop: Integer;
PostFields, Field: TStringList;
WebURL, FieldName, ALoginName, FieldValue: string;
WebTabAcount: TWebTabAcount;
SetTagAsZero: Boolean;
begin
WebBrowser := ASender as TWebBrowser;
OldTag := WebBrowser.Tag;
SetTagAsZero := True;
PanelForIE := WebBrowser.Owner as TPanel;
try
if (not PanelForIE.Visible) and (not AnsiSameText(URL, 'about:blank')) then
begin
//PanelForIE.Visible := True;
WebBrowser.OnDocumentComplete := nil;
WebBrowser.Navigate('about:blank');
//ShellExecute(handle,'open',pchar('C:\Program Files\Internet Explorer\IEXPLORE.EXE'),PChar(String(URL)),'',SW_SHOWMAXIMIZED);
ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(string(URL)), '', SW_SHOWMAXIMIZED);
Exit;
end;
{if not AnsiSameText(URL, 'about:blank') then
begin
WebBrowser.OnDocumentComplete := nil;
with cbxURLInputer.ItemsEx.Add do
begin
Caption := URL;
if (Copy(Caption, 1, 5) = 'file:') or (Copy(Caption, 2, 1) = ':') then
ImageIndex := 2
else if Copy(Caption, 1, 4) = 'ftp:' then
ImageIndex := 1
else
ImageIndex := 0;
end;
cbxURLInputer.ItemIndex := cbxURLInputer.ItemsEx.Count - 1;
if WebBrowser.Document <> nil then
begin
(WebBrowser.Application as IOleobject).DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser, 0, Handle, GetClientRect);
end;
end;}
if AnsiSameText(URL, 'about:blank') and (WebBrowser.Tag >= 0) and (TabAcountIndex >= 0) then
begin
WebPanel := FWebPanels.Objects[WebBrowser.Tag] as TWebPanel;
if WebPanel.Acounts.Count > 0 then
WebTabAcount := WebPanel.Acounts[TabAcountIndex]
else
WebTabAcount := nil;
WebBrowser.Tag := -1;
WebURL := WebPanel.URL;
if WebPanel.FName = '网络存储' then
begin
OpenNewWorkDisk(WebPanel.FURL);
Exit;
end;
if WebPanel.FNavigateType = ntGET then
begin
if Length(Trim(WebPanel.PostFields)) > 0 then
begin
if Pos('?', WebPanel.URL) > 0 then
WebURL := WebPanel.URL + '&' + ReplaceStr(WebPanel.PostFields, ',', '&')
else
WebURL := WebPanel.URL + '?' + ReplaceStr(WebPanel.PostFields, ',', '&');
end;
if WebTabAcount <> nil then
begin
WebURL := AnsiReplaceText(WebURL, '[%LoginName%]', WebTabAcount.LoginName);
WebURL := AnsiReplaceText(WebURL, '[%Password%]', WebTabAcount.Password);
WebURL := AnsiReplaceText(WebURL, '[%BASE64_LoginName%]', StrToBase64(WebTabAcount.LoginName));
WebURL := AnsiReplaceText(WebURL, '[%BASE64_Password%]', StrToBase64(WebTabAcount.Password));
WebURL := AnsiReplaceText(WebURL, '[%MD5_LoginName%]', MD5En(WebTabAcount.LoginName));
WebURL := AnsiReplaceText(WebURL, '[%MD5_Password%]', MD5En(WebTabAcount.Password));
WebURL := AnsiReplaceText(WebURL, '[%BASE64_MD5_LoginName%]', StrToBase64(MD5En(WebTabAcount.LoginName)));
WebURL := AnsiReplaceText(WebURL, '[%BASE64_MD5_Password%]', StrToBase64(MD5En(WebTabAcount.Password)));
end;
parameters := ALoginName + ' ' + RealICQClient.Password;
ShellExecute(handle, 'open', PChar(GetDefaultBrowser), PChar(string(Trim(WebURL))), PChar(parameters), SW_SHOWMAXIMIZED);
end
else
begin
v := VarArrayCreate([0, 0], varVariant);
v[0] := '' + '' + '';
(WebBrowser.Document as IHtmlDocument2).Write(PSafeArray(TVarData(v).VArray));
WebBrowser.oleobject.document.Forms.Item(0, 0).Submit;
end;
end;
finally
ClearMemory;
if SetTagAsZero then
WebBrowser.Tag := -1;
//pgcMainWorkArea.ActivePageIndex := 0;
end;
end;
procedure TMainForm.WebBrowserForPostWorkOrderDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
begin
//
{ if URL='about:blank' then
begin
v := VarArrayCreate([0, 0], varVariant);
v[0] := '' +
'' +
'';
(WebBrowserForPostWorkOrder.Document as IHtmlDocument2).Write(PSafeArray(TVarData(v).VArray));
WebBrowserForPostWorkOrder.oleobject.document.Forms.Item(0, 0).Submit;
end; }
end;
procedure TMainForm.UploadWebTabAccounts;
var
iLoop, jLoop: Integer;
WebPanel: TWebPanel;
StrTemp: string;
WebTabAcount: TWebTabAcount;
begin
StrTemp := '';
for iLoop := 0 to WebPanels.Count - 1 do
begin
WebPanel := WebPanels.Objects[iLoop] as TWebPanel;
for jLoop := 0 to WebPanel.Acounts.Count - 1 do
begin
WebTabAcount := WebPanel.Acounts[jLoop];
StrTemp := StrTemp + IntToStr(WebTabAcount.WebTabID) + Chr(10) + WebTabAcount.LoginName + Chr(10) + WebTabAcount.Password + Chr(10) + WebTabAcount.Title + Chr(10) + WebTabAcount.Explain + Chr(10) + Chr(13);
end;
end;
MainForm.RealICQClient.CallServerDBProcedure('SetWebTabAcounts', StrTemp);
end;
//------------------------------------------------------------------------------
procedure TMainForm.WebTabShow(Sender: TObject);
var
iIndex: Integer;
TabSheet: TTabSheet;
WebPanel: TWebPanel;
WebTabAcount: TWebTabAcount;
iLoop: Integer;
begin
if not DisplayWebs then
Exit;
TabSheet := Sender as TTabSheet;
//TabSheet.OnShow := nil;
iIndex := FWebTabs.IndexOf(TabSheet);
iIndex := TabSheet.Tag;
WebPanel := FWebPanels.Objects[iIndex] as TWebPanel;
TabAcountIndex := 0;
if WebPanel.Acounts.Count = 0 then
begin
if not ((Pos('[%', WebPanel.URL) <= 0) and (Pos('%]', WebPanel.URL) <= 0) and (Pos('[%', WebPanel.PostFields) <= 0) and (Pos('%]', WebPanel.PostFields) <= 0)) then
begin
AddWebTabForm := TAddWebTabForm.Create(Self);
try
AddWebTabForm.NewWebPanel := True;
AddWebTabForm.Left := Mouse.CursorPos.X;
AddWebTabForm.Top := Mouse.CursorPos.Y - 20;
if Left <= AddWebTabForm.Width then
AddWebTabForm.Left := Left + Width - 10
else
AddWebTabForm.Left := Left - AddWebTabForm.Width + 10;
if (AddWebTabForm.Top + AddWebTabForm.Height) > Screen.Height then
AddWebTabForm.Top := Screen.Height - AddWebTabForm.Height;
if AddWebTabForm.ShowModal = mrOK then
begin
WebTabAcount := TWebTabAcount.Create;
WebTabAcount.WebTabID := StrToInt(WebPanel.ID);
WebTabAcount.Title := Trim(AddWebTabForm.edTitle.Text);
WebTabAcount.LoginName := AddWebTabForm.ALoginName;
WebTabAcount.Password := AddWebTabForm.APassword;
WebTabAcount.Explain := Trim(AddWebTabForm.edExplain.Text);
WebPanel.Acounts.Add(WebTabAcount);
UploadWebTabAccounts;
end
else
begin
TabAcountIndex := -1;
end;
finally
FreeAndNil(AddWebTabForm);
end;
end;
end;
OpenWebTab(TabSheet, WebPanel, TabAcountIndex);
end;
//------------------------------------------------------------------------------
procedure TMainForm.ShowOrHideMuiltiWeb;
var
OldWidth: Integer;
begin
LockWindowUpdate(GetDesktopWindow);
OldWidth := pnlMiddleClient.Width;
try
//if not pnlMiddleRight.Visible then pnlMiddleRight.Width := 680;
pnlMiddleRight.Visible := not pnlMiddleRight.Visible;
Spl.Visible := pnlMiddleRight.Visible;
if not pnlMiddleRight.Visible then
begin
Width := Width - pnlMiddleRight.Width - Spl.Width;
Spl.Align := alRight;
pnlMiddleClient.Align := alClient;
pnlMiddleRight.Align := alRight;
pnlAll.Constraints.MinWidth := pnlMiddleClient.Constraints.MinWidth;
pnlAll.Constraints.MaxWidth := pnlMiddleClient.Constraints.MaxWidth;
end
else
begin
// Width := Width + pnlMiddleRight.Width + Spl.Width;
Top := Screen.Height div 2 - 290;
Left := Screen.Width div 2 - 440;
Width := 880;
Height := 580;
Spl.Align := alLeft;
pnlMiddleClient.Align := alLeft;
pnlMiddleRight.Align := alClient;
pnlAll.Constraints.MinWidth := pnlMiddleClient.Constraints.MinWidth + pnlMiddleRight.Constraints.MinWidth + Spl.Width;
pnlAll.Constraints.MaxWidth := 0;
pnlMiddleClient.Left := 0;
spl.Left := pnlMiddleClient.Left + pnlMiddleClient.Width + 1;
end;
finally
pnlMiddleClient.Width := OldWidth;
LockWindowUpdate(0);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actMsgManagerExecute(Sender: TObject);
begin
if MessagesManagerForm <> nil then
begin
MessagesManagerForm.BringToFront;
Exit;
end;
MessagesManagerForm := TMessagesManagerForm.Create(Application);
MessagesManagerForm.Width := Round(Screen.WorkAreaWidth * 0.70);
MessagesManagerForm.Height := Round(Screen.WorkAreaHeight * 0.70);
MessagesManagerForm.Show;
end;
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientAddedBlacklists(Sender: TObject; ALoginName: string);
var
ItemIndex: Integer;
RealICQUser: TRealICQUser;
RealICQContacterListView: TRealICQContacterListView;
RealICQContacterListItem: TRealICQContacterListItem;
begin
RealICQContacterListView := GetListViewByLoginName(ALoginName);
if RealICQContacterListView.Items.IndexOf(ALoginName) = -1 then
begin
ItemIndex := RealICQClient.Blacklists.IndexOf(ALoginName);
RealICQUser := RealICQClient.Blacklists.Objects[ItemIndex] as TRealICQUser;
RealICQContacterListView := GetListViewByLoginName(RealICQUser.LoginName);
ItemIndex := RealICQContacterListView.Items.IndexOf(RealICQUser.LoginName);
RealICQContacterListItem := RealICQContacterListView.Items.Objects[ItemIndex] as TRealICQContacterListItem;
//BindUserDataToItem(RealICQContacterListItem, RealICQUser);
TUsersService.GetUsersService.UpdateListItem(RealICQContacterListView, RealICQContacterListItem, RealICQUser);
end;
end;
procedure TMainForm.RealICQClientAddFriendRequest(Sender: TObject; ALoginName, ATag: string);
begin
AddMessageHistory(smSimple, ALoginName + ' 请求加您为好友', nil);
ShowAddFriendRequestWindow(Self, ALoginName, ATag);
end;
procedure TMainForm.RealICQClientAddFriendResponse(Sender: TObject; ALoginName, ATag: string; AAcceptted: Boolean);
var
RealICQUser: TRealICQUser;
itemIndex: Integer;
begin
if AAcceptted then
begin
RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
AddMessageHistory(smSimple, '您已将 ' + ALoginName + ' 添加至好友列表', nil);
FNotAddedEmployeeList.AddObject(RealICQUser.LoginName, RealICQUser);
//显示好友
// ShowGroupInterface;
ShowNotifyAlertForm('已将 ' + ALoginName + ' 添加至好友列表');
end
else
begin
if Length(ATag) = 0 then
ATag := '无';
AddMessageHistory(smSimple, ALoginName + ' 拒绝了您添加好友的请求', nil);
ShowNotifyAlertForm(ALoginName + ' 拒绝添加好友的请求' + #$D#$A + '附言：' + ATag);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actOpenMainFormExecute(Sender: TObject);
begin
if FHidden then
ZoomEffect(Self, zaMaximize);
Show;
ShowWindow(Handle, SW_SHOW);
ForceForeGroundWindow(Handle);
FHidden := False;
if FMainFormHidden then
begin
//FDblClickedTrayIcon := True;
//TimerForShowMainForm.Enabled := False;
//TimerForShowMainForm.Enabled := True;
SetForegroundWindow(TrueHiddenMainForm.Handle);
ShowMainForm;
end
else
HideMainForm;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actOpenRecvFileDirExecute(Sender: TObject);
begin
ShellExecute(handle, 'open', PChar('"' + RecvFileDir + '"'), '', '', SW_SHOWNORMAL);
end;
//------------------------------------------------------------------------------
procedure TMainForm.actOptionsExecute(Sender: TObject);
begin
if OptionsForm <> nil then
Exit;
OptionsForm := TOptionsForm.Create(Self);
try
OptionsForm.ShowModal;
finally
FreeAndNil(OptionsForm);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actPersonalSetExecute(Sender: TObject);
var
AForm: IUIForm;
begin
if OptionsForm <> nil then
Exit;
OptionsForm := TOptionsForm.Create(Self);
try
OptionsForm.PageIndex := 0;
OptionsForm.ShowModal;
finally
FreeAndNil(OptionsForm);
end;
end;
procedure TMainForm.actQuitExecute(Sender: TObject);
var
iWaitTimes: Integer;
begin
if RealICQClient.Connected then
begin
if GetTalkingFormCount > 0 then
begin
if MessageBox(Handle, '确实要退出吗，此操作将会关闭所有的对话窗口！', '提示', MB_ICONINFORMATION or MB_OKCANCEL) = ID_CANCEL then
Exit;
if Showing then
Close;
CloseAllTalkingForm;
iWaitTimes := 0;
while GetTalkingFormCount > 0 do
begin
Sleep(100);
Inc(iWaitTimes);
if iWaitTimes > 100 then
Break;
Application.ProcessMessages;
end;
end;
RealICQClient.Logout;
TTeamsAdapter.Stop;
end;
if Showing then
Close;
MainForm.OnClose := nil;
MainForm.Close;
TrueHiddenMainForm.Close;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actConnectSetExecute(Sender: TObject);
begin
if OptionsForm <> nil then
Exit;
OptionsForm := TOptionsForm.Create(Self);
try
OptionsForm.LVOptions.Enabled := False;
OptionsForm.PageIndex := 6;
OptionsForm.ShowModal;
//OptionsForm.Show;
finally
FreeAndNil(OptionsForm);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actCreateTeamExecute(Sender: TObject);
//var
// iLoop: Integer;
// Team: TRealICQTeam;
begin
// for iLoop := 0 to RealICQClient.Teams.Count - 1 do
// begin
// Team := RealICQClient.Teams.Objects[iLoop] as TRealICQTeam;
// if (not Team.IsTempTeam) and AnsiSameText(Team.TeamCreater, RealICQClient.LoginName) then
// begin
// MessageBox(Handle, '抱歉，您已经创建了一个群组了！', '提示', MB_ICONINFORMATION);
// Exit;
// end;
// end;
//if CreateTeamForm = nil then CreateTeamForm := TCreateTeamForm.Create(Self);
//CreateTeamForm.Show;
try
//非办公助手企业用户无新建群组权限
if (FProductType <> ptBGZS) AND ((FUserType = utUnknown) OR (FUserType = utCompany)) then
begin
ShowMessage('您没有创建群组权限! ');
Exit;
end;
CreateTeamForm := TCreateTeamForm.Create(Self);
try
CreateTeamForm.ShowModal;
finally
FreeAndNil(CreateTeamForm);
end;
except
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actCustomFacesManagerExecute(Sender: TObject);
begin
if CustomFacesManagerForm = nil then
CustomFacesManagerForm := TCustomFacesManagerForm.Create(Application);
CustomFacesManagerForm.Show;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actAVSetExecute(Sender: TObject);
begin
WinExec(PChar('"' + ExtractFilePath(Application.ExeName) + AVSetExeFile + '" "' + ExtractFilePath(Application.ExeName) + 'Languages\' + MainForm.Language + '.ini' + '"'), SW_SHOWNORMAL);
end;
//------------------------------------------------------------------------------
procedure TMainForm.actChangePassExecute(Sender: TObject);
begin
if ChangePassForm <> nil then
Exit;
ChangePassForm := TChangePassForm.Create(Self);
try
ChangePassForm.ShowModal;
finally
FreeAndNil(ChangePassForm);
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.actCloseExecute(Sender: TObject);
begin
Close;
end;
//--------------------------------------------------------------
procedure ClearFileMissions;
var
iLoop, jLoop: Integer;
UploadMission: TUploadMission;
DownloadMission: TDownloadMission;
Missions: TStringList;
begin
for iLoop := FUploadMissions.Count - 1 downto 0 do
begin
UploadMission := FUploadMissions.Objects[iLoop] as TUploadMission;
try
FreeAndNil(UploadMission);
except
end;
end;
FUploadMissions.Clear;
for iLoop := FSavedUploadMissions.Count - 1 downto 0 do
begin
Missions := TStringList(FSavedUploadMissions[iLoop]);
for jLoop := Missions.Count - 1 downto 0 do
begin
UploadMission := Missions.Objects[jLoop] as TUploadMission;
try
FreeAndNil(UploadMission);
except
end;
end;
Missions.Clear;
FreeAndNil(Missions);
end;
FSavedUploadMissions.Clear;
for iLoop := FSavedDownloadMissions.Count - 1 downto 0 do
begin
Missions := TStringList(FSavedDownloadMissions[iLoop]);
for jLoop := Missions.Count - 1 downto 0 do
begin
DownloadMission := Missions.Objects[jLoop] as TDownloadMission;
try
FreeAndNil(DownloadMission);
except
end;
end;
Missions.Clear;
FreeAndNil(Missions);
end;
FSavedDownloadMissions.Clear;
for iLoop := FDownloadMissions.Count - 1 downto 0 do
begin
DownloadMission := FDownloadMissions.Objects[iLoop] as TDownloadMission;
try
FreeAndNil(DownloadMission);
except
end;
end;
FDownloadMissions.Clear;
end;
//---退出主程序-----------------------------------------------------
procedure TMainForm.QuitWindows;
var
iWaitTimes: Integer;
begin
RealICQClient.OnLoginFailed := nil;
if RealICQClient.Connected then
begin
if GetTalkingFormCount > 0 then
begin
if Showing then
Close;
CloseAllTalkingForm;
iWaitTimes := 0;
while GetTalkingFormCount > 0 do
begin
Sleep(100);
Inc(iWaitTimes);
if iWaitTimes > 100 then
Break;
Application.ProcessMessages;
end;
end;
RealICQClient.Logout;
end;
if Showing then
Close;
MainForm.OnClose := nil;
MainForm.Close;
TrueHiddenMainForm.Close;
end;
//-----获的天气信息--------------------------------------------------------
procedure TMainForm.GetWeather(City, Weatheren, Weather: string);
var
Data: CopyDataStruct;
Args: PChar;
weatherImgPath: string;
WeatherList: TStringList;
WeatherPanelWidth: Integer;
begin
lblWeatherCity.Caption := City;
lblWeatheren.Caption := Weatheren;
lblWeather.Caption := Weather;
weatherImgPath := ExtractFilePath(paramstr(0)) + 'Images\Weather\' + GetWeatherImgName(lblWeather.Caption);
if fileexists(weatherImgPath) then
imgWeather.Picture.LoadFromFile(weatherImgPath);
WeatherPanelWidth := lblWeatherCity.Left + lblWeatherCity.Width + 5 + imgWeather.Width + 5 + lblWeather.Width + 5 + lblWeatheren.Width;
if pnlWebSearch.Width - spbAddFriend.Left >= WeatherPanelWidth then
lblWeatherCity.Left := spbAddFriend.Left
else
lblWeatherCity.Left := btMainMenu.Left + btMainMenu.Width + 5;
imgWeather.Left := lblWeatherCity.Left + lblWeatherCity.Width + 5;
lblWeather.Left := imgWeather.Left + imgWeather.Width + 5;
lblWeatheren.Left := lblWeather.Left + lblWeather.Width + 5;
end;
procedure TMainForm.SetGetMoreUserEvent;
begin
RealICQClient.OnGettedMoreBranchList := RealICQClientGettedMoreBranchList;
RealICQClient.OnGettedMoreUserList := RealICQClientGettedMoreUserList;
if (MessageBoxForm <> nil) then
begin
FreeAndNil(MessageBoxForm);
MessageBoxForm := nil;
end;
end;
//------------------------------------------------------------------------------
procedure TMainForm.OpenWebTab(TabSheet: TTabSheet; WebPanel: TWebPanel; AcountIndex: Integer);
var
Panel, PanelForIE: TPanel;
WebBrowser: TWebBrowser;
begin
TabAcountIndex := AcountIndex;
Panel := TPanel.Create(TabSheet);
Panel.Parent := TabSheet;
Panel.DoubleBuffered := True;
Panel.Font.Color := spbDisplayName.Font.Color;
Panel.Caption := '页面加载中...';
Panel.Color := clWhite;
Panel.Align := alClient;
Panel.BevelInner := bvNone;
Panel.BevelOuter := bvNone;
Panel.Visible := True;
Application.ProcessMessages;
PanelForIE := TPanel.Create(Panel);
PanelForIE.Parent := Panel;
PanelForIE.Tag := TabSheet.Tag;
PanelForIE.DoubleBuffered := True;
PanelForIE.Color := clWhite;
PanelForIE.Align := alClient;
PanelForIE.BevelInner := bvNone;
PanelForIE.BevelOuter := bvNone;
PanelForIE.Visible := True;
Application.ProcessMessages;
WebBrowser := TWebBrowser.Create(PanelForIE);
WebBrowser.DoubleBuffered := True;
WebBrowser.ParentWindow := PanelForIE.Handle;
WebBrowser.Align := alClient;
WebBrowser.Visible := True;
WebBrowser.Tag := TabSheet.Tag;
WebBrowser.RegisterAsBrowser := True;
WebBrowser.RegisterAsDropTarget := True;
//WebBrowser.OnBeforeNavigate2 := WebBrowserRightBeforeNavigate2;
if WebPanel.FNavigateType = ntFill then
WebBrowser.OnDocumentComplete := WebBrowserRightDocumentCompleteForPost
else
WebBrowser.OnDocumentComplete := WebBrowserRightDocumentComplete;
PanelForIE.InsertControl(WebBrowser);
Application.ProcessMessages;
if DisplayWebs then
begin
if WebPanel.FNavigateType = ntFill then
WebBrowser.Navigate(WebPanel.FURL)
else
WebBrowser.Navigate('about:blank');
end;
end;
//-------------------------------------------------------
procedure TMainForm.LoadMainTabImage;
begin
MyContactersIcon.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + MainTabImageDir + '1.bmp');
SysMsgIcon.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + MainTabImageDir + '2.bmp');
MyFriendIcon.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + MainTabImageDir + '3.bmp');
MyTeamIcon.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + MainTabImageDir + '4.bmp');
LatestsIcon.Picture.Bitmap.LoadFromFile(ExtractFilePath(Application.ExeName) + MainTabImageDir + '5.bmp');
end;
//------------------------------------------------------------------------------
//下载升级配置文件
//------------------------------------------------------------------------------
procedure TMainForm.DownLoadUpdateConfig;
var
TempDir: string;
begin
TempDir := GetMyDocument + '\Update';
if not DirectoryExists(TempDir) then
ForceDirectories(TempDir);
if FileExists(GetMyDocument + '\Update\Update.dat') then
begin
SetFileAttributes(pchar(GetMyDocument + '\Update\Update.dat'), file_attribute_normal);
DeleteFile(GetMyDocument + '\Update\Update.dat');
end;
//FDownFile.ThreadDownFile('http://' + MainForm.RealICQClient.RemoteAddress + '/Update/Update.dat', TempDir + '\Update.dat');
end;
//------------------------------------------------------------------------------
//文件下载完成事件处理函数
//-----------------------------------------------------------------------------=
procedure TMainForm.DownFaceFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
begin
ShowGettedFace(Dest_file);
end;
procedure TMainForm.DownFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
var
OldVersion, Version: string;
F: Textfile;
City, Weatheren, Weather: string;
function GetVersionFromIniFile(FileName: string): string;
var
IniFile: TIniFile;
begin
IniFile := TIniFile.Create(ExtractFilePath(paramstr(0)) + 'Update.dat');
try
OldVersion := IniFile.ReadString('Version', 'Version', '1.0.0.0');
finally
IniFile.Free;
end;
end;
begin
if FileExists(Dest_file) then
begin
if UpperCase(ExtractFileExt(Dest_file)) = '.DAT' then
begin
OldVersion := '1.0.0.0';
if FileExists(ExtractFilePath(paramstr(0)) + 'Update.dat') then
OldVersion := GetVersionFromIniFile(ExtractFilePath(paramstr(0)) + 'Update.dat');
if FileExists(GetMyDocument + '\Update\Update.dat') then
Version := GetVersionFromIniFile(GetMyDocument + '\Update\Update.dat');
if trim(OldVersion) <> trim(Version) then
WinExec('Update.exe', SW_SHOW);
end
else
begin
AssignFile(F, Dest_file);
try
Reset(F);
Readln(F, City);
Readln(F, Weatheren);
Readln(F, Weather);
GetWeather(City, Weatheren, Weather);
finally
Closefile(F); {关闭文件 F}
end;
end;
end;
end;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure TMainForm.RealICQClientGettedSysMsgInterfaces(Sender: TObject);
begin
//
end;
//------------------------------------------------------------------------------
function TMainForm.GetBranchName(LoginName: string): string;
var
ItemIndex: Integer;
Branch: TRealICQBranch;
Employee: TRealICQEmployee;
Node: TTreeNode;
RealICQContacterTreeView: TRealICQContacterTreeView;
begin
Result := '';
if MainForm.GetActiveTabSheetName = LVMoreUsers then
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVMoreUsers);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
end
else
begin
ItemIndex := MainForm.ContacterTreeViews.IndexOf(LVMyContacters);
RealICQContacterTreeView := MainForm.ContacterTreeViews.Objects[ItemIndex] as TRealICQContacterTreeView;
end;
Employee := RealICQContacterTreeView.GetEmployee(LoginName);
if (Employee = nil) then
Exit;
Node := Employee.Node.Parent;
Result := Node.Text;
while Node.Parent <> nil do
begin
Node := Node.Parent;
if Node = nil then
Break;
if Node.Parent <> nil then
Result := Node.Text + '/' + Result;
end;
end;
//------------------------------------------------------------------------------
function TMainForm.GetCompany: string;
var
iIndex: Integer;
ServerInfo: TServerInfo;
begin
Result := '';
if (FServerInfoList.IndexOf(MainForm.CurrentServerID) < 0) or (FServerInfoList.IndexOf(MainForm.RealICQClient.ServerID) < 0) then
Exit;
if MainForm.GetActiveTabSheetName = LVMoreUsers then
ServerInfo := FServerInfoList.Objects[FServerInfoList.IndexOf(MainForm.CurrentServerID)] as (TServerInfo)
else
ServerInfo := FServerInfoList.Objects[FServerInfoList.IndexOf(MainForm.RealICQClient.ServerID)] as (TServerInfo);
if Assigned(ServerInfo) then
Result := ServerInfo.ServerName;
end;
//------------------------------------------------------------------------------
//用post方式提交XML文件到服务器
//------------------------------------------------------------------------------
{
procedure TMainForm.PostUpdateLog;
function ReadUpdateLog: string;
var
XMLFile: string;
ConfigNode: IXMLNode;
XMLDocument: TXMLDocument;
begin
Result := '';
XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + UpdateLogXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
try
if FileExists(XMLFile) then
begin
XMLDocument.Active := True;
XMLDocument.LoadFromFile(XMLFile);
ConfigNode := XMLDocument.DocumentElement;
if ConfigNode.ChildNodes.FindNode('product').Attributes['status'] then
begin
Result := XMLDocument.XML.Text;
end;
end;
except
on E: EXception do
end;
finally
XMLDocument.Free;
end;
end;
var
XMLStr, Url: string;
begin
Url := GetUpdateLogPostUrl(ExtractFilePath(paramstr(0)) + 'Online.ini');
if Url = '' then
Url := DefaultUpdateLogPostUrl;
Url := Url + '?LoginName=' + RealICQClient.LoginName + '&DisplayName=' + HttpEncode(AnsiToUtf8(RealICQClient.Me.DisplayName)) + '&ServerName=' + HttpEncode(AnsiToUtf8(edServerList.Text));
XMLStr := ReadUpdateLog;
if XMLStr <> '' then
begin
TThreadPost.Create(Url, XMLStr);
end;
end;
}
//------------------------------------------------------------------------------
procedure TMainForm.UpdatePostLogState(Status: Boolean);
var
XMLFile: string;
ConfigNode: IXMLNode;
XMLDocument: TXMLDocument;
begin
XMLFile := ExtractFilePath(paramstr(0)) + ConfigXMLFilePath + UpdateLogXMLFile;
XMLDocument := TXMLDocument.Create(Self);
try
try
if FileExists(XMLFile) then
begin
XMLDocument.Active := True;
XMLDocument.LoadFromFile(XMLFile);
ConfigNode := XMLDocument.DocumentElement;
ConfigNode.ChildNodes.FindNode('product').Attributes['status'] := Status;
XMLDocument.SaveToFile(XMLFile);
end;
except
end;
finally
XMLDocument.Free;
end;
end;
constructor TThreadPost.Create(URL, Content: string);
begin
inherited Create(True);
FURL := URL;
FContent := Content;
FreeOnTerminate := True;
Resume;
end;
procedure TThreadPost.Execute;
var
IdHttp: TIdHTTP;
Sends: TStrings;
begin
IdHttp := TIdHTTP.Create(nil);
Sends := TStringList.Create;
try
IdHttp.Request.ContentType := 'application/x-www-form-urlencoded';
Sends.Add('XmlStr=' + StrToBase64(FContent));
IdHttp.Post(FUrl, Sends);
MainForm.UpdatePostLogState(False);
finally
FreeAndNil(IdHttp);
Sends.Free;
end;
end;
//---------------检测指定的进程是否运行-----------------------------------------
constructor TCheckRunProcessThread.Create(AProgramName, AProcessPath: string);
begin
inherited Create(True);
ProgramName := AProgramName;
ProcessPath := AProcessPath;
FreeOnTerminate := True;
Resume;
end;
//------------得到进程的执行路径------------------------------------------------
function TCheckRunProcessThread.GetProcessPath(ProcessID: DWORD): string;
var
Hand: THandle;
ModName: array[0..Max_Path - 1] of Char;
hMod: HModule;
n: DWORD;
begin
Result := '';
Hand := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID);
if Hand > 0 then
try
ENumProcessModules(Hand, @hMod, Sizeof(hMod), n);
if GetModuleFileNameEx(Hand, hMod, ModName, Sizeof(ModName)) > 0 then
Result := ModName; //得到路径和文见名
except
end;
end;
//根据可执行文件名称查找进程列表，以判断程序是否正在运行。
function TCheckRunProcessThread.FindProcess(AFileName: string): boolean;
var
hSnapshot: THandle; //用于获得进程列表
lppe: TProcessEntry32; //用于查找进程
Found: Boolean; //用于判断进程遍历是否完成
ProcessPath: string;
begin
Result := False;
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); //获得系统进程列表
lppe.dwSize := SizeOf(TProcessEntry32); //在调用Process32First API之前，需要初始化lppe记录的大小
Found := Process32First(hSnapshot, lppe); //将进程列表的第一个进程信息读入ppe记录中
while Found do
begin
ProcessPath := GetProcessPath(lppe.th32ProcessID);
if UpperCase(ProcessPath) = UpperCase(AFileName) then
begin
Result := True;
end;
Found := Process32Next(hSnapshot, lppe); //将进程列表的下一个进程信息读入lppe记录中
end;
end;
//------------------------------------------------------------------------------
procedure TCheckRunProcessThread.Execute;
begin
while FindProcess(ProcessPath) do
begin
Sleep(1000);
end;
//MainForm.PostUpdateLog;
end;
procedure TMainForm.btOAClick(Sender: TObject);
begin
MessageBox(Handle, '协同办公系统暂未接入！ ', '提示', MB_ICONINFORMATION);
end;
procedure TMainForm.btSwapClick(Sender: TObject);
begin
MessageBox(Handle, '公文交换系统暂未接入！ ', '提示', MB_ICONINFORMATION);
end;
initialization
HookID := 0;
FUploadMissions := TStringList.Create;
FSavedUploadMissions := TList.Create;
FDownloadMissions := TStringList.Create;
FSavedDownloadMissions := TList.Create;
CoInitialize(nil);
OleInitialize(nil);
finalization
try
ClearFileMissions;
FreeAndNil(FSavedDownloadMissions);
FreeAndNil(FSavedUploadMissions);
FreeAndNil(FUploadMissions);
FreeAndNil(FDownloadMissions);
OleUninitialize;
CoUninitialize;
except
end;
end.