RealICQClient/Client/MessagesManagerFrm.pas

unit MessagesManagerFrm;

interface

uses
  TransmitDirection,
  FileTransmitterObjective, md5, MyInputBoxFrm,
  FileTransmitter, DownloadFileFromWeb,ShellAPI,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, StrUtils, xFonts,
  Dialogs, ExtCtrls, ActnCtrls, ActnMan, ActnMenus, ToolWin, ComCtrls, ImgList, MSHTML,
  Menus, ActnList, StdStyleActnCtrls, Buttons, StdCtrls, OleCtrls, SHDocVw, RealICQClient,
  RealICQUtils, RealICQSkinFrm, ShareUtils, RealICQContacterTreeView, RealICQModel,
  RealICQSpeedButton, RealICQButton, FileCtrl;

type
  TMessagesManagerForm = class(TRealICQSkinForm)
    pnlClient: TPanel;
    Splitter1: TSplitter;
    CoolBar1: TCoolBar;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    btSearch: TSpeedButton;
    btRefresh: TSpeedButton;
    btDel: TSpeedButton;
    Bevel1: TBevel;
    cbSearchRange: TComboBox;
    edKeyword: TEdit;
    pnlLeft: TPanel;
    tvSenders: TTreeView;
    pnlRight: TPanel;
    Splitter2: TSplitter;
    lvContents: TListView;
    pnlContent: TPanel;
    pnlHeaders: TPanel;
    lblDate: TLabel;
    lblTime: TLabel;
    lblSender: TLabel;
    ScrollBox1: TScrollBox;
    WebBrowser: TWebBrowser;
    pnlPageSet: TPanel;
    btNext: TSpeedButton;
    btLast: TSpeedButton;
    btFirst: TSpeedButton;
    btPrev: TSpeedButton;
    lblPages: TLabel;
    Label3: TLabel;
    cbPageSize: TComboBox;
    ImgLstNodeImage: TImageList;
    ppTreeNode: TPopupMenu;
    miDelMessageHistory: TMenuItem;
    ppListView: TPopupMenu;
    MenuItem1: TMenuItem;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    btSeeInfo: TRealICQButton;
    btExportAllMsg: TSpeedButton;
    procedure lvContentsColumnClick(Sender: TObject; Column: TListColumn);
    procedure lvContentsClick(Sender: TObject);
    procedure btSeeInfoClick(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure lvContentsMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ppListViewPopup(Sender: TObject);
    procedure btNextClick(Sender: TObject);
    procedure btLastClick(Sender: TObject);
    procedure btPrevClick(Sender: TObject);
    procedure btFirstClick(Sender: TObject);
    procedure btDelClick(Sender: TObject);
    procedure btSearchClick(Sender: TObject);
    procedure btRefreshClick(Sender: TObject);
    procedure lvContentsDblClick(Sender: TObject);
    procedure WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
    procedure lvContentsChange(Sender: TObject; Item: TListItem;Change: TItemChange);
    procedure tvSendersChange(Sender: TObject; Node: TTreeNode);
    procedure lvContentsResize(Sender: TObject);
    procedure tvSendersGetSelectedIndex(Sender: TObject; Node: TTreeNode);
    procedure tvSendersCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ppTreeNodePopup(Sender: TObject);
    procedure tvSendersMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure miDelMessageHistoryClick(Sender: TObject);
    procedure cbPageSizeChange(Sender: TObject);
    procedure WebBrowserBeforeNavigate2(ASender: TObject;const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,Headers: OleVariant; var Cancel: WordBool);
    procedure btExportAllMsgClick(Sender: TObject);
  private
    FBaseURL: string;
    FRecordCount: Integer;
    FPageCount: Integer;
    FPageIndex: Integer;
    FTeamID: String;
    FSender: String;
    FReceiver: String;
    FFileTransmitter: TFileTransmitter;
    FDownFile: TDownFile;
    FDBFile: String;

    procedure DownFileProgress(ulProgress, ulProgressMax, ulStatusCode: integer; szStatusText: String);
    procedure DownFileComplete(Source_file, Dest_file:String; blStatus:boolean; ErrMessage:String);
    procedure LoadTreeViewItems;
    procedure ClearContents;
    procedure SetDOMStyle(Doc:IHTMLDocument2);
    procedure ShowMessages(Messages: TList);
    procedure LoadMessages;
    procedure SetPageSetsState;
    procedure ShowSystemMessages(Messages: TList);
    procedure LoadSystemMessages;
    procedure LoadSMSMessages;
    procedure FileTransmitterCalculatedSpeed(Sender: TObject; ATransmittedSize: Int64);
    procedure FileTransmitterCompleted(Sender: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    procedure ChangeUIColor(AColor: TColor); override;
    procedure ShowUsersMessages(ALoginName: String);
    procedure ShowTeamsMessages(ATeamID: String);
    function IsDigit(S: String): Boolean;
  end;

var
  MessagesManagerForm: TMessagesManagerForm;

implementation

uses
  MainFrm, RealICQDBHistory, TalkingFrm, SystemMessageFrm, ProcessingFrm, TeamsAdapter,
  UsersService, FriendsService, FileTransmitAdapter;

const
  UserStateIndex: Integer = 1;
  TeamStateIndex: Integer = 2;
  SystemMessageStateIndex: Integer = 3;
  SearchResultStateIndex: Integer = 4;
  SMSMessageStateIndex: Integer = 5;
{$R *.dfm}
{为消息添加字体信息}
//------------------------------------------------------------------------------
procedure AddFontStyle(var AMessageContent: String; FontStr: String);
var
  HexString,
  HTML: String;
  TextFont: TFont;
begin
  HTML := AMessageContent;
  TextFont := TFont.Create;
  try
    StringToFont(FontStr, TextFont);
    //设置字体
    HexString := IntToHex(TextFont.Color, 6);   //获取颜色的16进制格式
    HTML := '<DIV style="font-family:' + TextFont.Name;
    HTML := HTML + ';color:#' + Copy(HexString,5,2) + Copy(HexString,3,2) + Copy(HexString,1,2);  //将BGR颜色转换为RGB颜色
    HTML := HTML + ';font-size:' + IntToStr(TextFont.Size) + 'pt';
    if fsBold in TextFont.Style then HTML := HTML + ';font-weight:bold';
    if fsItalic in TextFont.Style then HTML := HTML + ';font-style:italic';
    HTML := HTML + ';text-decoration:';
    if fsUnderline in TextFont.Style then HTML := HTML + ' underline ';
    if fsStrikeOut in TextFont.Style then HTML := HTML + ' line-through ';
    HTML := HTML + '">' + AMessageContent + ' </DIV>';
  finally
    TextFont.Free;
  end;
  AMessageContent := HTML; 
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.ChangeUIColor(AColor: TColor);
begin
  inherited ChangeUIColor(AColor);
  pnlClient.Color := FormColor;
  btSeeInfo.ChangeUIColor(AColor);
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.btSearchClick(Sender: TObject);
var
  Messages: TList;
  MessageSearchResult: TMessageSearchResult;
  Node: TTreeNode;
  RealICQTeam: TRealICQTeam;
  RealICQUser: TRealICQUser;
  iLoop: Integer;
  AMessageStr,
  ReceiverName,
  ALoginName: String;
begin  if Length(Trim(edKeyword.Text)) = 0 then
  begin
    MessageBox(Handle, '请输入关键字', '提示', MB_ICONINFORMATION);
    Exit;
  end;

  ClearContents;
  Messages := nil;
  ProcessingForm := TProcessingForm.Create(Self);
  ProcessingForm.Show;
  Application.ProcessMessages;
  Sleep(400);
  try
    if cbSearchRange.ItemIndex <= 0 then
    begin
      Messages := MainForm.DBHistory.SearchMessage('-1', '','', True, Trim(edKeyword.Text));
    end
    else
    begin
      Node := tvSenders.Items.GetFirstNode;
      while Node <> nil do
      begin
        if Node.Text = cbSearchRange.Items.Strings[cbSearchRange.ItemIndex] then
        begin
          if Node.StateIndex = UserStateIndex then
          begin
            try
              RealICQUser := Node.Data;
              if Assigned(RealICQUser) then
              begin
                Messages := MainForm.DBHistory.SearchMessage('-1', RealICQUser.LoginName,
                  MainForm.RealICQClient.LoginName, False, Trim(edKeyword.Text));
                Break;
              end;
            except
            end;
          end;

          if Node.StateIndex = TeamStateIndex then
          begin
            try
              RealICQTeam := Node.Data;
              if Assigned(RealICQTeam) then
              begin
                Messages := MainForm.DBHistory.SearchMessage(RealICQTeam.TeamID, '', '', False, Trim(edKeyword.Text));
                Break;
              end;
            except
            end;
          end;
        end;

        Node := Node.GetNext;
      end; //while
    end;

    if Messages = nil then Exit;
    tvSenders.Items.Item[tvSenders.Items.Count - 1].Selected := True;
    lvContents.Items.BeginUpdate;
    try
      for iLoop := 0 to Messages.Count - 1 do
      begin
        MessageSearchResult := Messages[iLoop];
        with lvContents.Items.Add do
        begin
          try
            if StrToInt(MessageSearchResult.TeamID) <= 0 then
              StateIndex := UserStateIndex
            else
              StateIndex := TeamStateIndex;
          except
            StateIndex := TeamStateIndex;
          end;

          if StateIndex = UserStateIndex then
          begin
            if (MessageSearchResult.TeamID <= '-2') and (MessageSearchResult.TeamID <> '-5') then
              ImageIndex := 8
            else
            begin
              ImageIndex := 1;
            end;
          end
          else
            ImageIndex := 5;


          RealICQUser:= TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Sender);

          ALoginName := RealICQUser.LoginName;
          if Pos('-', ALoginName) > 0 then
             ALoginName := Copy(ALoginName, Pos('-', ALoginName) + 1, Length(ALoginName));

          if (Length(RealICQUser.DisplayName) = 0) then
            Caption := ALoginName
          else
            Caption := RealICQUser.DisplayName + '<' + ALoginName + '>';

          if MessageSearchResult.TeamID <= '-2' then
          begin
            RealICQUser:= TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Receiver);

            ALoginName := RealICQUser.LoginName;
            if Pos('-', ALoginName) > 0 then ALoginName := Copy(ALoginName, Pos('-', ALoginName) + 1, Length(ALoginName));

            if (Length(RealICQUser.DisplayName) = 0) then
              ReceiverName := ALoginName
            else
              ReceiverName := RealICQUser.DisplayName + '<' + ALoginName + '>';
            Caption := Caption + ' -> ' + ReceiverName;
          end;

          SubItems.Add(DateToStr(MessageSearchResult.SendDateTime));
          SubItems.Add(TimeToStr(MessageSearchResult.SendDateTime));

          AMessageStr := MessageSearchResult.MessageStr; 
          GetFaces2(AMessageStr, False);
          SubItems.Add(AMessageStr);
          Data := MessageSearchResult;
        end;
      end;
    finally
      lvContents.Items.EndUpdate;
      Messages.Free;
    end;
  finally
    pnlPageSet.Visible := False;
    ProcessingForm.Free;
  end;
end;
//------------------------------------------------------------------------------
//变量S为要判断的字符串,返回true则正确
function TMessagesManagerForm.IsDigit(S:String):Boolean;
var
i,j:integer;
begin
    Result:=True;
    j :=0 ;
    for i :=1 to length(s) do
    begin
       if not (s[i] in ['0'..'9','.'])then   //判断字符串每个字符即s[i],是否为"0"到'9"数字及".'
         Result:=False;
       if s[i]='.' Then //统计字符串中"."的个数
         j:=j+1;
    end;
    if j > 1 then   //字符串中"."的个数大于1
       Result:=False;
    if (s[1]='.') or (s[length(s)]='.') then //字符串中"."的在最前面和最后面
       Result:=False;
    //增加, 字符串中"."的位置之前有两个"0"判断
    s:=copy(s,1, pos('.', S)-1); //取字符串中"."的位置之前字符
    j:=0;
    for i:=1 to length(s) do
    begin
       if s[i]='0' then
          j:=j+1;
    end;
    if j > 1 then    //字符串中"."的位置之前有两个"0"
       Result:=False;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.btExportAllMsgClick(Sender: TObject);
var
  iLoop, jLoop: Integer;
  RootPath, FileName, StrLogin,StrSender, StrReceiver, StrTmp: string;
  GroupList, UserList, TmpList: TStringList;
  MessageSearchResult: TMessageSearchResult;
  Messages: TList;
  RealICQUser: TRealICQUser;
  RealICQTeam: TRealICQTeam;
begin
  RootPath := '';
  if SelectDirectory('请设置历史聊天记录文件的导出路径', '', RootPath) then
  begin
     if RootPath = '' then Exit;
     RootPath := RootPath + '\历史记录\';
     if not DirectoryExists(RootPath) then CreateDir(RootPath);
     ProcessingForm := TProcessingForm.Create(Self);
     ProcessingForm.Show;
     Application.ProcessMessages;
     Sleep(500);
     Messages := MainForm.DBHistory.SearchMessage('-1', '','', True, '');
     if Messages = nil then Exit;
     TmpList := TStringList.Create;
     //群组消息
     GroupList := TTeamsAdapter.GetTeams();
     if GroupList <> nil then
       for iLoop := 0 to GroupList.Count - 1 do
       begin
         RealICQTeam := GroupList.Objects[iLoop] as TRealICQTeam;
         if Length(RealICQTeam.TeamCaption) = 0 then
            FileName := RootPath + '群组：' + RealICQTeam.TeamID + '.txt'
         else
            FileName := RootPath + '群组：' + RealICQTeam.TeamCaption + '.txt';
         TmpList.Clear;
         for jLoop := 0 to Messages.Count - 1 do
         begin
            MessageSearchResult := Messages[jLoop];
            if MessageSearchResult.TeamID = RealICQTeam.TeamID then
            begin
              RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Sender);
              StrSender := RealICQUser.LoginName;
              if Pos('-', StrSender) > 0 then
                 StrSender := Copy(StrSender, Pos('-', StrSender) + 1, Length(StrSender));
              if (Length(RealICQUser.DisplayName) <> 0) then
                 StrSender := RealICQUser.DisplayName + '(' + StrSender + ')';
              StrTmp := DateToStr(MessageSearchResult.SendDateTime) + ' ';
              StrTmp := StrTmp + TimeToStr(MessageSearchResult.SendDateTime) + ' ';
              StrTmp := StrTmp + StrSender + #13#10;
              StrTmp := StrTmp + #13#10 + MessageSearchResult.MessageStr + #13#10;
              TmpList.Add(StrTmp);
            end;
         end;
         if TmpList.Count > 0 then TmpList.SaveToFile(FileName);
       end;
     //手机短信
     StrTmp := '';
     TmpList.Clear;
     FileName := RootPath + '手机短信.txt';
     for iLoop := 0 to Messages.Count - 1 do
     begin
       MessageSearchResult := Messages[iLoop];
       if (MessageSearchResult.TeamID = '-2') or (MessageSearchResult.TeamID = '-3') then
       begin
          if IsDigit(MessageSearchResult.Sender) then
             StrSender := MessageSearchResult.Sender
          else
             begin
                RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Sender);
                StrSender := RealICQUser.LoginName;
                if Pos('-', StrSender) > 0 then
                   StrSender := Copy(StrSender, Pos('-', StrSender) + 1, Length(StrSender));
                if (Length(RealICQUser.DisplayName) <> 0) then
                   StrSender := RealICQUser.DisplayName + '(' + StrSender + ')';
             end;
          if IsDigit(MessageSearchResult.Receiver) then
             StrReceiver := MessageSearchResult.Receiver
          else
             begin
                RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Receiver);
                StrReceiver := RealICQUser.LoginName;
                if Pos('-', StrReceiver) > 0 then
                   StrReceiver := Copy(StrReceiver, Pos('-', StrReceiver) + 1, Length(StrReceiver));
                if (Length(RealICQUser.DisplayName) <> 0) then
                   StrReceiver := RealICQUser.DisplayName + '(' + StrReceiver + ')';
             end;
          StrTmp := StrTmp + DateToStr(MessageSearchResult.SendDateTime) + ' ';
          StrTmp := StrTmp + TimeToStr(MessageSearchResult.SendDateTime) + ' ';
          StrTmp := StrTmp + StrSender + ' -> ' + StrReceiver + #13#10;
          StrTmp := StrTmp + #13#10 + MessageSearchResult.MessageStr + #13#10;
          TmpList.Add(StrTmp);
       end;
     end;
     if TmpList.Count > 0 then TmpList.SaveToFile(FileName);
     //联系人
     UserList := MainForm.DBHistory.GetContactors;
     if UserList <> nil then
       for iLoop := 0 to UserList.Count - 1 do
       begin
         StrLogin := UserList[iLoop];
         if (AnsiPos('+', StrLogin) <= 0) and (trim(MainForm.RealICQClient.CenterServerID) <> '') then
             StrLogin := MainForm.RealICQClient.CenterServerID + '+' + StrLogin;
         if AnsiSameText(StrLogin, MainForm.RealICQClient.LoginName) then continue;
         RealICQUser:= TUsersService.GetUsersService.GetOrRequestUser(StrLogin);
         StrLogin := RealICQUser.LoginName;
         if Pos('-', StrLogin) > 0 then
            StrLogin := Copy(StrLogin, Pos('-', StrLogin) + 1, Length(StrLogin));
         if (Length(RealICQUser.DisplayName) <> 0) then
            StrLogin := RealICQUser.DisplayName + '(' + StrLogin + ')';
         FileName := RootPath + '联系人：' + StrLogin + '.txt';

         TmpList.Clear;
         for jLoop := 0 to Messages.Count - 1 do
         begin
            MessageSearchResult := Messages[jLoop];
            if MessageSearchResult.TeamID <> '-1' then continue;
            if (MessageSearchResult.Sender = UserList[iLoop]) or (MessageSearchResult.Receiver = UserList[iLoop]) then
            begin
              if MessageSearchResult.Sender = UserList[iLoop] then
                 begin
                   StrSender := StrLogin;
                   RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Receiver);
                   StrReceiver := RealICQUser.LoginName;
                   if Pos('-', StrReceiver) > 0 then
                      StrReceiver := Copy(StrReceiver, Pos('-', StrReceiver) + 1, Length(StrReceiver));
                   if (Length(RealICQUser.DisplayName) <> 0) then
                      StrReceiver := RealICQUser.DisplayName + '(' + StrReceiver + ')';
                 end
              else
                 begin
                   StrReceiver := StrLogin;
                   RealICQUser := TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Sender);
                   StrSender := RealICQUser.LoginName;
                   if Pos('-', StrSender) > 0 then
                      StrSender := Copy(StrSender, Pos('-', StrSender) + 1, Length(StrSender));
                   if (Length(RealICQUser.DisplayName) <> 0) then
                      StrSender := RealICQUser.DisplayName + '(' + StrSender + ')';
                 end;

              StrTmp := DateToStr(MessageSearchResult.SendDateTime) + ' ';
              StrTmp := StrTmp + TimeToStr(MessageSearchResult.SendDateTime) + ' ';
              StrTmp := StrTmp + StrSender + #13#10;
              StrTmp := StrTmp + #13#10 + MessageSearchResult.MessageStr + #13#10;
              TmpList.Add(StrTmp);
            end;
         end;
         if TmpList.Count > 0 then TmpList.SaveToFile(FileName);
       end;
     Messages.Free;
     ProcessingForm.Free;
     MessageBox(Handle, '所有历史记录导出完成！ ', '提示', MB_OK or MB_ICONINFORMATION);
     ShellExecute(handle, 'open', PChar('"' + RootPath + '"'), nil, nil, SW_SHOWNORMAL);
  end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.btSeeInfoClick(Sender: TObject);
var LoginName,Url:String;

begin
  Url:=btSeeInfo.Hint;
  LoginName := MainForm.RealICQClient.LoginName;
  if AnsiPos('-',LoginName)>0 then
  begin
     LoginName:=Copy(LoginName,AnsiPos('-',LoginName)+1,Length(LoginName)-AnsiPos('-',LoginName));
  end;

  Url := AnsiReplaceText(Url, '[%LoginName%]',LoginName );
  Url := AnsiReplaceText(Url, '[%Password%]', MainForm.RealICQClient.Password);
  Url := AnsiReplaceText(Url, '[%MD5_LoginName%]', MD5En(LoginName));
  Url := AnsiReplaceText(Url, '[%MD5_Password%]', MD5En(MainForm.RealICQClient.Password));
  Url := AnsiReplaceText(Url, '[%BranchID%]', MainForm.RealICQClient.Me.BranchID);



  if AnsiSameText(Copy(Url, 1, 5), 'http:') or AnsiSameText(Copy(Url, 1, 6), 'https:') then
  begin
    ShellExecute(handle, 'open',PChar(MainForm.GetDefaultBrowser), PChar('"' + String(Url) + '"'),'', SW_SHOWNORMAL)
  end
  else
    ShellExecute(handle, 'open', PChar(MainForm.GetDefaultBrowser),PChar(Format(MainForm.RealICQClient.WebAppBaseURL + LoginURL, [StrToBase64(MainForm.RealICQClient.LoginName), StrToBase64(MD5En(MainForm.RealICQClient.Password)), StrToBase64(ReadMessageURL +Url)])),'',SW_SHOWDEFAULT);

end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.cbPageSizeChange(Sender: TObject);
begin
  if tvSenders.Selected.StateIndex = SystemMessageStateIndex then
    LoadSystemMessages
  else if tvSenders.Selected.StateIndex = SMSMessageStateIndex then
    LoadSMSMessages
  else
    LoadMessages;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.ShowUsersMessages(ALoginName: String);
var
  Node,
  NodeUser,
  NodeGroup: TTreeNode;
  RealICQUser: TRealICQUser;
  ACaption: String;
begin
  Node := tvSenders.Items.GetFirstNode;
  while Node <> nil do
  begin
    if AnsiSameStr(ALoginName, '<SMS>') then
    begin
      if Node.StateIndex = SMSMessageStateIndex then
      begin
        Node.Selected := True;
        Exit;
      end;
    end
    else
    begin
      if Node.StateIndex = UserStateIndex then
      begin
        try
          RealICQUser := Node.Data;
          if Assigned(RealICQUser) then
          begin
            if RealICQUser.LoginName = ALoginName then
            begin
               Node.Selected := True;
               Exit;
            end;
          end;
        except
        end;
      end;
    end;

    Node := Node.GetNext;
  end;

  RealICQUser:= TUsersService.GetUsersService.GetOrRequestUser(ALoginName);
  if RealICQUser = nil then Exit;


  ALoginName := RealICQUser.LoginName;
  if Pos('-', ALoginName) > 0 then ALoginName := Copy(ALoginName, Pos('-', ALoginName) + 1, Length(ALoginName));

  if (Length(RealICQUser.DisplayName) = 0) then
    ACaption := ALoginName
  else
    ACaption := RealICQUser.DisplayName + '<' + ALoginName + '>';

  NodeGroup := tvSenders.Items.GetFirstNode.getNextSibling.getNextSibling;
  //NodeGroup := tvSenders.Items.GetFirstNode;
  NodeUser := tvSenders.Items.AddChild(NodeGroup, ACaption);
  NodeUser.Data := RealICQUser;
  NodeUser.StateIndex := UserStateIndex;
  NodeUser.ImageIndex := 1;
  NodeUser.Selected := True;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.ShowTeamsMessages(ATeamID: String);
var
  Node: TTreeNode;
  RealICQTeam: TRealICQTeam;
begin
  Node := tvSenders.Items.GetFirstNode;
  while Node <> nil do
  begin
    if Node.StateIndex = TeamStateIndex then
    begin
      try
        RealICQTeam := Node.Data;
        if Assigned(RealICQTeam) then
        begin
          if RealICQTeam.TeamID = ATeamID then
          begin
            Node.Selected := True;
            Exit;
          end;
        end;
      except
      end;
    end;

    Node := Node.GetNext;
  end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.LoadTreeViewItems;
var
  iLoop, jLoop, iIndex: Integer;
  LoginName, ALoginName, ACaption, GroupName: String;
  ATeams, AUsers, GroupMembers, AlreadyAddedUsers, OtherContactors: TStringList;
  BranchNodes: TList;
  RealICQUser: TRealICQUser;
  RealICQTeam: TRealICQTeam;
  NodeGroup, NodeUser: TTreeNode;
  Branch, TmpBranch: TRealICQBranch;
  BranchInfo: TRealICQBranchInfo;
  Employee: TRealICQEmployee;
  ATreeView: TRealICQContacterTreeView;

  procedure AddGroupUsers(AGroupName: String; GroupList: TStringList);
  var
    kLoop: Integer;
  begin
    try      
      NodeGroup := tvSenders.Items.AddChild(nil, AGroupName);
      NodeGroup.StateIndex := 0;
      NodeGroup.ImageIndex := 4;
      if (GroupList = nil) then
        Exit;
      for kLoop := 0 to GroupList.Count - 1 do
      begin
        LoginName := GroupList[kLoop];
        if AGroupName='其他联系人' then
        begin
           if (AnsiPos('+',LoginName)<=0) and (trim(MainForm.RealICQClient.CenterServerID)<>'') then
              LoginName := MainForm.RealICQClient.CenterServerID + '+' + LoginName;
        end;

        if AnsiSameText(LoginName, MainForm.RealICQClient.LoginName) then continue;
        if AlreadyAddedUsers.IndexOf(LoginName) >= 0  then continue;

        //RealICQUser := GroupList.Objects[kLoop] as TRealICQUser;
        RealICQUser:= TUsersService.GetUsersService.GetOrRequestUser(LoginName);

        ALoginName := RealICQUser.LoginName;
        if Pos('-', ALoginName) > 0 then ALoginName := Copy(ALoginName, Pos('-', ALoginName) + 1, Length(ALoginName));

        if (Length(RealICQUser.DisplayName) = 0) then
          ACaption := ALoginName
        else
          ACaption := RealICQUser.DisplayName + '<' + ALoginName + '>';
        
        NodeUser := tvSenders.Items.AddChild(NodeGroup, ACaption);
        NodeUser.Data := RealICQUser;
        NodeUser.StateIndex := UserStateIndex;
        NodeUser.ImageIndex := 1;
        AlreadyAddedUsers.Add(LoginName);
        cbSearchRange.Items.Add(ACaption);
      end;
    finally
      FreeAndNil(GroupList);
    end;
  end;
begin
  AlreadyAddedUsers := TStringList.Create;
  tvSenders.Items.Clear;
  cbSearchRange.Items.Clear;
  cbSearchRange.Items.Add('全部记录');

  if MainForm.ShowGroup and (MainForm.RealICQClient.WorkingMode = wmPublic) then
  begin
    for iLoop := MainForm.Groups.Count - 1 downto 0 do
    begin
      GroupName := MainForm.Groups[iLoop];
      NodeGroup := tvSenders.Items.AddChildFirst(nil, GroupName);
      NodeGroup.StateIndex := 0;
      NodeGroup.ImageIndex := 4;

      GroupMembers :=  MainForm.Groups.Objects[iLoop] as TStringList;
      for jLoop := 0 to GroupMembers.Count - 1 do
      begin
        LoginName := GroupMembers[jLoop];
        RealICQUser:= TUsersService.GetUsersService.GetUser(LoginName);
        if RealICQUser <> nil then
        begin
          ALoginName := RealICQUser.LoginName;
          if Pos('-', ALoginName) > 0 then
             ALoginName := Copy(ALoginName, Pos('-', ALoginName) + 1, Length(ALoginName));

          if (Length(RealICQUser.DisplayName) = 0) then
              ACaption := ALoginName
          else
              ACaption := RealICQUser.DisplayName + '<' + ALoginName + '>';
            
          NodeUser := tvSenders.Items.AddChild(NodeGroup, ACaption);
          NodeUser.Data := RealICQUser;
          NodeUser.StateIndex := UserStateIndex;
          NodeUser.ImageIndex := 1;
          AlreadyAddedUsers.Add(LoginName);
          cbSearchRange.Items.Add(ACaption);
        end;
      end;
    end;
  end;

  //if MainForm.RealICQClient.WorkingMode = wmPublic then
  //begin
    //好友/联系人列表
    //GroupName := LVFriends;
    //AddGroupUsers(GroupName, MainForm.RealICQClient.Friends);
    //NodeGroup.MoveTo(NodeGroup.Parent, naAddChildFirst);

    //陌生人列表
    //AddGroupUsers(LVStrangers, MainForm.RealICQClient.Strangers);

    //黑名单列表
    //AddGroupUsers(LVBlacklists, MainForm.RealICQClient.Blacklists);
  //end
  //else
  //begin

    try
      BranchNodes := TList.Create;
      {$region '添加部门'}
      for iLoop := 0 to MainForm.RealICQClient.Branchs.Count - 1 do
      begin
        BranchInfo := MainForm.RealICQClient.Branchs.Objects[iLoop] as TRealICQBranchInfo;
        Branch := TRealICQBranch.Create(BranchInfo.BranchName);
        Branch.BranchID := BranchInfo.ID;
        Branch.ParentID := BranchInfo.ParentID;
        Branch.Node := tvSenders.Items.AddChildObject(nil, Branch.BranchName, Branch);
        Branch.Node.StateIndex := 0;        
        Branch.Node.ImageIndex := 4;

        for jLoop := 0 to BranchNodes.Count - 1 do
        begin
          NodeGroup := BranchNodes[jLoop];
          TmpBranch := TRealICQBranch(NodeGroup.Data);
          if AnsiSameText(Branch.ParentID, TmpBranch.BranchID) then
          begin
            Branch.Node.MoveTo(TmpBranch.Node, naAddChild);
            TmpBranch.Node.Expanded := False;
            Break;
          end;
        end;
        BranchNodes.Add(Branch.Node);
      end;

      for iLoop := 0 to tvSenders.Items.Count - 1 do
      begin
        Branch := TRealICQBranch(tvSenders.Items.Item[iLoop].Data);
        for jLoop := 0 to tvSenders.Items.Count - 1 do {添加至父部门}
        begin
          if iLoop = jLoop then continue;
        
          TmpBranch := TRealICQBranch(tvSenders.Items.Item[jLoop].Data);
          if AnsiSameText(Branch.ParentID, TmpBranch.BranchID) then
          begin
            if Branch.Node.Parent = TmpBranch.Node then continue;
          
            Branch.Node.MoveTo(TmpBranch.Node, naAddChild);
            TmpBranch.Node.Expanded := False;
            Break;
          end;
        end;
      end;
      {$endregion}

      {$region '添加用户'}
      AUsers := TUsersService.GetUsersService.GetWorkmatesAndFriends;
      for iLoop := AUsers.Count - 1  downto 0 do
      begin
        RealICQUser := AUsers.Objects[iLoop] as TRealICQUser;
        ALoginName := RealICQUser.LoginName;
        if Pos('-', ALoginName) > 0 then ALoginName := Copy(ALoginName, Pos('-', ALoginName) + 1, Length(ALoginName));
        if (Length(RealICQUser.DisplayName) = 0) then
          ACaption := ALoginName
        else
          ACaption := RealICQUser.DisplayName + '<' + ALoginName + '>';
        cbSearchRange.Items.Add(ACaption);
        Employee := TRealICQEmployee.Create(RealICQUser.LoginName);
        Employee.BranchID := RealICQUser.BranchID;

        for jLoop := 0 to BranchNodes.Count - 1 do
        begin
          NodeGroup := BranchNodes[jLoop];
          if NodeGroup.StateIndex <> 0 then continue;
          
          TmpBranch := TRealICQBranch(NodeGroup.Data);
          if AnsiSameText(Employee.BranchID, TmpBranch.BranchID) then
          begin
            Employee.Node := tvSenders.Items.AddChildObjectFirst(TmpBranch.Node, ACaption, Employee);
            Employee.Node.StateIndex := UserStateIndex;
            Employee.Node.ImageIndex := 1;
            Employee.Node.Data:=RealICQUser;
            TmpBranch.Node.Expanded := False;

            AlreadyAddedUsers.Add(Employee.LoginName);
            Break;
          end;
        end;
      end;

      {$endregion}
    finally
      FreeAndNil(BranchNodes);
      if AUsers <> nil then
         FreeAndNil(AUsers);
    end;
  //end;


  GroupName := LVFriends;
  AddGroupUsers(GroupName, TFriendsService.GetService.GetFriends);
  NodeGroup.MoveTo(NodeGroup.Parent, naAddChildFirst);

  GroupName := '其他联系人';
  OtherContactors := MainForm.DBHistory.GetContactors;
  AddGroupUsers(GroupName, OtherContactors);


  //添加群组列表
  NodeGroup := tvSenders.Items.AddChild(nil, LVTeams);
  NodeGroup.StateIndex := 0;
  NodeGroup.ImageIndex := 4;
  ATeams := TTeamsAdapter.GetTeams();
  if ATeams <> nil then
    for iLoop := 0 to ATeams.Count - 1 do
    begin
      RealICQTeam := ATeams.Objects[iLoop] as TRealICQTeam;
      if Length(RealICQTeam.TeamCaption) = 0 then
         ACaption := RealICQTeam.TeamID
      else
         ACaption := RealICQTeam.TeamCaption + '<群号码:' + RealICQTeam.TeamID + '>';
      NodeUser := tvSenders.Items.AddChild(NodeGroup, ACaption);
      NodeUser.Data := RealICQTeam;
      NodeUser.StateIndex := TeamStateIndex;
      NodeUser.ImageIndex := 5;
      cbSearchRange.Items.Add(ACaption);
    end;

  //添加手机短消息结节
  NodeGroup := tvSenders.Items.AddChild(nil, '手机短信');
  NodeGroup.StateIndex := SMSMessageStateIndex;
  NodeGroup.ImageIndex := 8;

  //添加系统消息结节
  NodeGroup := tvSenders.Items.AddChild(nil, LVSystemMessage);
  NodeGroup.StateIndex := SystemMessageStateIndex;
  NodeGroup.ImageIndex := 6;

  //添加查找结果结节
  NodeGroup := tvSenders.Items.AddChild(nil, '查找结果');
  NodeGroup.StateIndex := SearchResultStateIndex;
  NodeGroup.ImageIndex := 7;

  AlreadyAddedUsers.Free;
  cbSearchRange.ItemIndex := 0;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.SpeedButton1Click(Sender: TObject);
var
  DBFile: String;
begin
  if Length(Trim(MainForm.RealICQClient.DBHistoryFileName)) > 0 then
  begin
    if MessageBox(Handle, PChar(Format('确定要替换服务器上%s的消息记录吗?', [DateTimeToStr(MainForm.RealICQClient.DBHistoryFileUploadDateTime)])), '提示', MB_OKCANCEL or MB_ICONQUESTION) <> ID_OK then Exit;
  end;
  
  DBFile := MainForm.DBHistory.DBFileName;
  try
    try
      MainForm.DBHistory.CloseDBConntion;
      FFileTransmitter := TFileTransmitter.Create(MainForm.RealICQClient.TCPClient, tdSender, DBFile, 2, MainForm.RealICQClient.LoginName, 0, 0);
      FFileTransmitter.OnTransmitting := FileTransmitterCalculatedSpeed;
      FFileTransmitter.OnTransmitOK := FileTransmitterCompleted;
      FFileTransmitter.SendFileRequest;
      SpeedButton1.Enabled := False;
    except
      On E: Exception do MessageBox(Handle, PChar('备份消息记录时出错：' + E.Message), '提示', MB_OK);
    end;
  finally
    //  MainForm.DBHistory.DBFileName := DBFile;
  end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.SpeedButton2Click(Sender: TObject);
begin
  if Length(Trim(MainForm.RealICQClient.DBHistoryFileName)) = 0 then
  begin
    MessageBox(Handle, '没有备份记录！', '提示', MB_OK);
    Exit;
  end;
  
  if MessageBox(Handle, PChar(Format('确定要将 %s 的消息记录恢复至本地吗?', [DateTimeToStr(MainForm.RealICQClient.DBHistoryFileUploadDateTime)])), '提示', MB_OKCANCEL or MB_ICONQUESTION) <> ID_OK then Exit;
  
  FDownFile := TDownFile.Create;
  FDownFile.OnComplete := DownFileComplete;
  FDownFile.OnProgress := DownFileProgress;
  
  FDBFile := MainForm.DBHistory.DBFileName + '.TEMP';
  FDownFile.ThreadDownFile(MainForm.RealICQClient.DBHistoryFileName, FDBFile);
  SpeedButton2.Enabled := False;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.FileTransmitterCalculatedSpeed(Sender: TObject; ATransmittedSize: Int64);
var
  Completed: Integer;
begin
  Completed := ATransmittedSize*100 div FFileTransmitter.StreamLength;
  SpeedButton1.Caption := IntToStr(Completed)+'%';
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.FileTransmitterCompleted(Sender: TObject);
begin
  SpeedButton1.Enabled := True;
  SpeedButton1.Caption := '备份';
  MessageBox(Handle, PChar('消息记录已成功备份至服务器'), '提示', MB_OK or MB_ICONINFORMATION);
  MainForm.DBHistory.OpenDBConntion;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.DownFileProgress(ulProgress, ulProgressMax, ulStatusCode: integer; szStatusText: String);
var
  Completed: Integer;
begin
  if ulProgressMax = 0 then Exit;
  
  Completed := ulProgress*100 div ulProgressMax;
  SpeedButton2.Caption := IntToStr(Completed)+'%';
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.DownFileComplete(Source_file, Dest_file:String; blStatus:boolean; ErrMessage:String);
begin
  SpeedButton2.Caption := '恢复';
  SpeedButton2.Enabled := True;
  if blStatus then
  begin
    try
      ProcessingForm := TProcessingForm.Create(Self);
      ProcessingForm.pnlClient.Caption := '正在恢复记录，请稍候...';
      ProcessingForm.Show;
      Application.ProcessMessages;
      Sleep(400);
      try
        MainForm.DBHistory.RestoreMessageHistory(FDBFile);
      finally
        ProcessingForm.Free;
      end;
      MessageBox(Handle, '恢复消息记录成功！', '提示', MB_ICONINFORMATION);
    except
      MessageBox(Handle, PChar('恢复消息记录失败: ' + ErrMessage), '错误', MB_ICONERROR);
    end;
  end
  else
  begin
    MessageBox(Handle, PChar('恢复消息记录失败: ' + ErrMessage), '错误', MB_ICONERROR);
  end;

  btRefresh.Click;
  //tvSendersChange(tvSenders, tvSenders.Selected);
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.lvContentsResize(Sender: TObject);
begin
  lvContents.Columns.Items[3].Width := lvContents.Width - 308;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.miDelMessageHistoryClick(Sender: TObject);
var
  Node: TTreeNode;
  RealICQUser: TRealICQUser;
  RealICQTeam: TRealICQTeam;
begin
  Node := tvSenders.Selected;
  if Node = nil then Exit;

  if MessageBox(Handle, '确定要删除这些消息记录吗？', '确认删除', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
  begin
    Exit;
  end;

  if Node.StateIndex = UserStateIndex then
  begin
    RealICQUser := Node.Data;
    MainForm.DBHistory.DelMessageByLoginName(RealICQUser.LoginName);
  end
  else if Node.StateIndex = TeamStateIndex then
  begin
    RealICQTeam := Node.Data;
    MainForm.DBHistory.DelMessageByTeamID(RealICQTeam.TeamID);
  end
  else if Node.StateIndex = SystemMessageStateIndex then
  begin
    MainForm.DBHistory.DelAllSystemMessage;
  end;
  if Node.Parent = tvSenders.Items.GetFirstNode.getNextSibling.getNextSibling then
  begin
    FreeAndNil(Node);
  end;
  tvSendersChange(tvSenders, Node);
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.ppListViewPopup(Sender: TObject);
begin
  MenuItem1.Enabled := btDel.Enabled;
end;
procedure TMessagesManagerForm.ppTreeNodePopup(Sender: TObject);
begin
  miDelMessageHistory.Visible := tvSenders.Selected <> nil;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.lvContentsChange(Sender: TObject;
  Item: TListItem; Change: TItemChange);
var
  MessageSearchResult: TMessageSearchResult;
  SystemMessageSearchResult: TSystemMessageSearchResult;
  AMessageStr,Content: String;
  Password,AReceiver:String;
  TempMessage:TMessageSearchResult;
  hwnd:THandle;
  UserName:String;
begin
  if lvContents.SelCount > 0 then
  begin
    if not btDel.Enabled then
    begin
      btDel.Enabled := True;
    end;
  end
  else
  begin
    if btDel.Enabled then
    begin
      btDel.Enabled := False;
    end;
  end;

  if Item = nil then Exit;
  AMessageStr := '';
  lblDate.Caption := '日期: ' + Item.SubItems[0];
  lblTime.Caption := '时间: ' + Item.SubItems[1];
  lblSender.Caption := '发信人: ' + Item.Caption;

  btSeeInfo.Visible:=False;
  ClearHTML(WebBrowser);
  if (Item.StateIndex = UserStateIndex) or (Item.StateIndex = TeamStateIndex) or (Item.StateIndex = SMSMessageStateIndex) then
  begin
    MessageSearchResult := Item.Data;

    if MessageSearchResult.IsEncryMessage then
    begin

       hWnd:=FindWindow(nil,pchar(trim('输入密码')));
       if hWnd>0 then Exit;

       Password:=(ShowMyInputBox('输入密码','密码','', 50));

       if Password<>MainForm.RealICQClient.Password then
       begin
           if Password<>'' then
              Dialogs.ShowMessage('密码错误');

           Exit;
       end;

       TempMessage:=MainForm.DBHistory.GetMessageByMessageID(IntToStr(MessageSearchResult.ID));

       if (MainForm.RealICQClient.CenterServerID<>'') and (AnsiPos('+',TempMessage.Sender)<=0) then
             AReceiver:=MainForm.RealICQClient.CenterServerID+'+' + TempMessage.Sender;


       if (not TempMessage.IsRead) and (MainForm.RealICQClient.LoginName<>AReceiver) then //发送已经查看私密消息确认信息给发送者
       begin
                UserName:=MainForm.RealICQClient.Me.DisplayName;
                if Trim(UserName)='' then UserName:=MainForm.RealICQClient.Me.LoginName;
                
                Content:='LXC01'+#13+#10+'LXUMC'+#13+#10+'0'+ #13+#10+'您于［'+DateTimeToStr(TempMessage.SendDateTime)
                       +'］发送给'+UserName+'的签收消息对方已经阅读！';

                MainForm.RealICQClient.SendCustomMessage(MainForm.RealICQClient.LoginName,AReceiver,Content);

       end;
    end;

    AMessageStr := FilterHTMLCode(MessageSearchResult.MessageStr, MainForm.AllowURL);
    if MessageSearchResult.TeamID <> '-5' then
       GetFaces2(AMessageStr, True);
    AddFontStyle(AMessageStr, MessageSearchResult.Font); 
  end;

  if (Item.StateIndex = SystemMessageStateIndex) then
  begin
    SystemMessageSearchResult := Item.Data;
    if SystemMessageSearchResult.MessageType = mtBroadcast then
      AMessageStr := SystemMessageSearchResult.Content
    else
      AMessageStr := SystemMessageSearchResult.Title;

    if trim(SystemMessageSearchResult.Url)<>'' then
    begin
      btSeeInfo.Hint:=SystemMessageSearchResult.Url;
      btSeeInfo.Visible:=True;
    end;
  end;

  InsertHTML(WebBrowser, AMessageStr);
end;
procedure TMessagesManagerForm.lvContentsClick(Sender: TObject);
begin

  if lvContents.Selected<>nil then
     self.lvContentsChange(Sender,lvContents.Selected,ctText);
  
end;
procedure TMessagesManagerForm.lvContentsColumnClick(Sender: TObject;
  Column: TListColumn);
begin
   //
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.lvContentsDblClick(Sender: TObject);
var
  Item: TListItem;
  SystemMessageSearchResult: TSystemMessageSearchResult;
begin
  Item := lvContents.Selected;
  if Item = nil then Exit;
  if (Item.StateIndex = SystemMessageStateIndex) then
  begin
    SystemMessageSearchResult := Item.Data;
    OpenSystemMessageForm(IntToStr(SystemMessageSearchResult.MessageID),
            SystemMessageSearchResult.MessageType,
            SystemMessageSearchResult.PositionType,
            SystemMessageSearchResult.Left,
            SystemMessageSearchResult.Top,
            SystemMessageSearchResult.Width,
            SystemMessageSearchResult.Height,
            SystemMessageSearchResult.Title,
            SystemMessageSearchResult.Content,
            SystemMessageSearchResult.URL,
            SystemMessageSearchResult.AutoCloseTime);
  end;
end;
procedure TMessagesManagerForm.lvContentsMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.btDelClick(Sender: TObject);
var
  iLoop: Integer;
  ListItem: TListItem;
  MessageSearchResult: TMessageSearchResult;
  SystemMessageSearchResult: TSystemMessageSearchResult;
begin
  {if tvSenders.Focused then
  begin
    miDelMessageHistory.Click;
    Exit;
  end;}

  if MessageBox(Handle, '确定要删除选中的消息记录吗？', '确认删除', MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
  begin
    Exit;
  end;

  for iLoop := lvContents.Items.Count - 1 downto 0 do
  begin
      ListItem := lvContents.Items.Item[iLoop];
      if ListItem.Selected then
      begin
        if ListItem.StateIndex = SystemMessageStateIndex then
        begin
          SystemMessageSearchResult := ListItem.Data;
          MainForm.DBHistory.DelSystemMessage(SystemMessageSearchResult.ID);
          FreeAndNil(SystemMessageSearchResult);
        end
        else
        begin
          MessageSearchResult := ListItem.Data;
          MainForm.DBHistory.DelMessage(MessageSearchResult.ID);
          FreeAndNil(MessageSearchResult);
        end;

        lvContents.Items.Delete(iLoop);
        //ClearContents;
      end;
  end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.btLastClick(Sender: TObject);
begin
  FPageIndex := 1000000;
  
  if tvSenders.Selected.StateIndex = SystemMessageStateIndex then
    LoadSystemMessages
  else if tvSenders.Selected.StateIndex = SMSMessageStateIndex then
    LoadSMSMessages
  else
    LoadMessages;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.btNextClick(Sender: TObject);
begin
  Inc(FPageIndex);
  
  if tvSenders.Selected.StateIndex = SystemMessageStateIndex then
    LoadSystemMessages
  else if tvSenders.Selected.StateIndex = SMSMessageStateIndex then
    LoadSMSMessages
  else
    LoadMessages;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.btFirstClick(Sender: TObject);
begin
  FPageIndex := 1;

  if tvSenders.Selected.StateIndex = SystemMessageStateIndex then
    LoadSystemMessages
  else if tvSenders.Selected.StateIndex = SMSMessageStateIndex then
    LoadSMSMessages
  else
    LoadMessages;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.btPrevClick(Sender: TObject);
begin
  Dec(FPageIndex);
  
  if tvSenders.Selected.StateIndex = SystemMessageStateIndex then
    LoadSystemMessages
  else if tvSenders.Selected.StateIndex = SMSMessageStateIndex then
    LoadSMSMessages
  else
    LoadMessages;
end;
procedure TMessagesManagerForm.btRefreshClick(Sender: TObject);
begin
  Self.ClearContents;
  ClearHTML(WebBrowser);
  LoadTreeViewItems;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.ClearContents;
var
  iLoop: Integer;
  DataObj: TObject;
begin
  for iLoop := 0 to lvContents.Items.Count - 1 do
  begin
    DataObj := lvContents.Items.Item[iLoop].Data;  
    FreeAndNil(DataObj);
  end;
  lvContents.Items.Clear;

  lblDate.Caption := '日期:';
  lblTime.Caption := '时间:';
  lblSender.Caption := '发信人:';
  ClearHTML(WebBrowser);
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.ShowSystemMessages(Messages: TList);
var
  iLoop: Integer;
  SystemMessageSearchResult: TSystemMessageSearchResult;
  AMessageStr: String;
begin
    SetPageSetsState;
    lvContents.Items.BeginUpdate;
    try
      ClearContents;
      for iLoop := 0 to Messages.Count - 1 do
      begin
        SystemMessageSearchResult := Messages[iLoop];
        with lvContents.Items.Add do
        begin
          StateIndex := tvSenders.Selected.StateIndex;
          ImageIndex := 6; 
          Caption := '系统管理员';

          SubItems.Add(DateToStr(SystemMessageSearchResult.SendDateTime));
          SubItems.Add(TimeToStr(SystemMessageSearchResult.SendDateTime));

          if SystemMessageSearchResult.MessageType = mtBroadcast then
            AMessageStr := '系统广播：'
          else
            AMessageStr := '系统广告：';
          AMessageStr := AMessageStr + SystemMessageSearchResult.Title;
          SubItems.Add(AMessageStr);
          Data := SystemMessageSearchResult;
        end;
      end;
    finally
      lvContents.Items.EndUpdate;
      SendMessage(lvContents.Handle, WM_VSCROLL, SB_BOTTOM, 0); //发送到底消息
      Messages.Free;
    end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.SetPageSetsState;
begin
    lblPages.Caption := Format('%d 条记录，第 %d 页、共 %d 页', [FRecordCount, FPageIndex, FPageCount]);
    if FPageIndex < FPageCount then
      btNext.Enabled := True
    else
      btNext.Enabled := False;
    if FPageIndex > 1 then
      btPrev.Enabled := True
    else
      btPrev.Enabled := False;      
    btFirst.Enabled := btPrev.Enabled;
    btLast.Enabled := btNext.Enabled;
    pnlPageSet.Visible := True;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.ShowMessages(Messages: TList);
var
  iLoop: Integer;
  RealICQUser: TRealICQUser;
  MessageSearchResult: TMessageSearchResult;
  AMessageStr,
  ReceiverName: String;
  ALoginName: String;
begin   
    SetPageSetsState;
    lvContents.OnChange := nil;
    lvContents.Items.BeginUpdate;
    try
      ClearContents;
      for iLoop := 0 to Messages.Count - 1 do
      begin
        MessageSearchResult := Messages[iLoop];
        with lvContents.Items.Add do
        begin
          StateIndex := tvSenders.Selected.StateIndex;
          if (StateIndex = UserStateIndex) or (StateIndex = SMSMessageStateIndex) then
          begin
            //Dialogs.ShowMessage(MessageSearchResult.TeamID);
            if ((MessageSearchResult.TeamID = '-2') or (MessageSearchResult.TeamID = '-3')) then
            begin
              ImageIndex := 8;
            end
            else
            begin
              ImageIndex := 1;
            end;
          end
          else
            ImageIndex := 5;

          RealICQUser:= TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Sender);
          ALoginName := RealICQUser.LoginName;
          if Pos('-', ALoginName) > 0 then ALoginName := Copy(ALoginName, Pos('-', ALoginName) + 1, Length(ALoginName));
          if (Length(RealICQUser.DisplayName) = 0) then
            Caption := ALoginName
          else
            Caption := RealICQUser.DisplayName + '<' + ALoginName + '>';
            
          if MessageSearchResult.TeamID <= '-2' then
          begin
            RealICQUser:= TUsersService.GetUsersService.GetOrRequestUser(MessageSearchResult.Receiver);
            ALoginName := RealICQUser.LoginName;
            if Pos('-', ALoginName) > 0 then
               ALoginName := Copy(ALoginName, Pos('-', ALoginName) + 1, Length(ALoginName));
            if (Length(RealICQUser.DisplayName) = 0) then
              ReceiverName := RealICQUser.LoginName
            else
              ReceiverName := RealICQUser.DisplayName + '<' + RealICQUser.LoginName + '>';
            Caption := Caption + ' -> ' + ReceiverName;
          end;
          
          SubItems.Add(DateToStr(MessageSearchResult.SendDateTime));
          SubItems.Add(TimeToStr(MessageSearchResult.SendDateTime));

          AMessageStr := MessageSearchResult.MessageStr;

          if MessageSearchResult.IsEncryMessage then
          begin
             if MessageSearchResult.Sender=MainForm.RealICQClient.LoginName then
                AMessageStr:='您发送了一条签收消息'
             else
                AMessageStr:='您收到了一条签收消息';
          end
          else
             AMessageStr := MessageSearchResult.MessageStr;
             
          GetFaces2(AMessageStr, False);
          SubItems.Add(AMessageStr);
          Data := MessageSearchResult;
        end;
      end;
    finally
      lvContents.Items.EndUpdate;
     // lvContents.OnChange := lvContentsChange;
      SendMessage(lvContents.Handle, WM_VSCROLL, SB_BOTTOM, 0); //发送到底消息
      Messages.Free;
    end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.LoadMessages;
var
  DBHistorySearchResult: TDBHistorySearchResult;
begin
    try
      DBHistorySearchResult := MainForm.DBHistory.GetMessage(FTeamID, FSender,
        FReceiver, StrToDate('1900-01-01'), 0, FPageIndex, StrToInt(cbPageSize.Text));
  
    except
      DBHistorySearchResult := MainForm.DBHistory.GetMessage(FTeamID, FSender,
        FReceiver, StrToDate('1900/01/01'), 0, FPageIndex, StrToInt(cbPageSize.Text));
    end;
   
    try
      FRecordCount := DBHistorySearchResult.RecordCount;
      FPageCount := DBHistorySearchResult.PageCount;
      FPageIndex := DBHistorySearchResult.PageIndex;
      ShowMessages(DBHistorySearchResult.Messages);
    finally
      DBHistorySearchResult.Free;
    end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.LoadSystemMessages;
var
  DBHistorySearchResult: TDBHistorySearchResult;
begin
    try
      DBHistorySearchResult := MainForm.DBHistory.GetSystemMessage(StrToDate('1900-01-01'), FPageIndex, StrToInt(cbPageSize.Text));
    except
      DBHistorySearchResult := MainForm.DBHistory.GetSystemMessage(StrToDate('1900/01/01'), FPageIndex, StrToInt(cbPageSize.Text));
    end;
    try
      FRecordCount := DBHistorySearchResult.RecordCount;
      FPageCount := DBHistorySearchResult.PageCount;
      FPageIndex := DBHistorySearchResult.PageIndex;
      ShowSystemMessages(DBHistorySearchResult.Messages);
    finally
      DBHistorySearchResult.Free;
    end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.LoadSMSMessages;
var
  DBHistorySearchResult: TDBHistorySearchResult;
begin
    try
      DBHistorySearchResult := MainForm.DBHistory.GetMessage('-3', '',
        '', StrToDate('1900-01-01'), 0, FPageIndex, StrToInt(cbPageSize.Text));
    except
      DBHistorySearchResult := MainForm.DBHistory.GetMessage('-3', '',
        '', StrToDate('1900/01/01'), 0, FPageIndex, StrToInt(cbPageSize.Text));
    end;
    
    try
      FRecordCount := DBHistorySearchResult.RecordCount;
      FPageCount := DBHistorySearchResult.PageCount;
      FPageIndex := DBHistorySearchResult.PageIndex;
      ShowMessages(DBHistorySearchResult.Messages);
    finally
      DBHistorySearchResult.Free;
    end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.tvSendersChange(Sender: TObject; Node: TTreeNode);
var
  RealICQUser: TRealICQUser;
  RealICQTeam: TRealICQTeam;
begin
  btSeeInfo.Visible:=False;
  lvContents.Items.BeginUpdate;
  try
    ClearContents;
    if Node = nil then Exit;
    if Node.StateIndex = UserStateIndex then
    begin
      {$region '选择了某个用户'}
      RealICQUser := Node.Data;
      FTeamID := '-2';
      FSender := RealICQUser.LoginName;
      FReceiver := MainForm.RealICQClient.LoginName;
      FPageCount := 0;
      FPageIndex := 1000000;
      LoadMessages;
      {$endregion}
      cbSearchRange.ItemIndex := cbSearchRange.Items.IndexOf(Node.Text);
      Exit;
    end;

    if Node.StateIndex = TeamStateIndex then
    begin
      {$region '选择了某个群组'}
      RealICQTeam := Node.Data;
      FTeamID := RealICQTeam.TeamID;
      FSender := '';
      FReceiver := '';
      FPageCount := 0;
      FPageIndex := 1000000;
      LoadMessages;
      {$endregion}
      cbSearchRange.ItemIndex := cbSearchRange.Items.IndexOf(Node.Text);
      Exit;
    end;

    if Node.StateIndex = SystemMessageStateIndex then
    begin
      {$region '选择了系统消息节点'}
      FPageCount := 0;
      FPageIndex := 1000000;
      LoadSystemMessages;
      Exit;
      {$endregion}
    end;

    if Node.StateIndex = SMSMessageStateIndex then
    begin
      {$region '选择了手机短消息节点'}
      FPageCount := 0;
      FPageIndex := 1000000;
      LoadSMSMessages;
      Exit;
      {$endregion}
    end;

    cbSearchRange.ItemIndex := 0;
    pnlPageSet.Visible := False;
  finally
    lvContents.Items.EndUpdate;
  end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.tvSendersCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  DefaultDraw := True;
  if Node.StateIndex = 0 then
  begin
    if Node.Expanded then
      Node.ImageIndex := 3
    else
      Node.ImageIndex := 4;
  end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.tvSendersGetSelectedIndex(Sender: TObject; Node: TTreeNode);
begin
  Node.SelectedIndex := Node.ImageIndex;
end;
procedure TMessagesManagerForm.tvSendersMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Node: TTreeNode;
  P: TPoint;
begin
  Node := tvSenders.GetNodeAt(X, Y);

  if Node = nil then Exit;

  Node.Selected := True;
  if Button <> mbRight then Exit;

  if (Node.StateIndex = UserStateIndex) or
     (Node.StateIndex = TeamStateIndex) or
     (Node.StateIndex = SystemMessageStateIndex) then
  begin
    P.X := X;
    P.Y := Y;
    P := tvSenders.ClientToScreen(P);
    ppTreeNode.Popup(P.X, P.Y);
  end;

end;
{设置WebBrowser的样式}
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.SetDOMStyle(Doc:IHTMLDocument2);
begin
  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 := '2pt';
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.WebBrowserBeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
const
  BaseURL = 'about:blank';
  BaseURL1 = 'about:';
var
  NewUrl, BaseID: string;
  function GetBaseIDFromUrl(SrcUrl:String):String;
  begin
    result := Copy(SrcUrl, AnsiPos('_',SrcUrl) + 1, Length(SrcUrl));
  end;
begin
  if (Pos(FBaseURL, String(URL)) < 1) and (Pos('about:blank', String(URL)) < 1) then
    Exit;

  URL := Trim(AnsiReplaceText(String(URL), FBaseURL, ''));
  if TFileTransmitAdapter.HandleMessage(Self, URL, Cancel) then
    Exit;
  NewUrl := Trim(AnsiReplaceText(String(URL), BaseURL, ''));
  NewUrl := Trim(AnsiReplaceText(String(NewUrl), BaseURL1, ''));

  {$region '打开文件'}
  if AnsiSameText(Copy(NewUrl, 1, 7) , 'File://') then
  begin
    Cancel := True;
    BaseID := AnsiReplaceStr(GetBaseIDFromUrl(NewUrl),'%20',' ');
    if AnsiSameText(ExtractFileExt(BaseID), '.EXE') or
       AnsiSameText(ExtractFileExt(BaseID), '.COM') then
    begin
      if MessageBox(Handle,
                    '直接打开可执行文件可能会有感染病毒的风险，确实要打开此文件吗？',
                    '警告',
                    MB_ICONWARNING or MB_OKCANCEL) <> ID_OK then Exit;
    end;

    if FileExists(BaseID) then
      ShellExecute(handle, 'open', PChar('"' + BaseID + '"'), nil, nil, SW_SHOWNORMAL)
    else
      Dialogs.ShowMessage('本地电脑已经不存在此文件。');

    Exit;
  end;
  {$endregion}
  
  {$region '打开所在文件夹'}
  if AnsiSameText(Copy(NewUrl, 1, 7) , 'Path://') then
  begin
    Cancel := True;
    BaseID := AnsiReplaceStr(GetBaseIDFromUrl(NewUrl),'%20',' ');
    WinExec(PChar('explorer /select,"' + BaseID + '"'), SW_SHOWNORMAL);
    Exit;
  end;
  {$endregion}
end;
procedure TMessagesManagerForm.WebBrowserDocumentComplete(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  try
    SetDomStyle(WebBrowser.Document as IHtmlDocument2);
  except
  end;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  lvContents.OnChange := nil;
  CanClose := True;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.FormCreate(Sender: TObject);
begin
  SkinName := AnsiReplaceText(MainForm.SkinName, 'MainForm', '');
  ChangeUIColor(MainForm.UIMainColor);

  FFileTransmitter := nil;
  
  lvContents.DoubleBuffered := True;
  WebBrowser.Navigate(ExtractFilePath(paramstr(0)) + 'html\chat.html');
  FBaseURL := ExtractFilePath(paramstr(0)) + 'html\';
  AddUserStatePictureToImageList(ImgLstNodeImage);
  LoadTreeViewItems;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.FormDestroy(Sender: TObject);
begin
  MessagesManagerForm := nil;
end;
//------------------------------------------------------------------------------
procedure TMessagesManagerForm.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do
  begin
    Params.WndParent := 0;
  end;
end;

end.