RealICQClient/Client/Group/GroupService.pas

unit GroupService;

interface

uses
  StrUtils, SysUtils, Windows, superobject, Classes, GroupClient, RealICQModel,
  xFonts, Graphics, DownloadFileFromWeb, DateUtils;

type
  TGroupService = class
  private
    FTeams: TStringList;
    FLoginName: string;
    FGroupClient: TGroupClient;
    FDownFile: TDownFile;
    function RemoveMembers(AMembers: string; ARemoveMembers: TStrings): string;
    function AddMembers(AMembers: string; ANewMembers: TStrings): string;
    procedure DownFaceFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
    function AddMember(AMembers, ANewMember: string): string;
  public
    procedure Init(ALoginName: string);
    procedure Uninstall;
    class function GetService: TGroupService; static;
    constructor Create;
    destructor Destroy; override;

    { TODO -olqq -c : 群组请求 2015/6/8 11:09:05 }
    procedure QuitTeam(ATeamID: string);
    procedure DisbandTeam(ATeamID: string);
    procedure UpdateTeam(ATeamID, AIntro, ANotice, AName: string; AAuth: Integer);
    procedure CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: string; ATeamMembers: TStringList; AIsTempTeam: Boolean; ATeamValidateType: TRealICQTeamValidateType);
    procedure SearchTeam(AKey: string; ASearchType: TRealICQTeamSearchType; AMatchingType: TRealICQMatchingType; APage: Integer);
    procedure AddTeamMembers(ATeamID: string; AAddMembers: TStringList);
    procedure RemoveTeamMembers(ATeamID: string; ARemoveMembers: TStringList);
    procedure UpdateTeamMembers(ATeamID: string; AOldMembers, ANewMembers: TStringList);
    function RemoveManager(ATeamID, ALoginName: string): Boolean;
    function AddManager(ATeamID, ALoginName: string): Boolean;
    procedure SetAlias(ATeamID, ALoginName, Alias: string);
    function GetAlias(ATeamID, ALoginName: string): string;
    procedure JoinTeam(ATeamID, ATag: string);
    procedure JoinTeamResponse(ATeamID, ALoginName, ATag: string; Accepted: Boolean);
    procedure SendTeamMessage(ATeamID, ASender, AMsg: string; AFont: TFont; AFaces: TStringList; Attachs: string);
    function IsTeamManager(ATeamID, ALoginName: string): Boolean;
    function GetTeam(ATeamID: string): TRealICQTeam;
    function GetTeams: TStringList;
    procedure MessageMiscMust(ATeamID: string);
    { TODO -olqq -c : 群组信息反馈 2015/6/8 11:08:43 }

    procedure OnMessageReaded(ATeamID: string; ts: Int64);
    procedure OnAddedTeam(ATeam: TRealICQTeam; ts: Int64 = 0);
    procedure OnDeletedTeam(ATeamID: string);
    procedure OnTeamInfoChange(ATeam: TRealICQTeam);
    procedure OnSearched(ARecords: TStringList; ASkip, ALimit: Integer); overload;
    procedure OnAddedMembers(ATeamID: string; AMembers: TStrings);
    procedure OnAddedManagers(ATeamID: string; AManagers: TStrings);
    procedure OnDeletedMembers(ATeamID: string; AMembers: TStrings);
    procedure OnDeletedManagers(ATeamID: string; AManagers: TStrings);
    procedure OnReceivedApplyBoardcast(ATeamID, ALoginName, ATag: string);
    procedure OnReceivedReplyBoardcast(ATeamID, ALoginName, ATag: string; ARet: Integer);
    procedure OnMessage(ATeamID, ASender, AContent, AStyle: string; ASendTime: TDateTime; AMSGType, ALength: Integer);
    procedure OnUploaded(ADownloadURL, AFileName: string);
  end;

implementation

uses
  MainFrm, SearchTeamFrm, RealICQUtils, ShareUtils, RealICQClient, LoggerImport,
  RealICQUtility, ConditionConfig, IdURI, IdHTTP, HTTPApp;

var
  AGroupService: TGroupService;

procedure ClearStringList(AStringList: TStringList);
var
  AObj: TObject;
begin
  if AStringList = nil then
    Exit;
  while AStringList.Count > 0 do
  begin
    Aobj := AStringList.Objects[0];
    AStringList.Delete(0);
    FreeAndNil(AObj);
  end;
end;

{ TGroupService }


function TGroupService.AddManager(ATeamID, ALoginName: string): Boolean;
var
  AManagers: TStringList;
begin
  if Trim(ALoginName) = '' then
    Exit;
  AManagers := TStringList.Create;
  try
    AManagers.Add(ALoginName);
    FGroupClient.AddTeamMembers(ATeamID, nil, AManagers);
  finally
    AManagers.Free;
  end;
end;

function TGroupService.AddMembers(AMembers: string; ANewMembers: TStrings): string;
var
  iLoop: Integer;
  AMemberList: TStrings;
begin
  iLoop := 0;
  Result := '';
  AMemberList := SplitString(AMembers, Chr(10));
  try
    for iLoop := AMemberList.Count - 1 downto 0 do
    begin
      if Length(Trim(AMemberList[iLoop])) = 0 then
        AMemberList.Delete(iLoop);
    end;

    for iLoop := 0 to ANewMembers.Count - 1 do
      if AMemberList.IndexOf(ANewMembers[iLoop]) < 0 then
        AMemberList.Add(ANewMembers[iLoop]);

    iLoop := 0;
    while iLoop < AMemberList.Count - 1 do
    begin
      Result := Result + AMemberList[iLoop] + Chr(10);
      Inc(iLoop);
    end;
    Result := Result + AMemberList[iLoop]
  finally
    AMemberList.Free;
  end;
end;

function TGroupService.AddMember(AMembers: string; ANewMember: string): string;
begin
  Result := AMembers;
  if Pos(ANewMember, AMembers) > 0 then
    Exit;
  Result := AMembers + Chr(10) + ANewMember;
end;

procedure TGroupService.AddTeamMembers(ATeamID: string; AAddMembers: TStringList);
begin
  FGroupClient.AddTeamMembers(ATeamID, AAddMembers, nil);
end;

constructor TGroupService.Create;
begin
  FTeams := TStringList.Create;
  FGroupClient := TGroupClient.Create;
  FDownFile := TDownFile.Create;
  inherited;
end;

procedure TGroupService.CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: string; ATeamMembers: TStringList; AIsTempTeam: Boolean; ATeamValidateType: TRealICQTeamValidateType);
begin
  FGroupClient.CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro, ATeamMembers, AIsTempTeam);
end;

procedure TGroupService.RemoveTeamMembers(ATeamID: string; ARemoveMembers: TStringList);
begin
  FGroupClient.RemoveTeamMembers(ATeamID, ARemoveMembers, nil);
end;

destructor TGroupService.Destroy;
begin
  ClearStringList(FTeams);
  FreeAndNil(FGroupClient);
  FreeAndNil(FDownFile);
  inherited;
end;

procedure TGroupService.DisbandTeam(ATeamID: string);
begin
  FGroupClient.RemoveTeam(ATeamID);
end;

function TGroupService.GetAlias(ATeamID, ALoginName: string): string;
begin

end;

class function TGroupService.GetService: TGroupService;
begin
  if AGroupService = nil then
    AGroupService := TGroupService.Create;
  Result := AGroupService;
end;

function TGroupService.GetTeam(ATeamID: string): TRealICQTeam;
var
  iIndex: Integer;
  ATeam: TRealICQTeam;
begin
  ATeam := nil;
  iIndex := FTeams.IndexOf(ATeamID);
  if iIndex > -1 then
    ATeam := FTeams.Objects[iIndex] as TRealICQTeam;
  Result := ATeam;
end;

function TGroupService.GetTeams: TStringList;
begin
  Result := FTeams;
end;

procedure TGroupService.Init(ALoginName: string);
begin
  FLoginName := ALoginName;
  FGroupClient.Connect(ALoginName);
end;

function TGroupService.IsTeamManager(ATeamID, ALoginName: string): Boolean;
var
  iIndex: Integer;
  ATempTeam: TRealICQTeam;
begin
  iIndex := FTeams.IndexOf(ATeamID);
  ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  if (AnsiPos(Chr(10) + ALoginName + Chr(10), Chr(10) + ATempTeam.TeamManagers + Chr(10)) > 0) or (AnsiSameText(ALoginName, ATempTeam.TeamCreater)) then
    Result := True
  else
    Result := False;
end;

procedure TGroupService.JoinTeam(ATeamID, ATag: string);
begin
  FGroupClient.JoinTeam(ATeamID, ATag);
end;

procedure TGroupService.JoinTeamResponse(ATeamID, ALoginName, ATag: string; Accepted: Boolean);
begin
  FGroupClient.JoinTeamResponse(ATeamID, ALoginName, ATag, Accepted);
end;

procedure TGroupService.OnAddedManagers(ATeamID: string; AManagers: TStrings);
var
  iLoop, iIndex: Integer;
  ATempTeam: TRealICQTeam;
begin
  iIndex := FTeams.IndexOf(ATeamID);
  if iIndex < 0 then
    Exit;
  ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  ATempTeam.TeamManagers := AddMembers(ATempTeam.TeamManagers, AManagers);
  MainForm.WebSocketSendReadTeamInfo(ATempTeam.TeamID);
end;

procedure TGroupService.OnAddedMembers(ATeamID: string; AMembers: TStrings);
var
  iLoop, iIndex: Integer;
  ATempTeam: TRealICQTeam;
begin
  iIndex := FTeams.IndexOf(ATeamID);
  if iIndex < 0 then
  begin
    FGroupClient.AsynTeam(ATeamID);
    Exit;
  end;
  ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  ATempTeam.TeamMembers := AddMembers(ATempTeam.TeamMembers, AMembers);
  MainForm.WebSocketSendReadTeamInfo(ATempTeam.TeamID);
end;

procedure TGroupService.OnAddedTeam(ATeam: TRealICQTeam; ts: Int64);
var
  iIndex: Integer;
  ATempTeam: TObject;
  LastMessageTime: TDateTime;
  LastMessageTimeTs: Int64;
begin
  iIndex := FTeams.IndexOf(ATeam.TeamID);
  if iIndex > -1 then
  begin
    ATempTeam := FTeams.Objects[iIndex];
    if ATempTeam <> nil then
      FreeAndNil(ATempTeam);
    FTeams.Delete(iIndex);
  end;
  FTeams.AddObject(ATeam.TeamID, ATeam.Clone);
  MainForm.WebSocketSendReadTeamInfo(ATeam.TeamID);
  LastMessageTime := MainForm.DBHistory.GetLastMessageTimeByTeamID(ATeam.TeamID);
  if (LastMessageTime = 0) and (ts <= 0) then
    Exit
  else if (LastMessageTime = 0) and (ts > 0) then
    FGroupClient.GetHistoryMessages(ATeam.TeamID, ts)
  else
  begin
    LastMessageTimeTs :=(DateTimeToUnix(LastMessageTime) - 8*60*60) * 1000;
    FGroupClient.GetHistoryMessages(ATeam.TeamID, LastMessageTimeTs);
  end;
  
end;

procedure TGroupService.OnDeletedManagers(ATeamID: string; AManagers: TStrings);
var
  iLoop, iIndex: Integer;
  ATempTeam: TRealICQTeam;
begin
  iIndex := FTeams.IndexOf(ATeamID);
  if iIndex < 0 then
    Exit;
  ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  ATempTeam.TeamManagers := RemoveMembers(ATempTeam.TeamManagers, AManagers);
  MainForm.WebSocketSendReadTeamInfo(ATempTeam.TeamID);
end;

procedure TGroupService.OnDeletedMembers(ATeamID: string; AMembers: TStrings);
var
  iLoop, iIndex: Integer;
  ATempTeam: TRealICQTeam;
begin
  iIndex := FTeams.IndexOf(ATeamID);
  if iIndex < 0 then
    Exit;
  for iLoop := 0 to AMembers.Count - 1 do
    if SameText(FLoginName, AMembers[iLoop]) then
    begin
      MainForm.WebSocketQuitTeam(ATeamID);
      ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
      if ATempTeam <> nil then
        FreeAndNil(ATempTeam);
      FTeams.Delete(iIndex);
      Exit;
    end;
  ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  ATempTeam.TeamMembers := RemoveMembers(ATempTeam.TeamMembers, AMembers);
  ATempTeam.TeamManagers := RemoveMembers(ATempTeam.TeamManagers, AMembers);
  MainForm.WebSocketSendReadTeamInfo(ATempTeam.TeamID);
end;

procedure TGroupService.OnDeletedTeam(ATeamID: string);
var
  iIndex: Integer;
begin
  iIndex := FTeams.IndexOf(ATeamID);
  if iIndex >= 0 then
  begin
    MainForm.WebSocketRemoveTeamResponse(ATeamID);
    FTeams.Delete(iIndex);
  end;
end;

procedure TGroupService.OnMessage(ATeamID, ASender, AContent, AStyle: string; ASendTime: TDateTime; AMSGType: Integer; ALength: Integer);
const
  AParam: string = '?center=%s&marker=%s&lat=%s&lng=%s';
var
  tmpStrs: TStrings;
begin
  if AMSGType = 2 then
    MainForm.WebSocketRecivedbroadcastmesssage('', ATeamID, ASender, AStyle, '[image-src="' + AContent + '"]', ASendTime)
  else if AMSGType = 3 then
    MainForm.RealICQClientReceivedOfflineFile(nil, ASender, AContent, ALength, ASendTime)
  else if AMSGType = 4 then
//    MainForm.WebSocketRecivedbroadcastmesssage('', ATeamID, ASender, AStyle, '', ASendTime)


  else if AMSGType = 5 then
  begin
    tmpStrs := TRealICQUtility.SplitString(AContent, ':');
    try

      AContent := '[map-src="' + (TConditionConfig.GetConfig.MapHost + Format(AParam, [HTTPEncode(UTF8Encode(tmpStrs[0])), HTTPEncode(UTF8Encode(tmpStrs[1])), tmpStrs[2], tmpStrs[3]])) + '"]';
      MainForm.WebSocketRecivedbroadcastmesssage('', ATeamID, ASender, AStyle, AContent, ASendTime)
    finally
      tmpStrs.Free;
    end;
  end
  else
    MainForm.WebSocketRecivedbroadcastmesssage('', ATeamID, ASender, AStyle, AContent, ASendTime);
end;

procedure TGroupService.OnMessageReaded(ATeamID: string; ts: Int64);
var
  AList: TList;
  i: Integer;
begin
  i := MainForm.NotReadMessages.IndexOf(MainFrm.TeamMessageID + ATeamID);
  if i > -1 then
  begin
    AList := MainForm.NotReadMessages.Objects[i] as TList;
    MainForm.NotReadMessages.Delete(i);
    TRealICQUtility.FreeList(AList);
    MainForm.StopHeadImageFlash(ATeamID);
  end;
end;

procedure TGroupService.OnReceivedApplyBoardcast(ATeamID, ALoginName, ATag: string);
begin
  MainForm.WebSocketJionTeamRequest(ATeamID, ALoginName, ATag);
end;

procedure TGroupService.OnReceivedReplyBoardcast(ATeamID, ALoginName, ATag: string; ARet: Integer);
var
  iIndex: Integer;
  ATempTeam: TRealICQTeam;
begin
  if SameText(ALoginName, FLoginName) then
    case ARet of
      0:
        begin
          MainForm.RealICQClientJoinTeamResponse(nil, ATeamID, '管理员', ATag, False);
        end;
      1:
        begin
          FGroupClient.AsynTeam(ATeamID);
          MainForm.RealICQClientJoinTeamResponse(nil, ATeamID, '管理员', ATag, True);
        end;
      5:
        begin
          MessageBox(SearchTeamForm.Handle, PChar('申请加入的群组不允许任何人加入！！！'), '提示', MB_ICONINFORMATION);
        end;
    end
  else
  begin
    if ARet = 1 then
    begin
      iIndex := FTeams.IndexOf(ATeamID);
      if iIndex < 0 then
        Exit;
      ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
      ATempTeam.TeamMembers := AddMember(ATempTeam.TeamMembers, ALoginName);
      MainForm.WebSocketSendReadTeamInfo(ATempTeam.TeamID);
    end;
  end;
end;

procedure TGroupService.OnSearched(ARecords: TStringList; ASkip, ALimit: Integer);
begin
  SearchTeamForm.ShowTeamSearchResult(ARecords);
end;

procedure TGroupService.OnTeamInfoChange(ATeam: TRealICQTeam);
var
  iIndex: Integer;
  ATempTeam: TRealICQTeam;
begin
  iIndex := FTeams.IndexOf(ATeam.TeamID);
  if iIndex > -1 then
  begin
    ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
    if ATempTeam = nil then
      Exit;
    ATempTeam.TeamCaption := ATeam.TeamCaption;
    ATempTeam.TeamIntro := ATeam.TeamIntro;
    ATempTeam.TeamCallBoard := ATeam.TeamCallBoard;
    ATempTeam.TeamValidate := ATeam.TeamValidate;

    MainForm.WebSocketSendReadTeamInfo(ATeam.TeamID);
  end;
end;

procedure TGroupService.OnUploaded(ADownloadURL, AFileName: string);
begin
  FDownFile.OnComplete := DownFaceFileComplete;
  FDownFile.ThreadDownFile(ADownloadURL, TRealICQClient.GetReceivedFaceDir + AFileName);
end;

procedure TGroupService.DownFaceFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
begin
  if not blStatus then
  begin
    Error(ErrMessage, '下载群图片');
    Exit;
  end;
  ShowGettedFace(Dest_file);
end;

procedure TGroupService.QuitTeam(ATeamID: string);
var
  AMembers: TStringList;
begin
  AMembers := TStringList.Create;
  try
    AMembers.Add(FLoginName);
    FGroupClient.RemoveTeamMembers(ATeamID, AMembers, nil);
  finally
    AMembers.Free;
  end;
end;

function TGroupService.RemoveManager(ATeamID, ALoginName: string): Boolean;
var
  AManagers: TStringList;
begin
  if Trim(ALoginName) = '' then
    Exit;
  AManagers := TStringList.Create;
  try
    AManagers.Add(ALoginName);
    FGroupClient.RemoveTeamMembers(ATeamID, nil, AManagers);
  finally
    AManagers.Free;
  end;
//  FGroupClient.RemoveManager();


end;

function TGroupService.RemoveMembers(AMembers: string; ARemoveMembers: TStrings): string;
var
  iLoop, iIndex: Integer;
  AMemberList: TStrings;
begin
  iLoop := 0;
  Result := '';
  AMemberList := SplitString(AMembers, Chr(10));
  try
    for iLoop := AMemberList.Count - 1 downto 0 do
    begin
      if Length(Trim(AMemberList[iLoop])) = 0 then
        AMemberList.Delete(iLoop);
    end;

    for iLoop := 0 to ARemoveMembers.Count - 1 do
    begin
      iIndex := AMemberList.IndexOf(ARemoveMembers[iLoop]);
      if iIndex > -1 then
        AMemberList.Delete(iIndex);
    end;

    iLoop := 0;
    while iLoop < AMemberList.Count - 1 do
    begin
      Result := Result + AMemberList[iLoop] + Chr(10);
      Inc(iLoop);
    end;
    Result := Result + AMemberList[iLoop]
  finally
    AMemberList.Free;
  end;
end;

procedure TGroupService.SearchTeam(AKey: string; ASearchType: TRealICQTeamSearchType; AMatchingType: TRealICQMatchingType; APage: Integer);
begin
  case ASearchType of
    tsByTeamID:
      FGroupClient.SearchTeam(AKey, '', '', '', AMatchingType, 0, 500);
    tsByTeamCaption:
      FGroupClient.SearchTeam('', AKey, '', '', AMatchingType, 0, 500);
    tsByTeamIntro:
      FGroupClient.SearchTeam('', '', AKey, '', AMatchingType, 0, 500);
//    tsByTeamCreater: FGroupClient.SearchTeam('', '', '', '', 0, 500);


  end;
end;

procedure TGroupService.SendTeamMessage(ATeamID, ASender, AMsg: string; AFont: TFont; AFaces: TStringList; Attachs: string);
begin
  FGroupClient.SendTeamMessage(ATeamID, ASender, AMsg, AFont, AFaces, Attachs);
end;

procedure TGroupService.SetAlias(ATeamID, ALoginName, Alias: string);
begin

end;

procedure TGroupService.Uninstall;
var
  iIndex: Integer;
  ATeam: TRealICQTeam;
begin
  ATeam := nil;
  for iIndex := 0 to FTeams.Count - 1 do
  begin
    ATeam := FTeams.Objects[iIndex] as TRealICQTeam;
//    FGroupClient.MessageMiscMust(ATeam.TeamID);
  end;
  FGroupClient.Disconnect;
end;

procedure TGroupService.MessageMiscMust(ATeamID: string);
begin
  FGroupClient.MessageMiscMust(ATeamID);
end;

procedure TGroupService.UpdateTeam(ATeamID, AIntro, ANotice, AName: string; AAuth: Integer);
begin
  FGroupClient.UpdateTeamInfo(ATeamID, AIntro, ANotice, AName, AAuth);
end;

procedure TGroupService.UpdateTeamMembers(ATeamID: string; AOldMembers, ANewMembers: TStringList);
var
  iLoop: Integer;
  ATeamAddMembers, ATeamRemoveMembers: TStringList;
  MemberListChanged: Boolean;
begin
  ATeamAddMembers := TStringList.Create;
  ATeamRemoveMembers := TStringList.Create;
  MemberListChanged := False;
  for iLoop := 0 to ANewMembers.Count - 1 do
  begin
    if AOldMembers.IndexOf(ANewMembers[iLoop]) = -1 then
    begin
      MemberListChanged := True;
      ATeamAddMembers.Add(ANewMembers[iLoop]);
    end;
  end;
  if MemberListChanged then
    AddTeamMembers(ATeamID, ATeamAddMembers);

  MemberListChanged := False;
  for iLoop := 0 to AOldMembers.Count - 1 do
  begin
    if Length(Trim(AOldMembers[iLoop])) = 0 then
      Continue;
    if ANewMembers.IndexOf(AOldMembers[iLoop]) = -1 then
    begin
      MemberListChanged := True;
      ATeamRemoveMembers.Add(AOldMembers[iLoop]);
    end;
  end;
  if MemberListChanged then
    RemoveTeamMembers(ATeamID, ATeamRemoveMembers);
  ATeamAddMembers.Free;
  ATeamRemoveMembers.Free;
end;

end.