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; procedure SetTeams(const Value: TStringList); 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 HandOverTeam(ATeamID, ALoginName: string); 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 IsTeamCreater(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; NeedLoadHistory: Boolean = false); 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); property Teams: TStringList read FTeams write SetTeams; end; {$INCLUDE LXTalk.inc} implementation uses MainFrm, SearchTeamFrm, RealICQUtils, ShareUtils, RealICQClient, LoggerImport, RealICQUtility, ConditionConfig, IdURI, IdHTTP, HTTPApp, IdTStrings, Dialogs; 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); FGroupClient.CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro, ATeamMembers, AIsTempTeam, ATeamValidateType); 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; procedure TGroupService.HandOverTeam(ATeamID, ALoginName: string); var iIndex: Integer; ATempTeam: TRealICQTeam; begin iIndex := FTeams.IndexOf(ATeamID); if iIndex < 0 then Exit; ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam; FGroupClient.UpdateTeamCreator(ATeamID, ATempTeam.TeamIntro, ATempTeam.TeamCallBoard, ATempTeam.TeamCaption, Integer(ATempTeam.TeamValidate), ALoginName); if not IsTeamManager(ATeamID, ALoginName) then AddManager(ATeamID, ALoginName); end; function TGroupService.IsTeamCreater(ATeamID, ALoginName: string): Boolean; var iIndex: Integer; ATempTeam: TRealICQTeam; begin Result := False; iIndex := FTeams.IndexOf(ATeamID); if iIndex < 0 then Exit; ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam; Result := AnsiSameText(ALoginName, ATempTeam.TeamCreater); 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; NeedLoadHistory: Boolean); 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); if not NeedLoadHistory then Exit; {$IFNDEF OldGroup} LastMessageTime := MainForm.DBHistory.GetLastMessageTimeByTeamID(ATeam.TeamID); if (LastMessageTime = 0) and (ts <= 0) then Exit else if (ts > LastMessageTime) then FGroupClient.GetHistoryMessages(ATeam.TeamID, ts) else begin LastMessageTimeTs := (DateTimeToUnix(LastMessageTime) - 8 * 60 * 60) * 1000; FGroupClient.GetHistoryMessages(ATeam.TeamID, LastMessageTimeTs); end; {$ENDIF} 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'; //ARM_2_MP3_URL: string = 'http://120.26.126.129:3001/api/amr2mp3'; BODY: string = '{"data":"%s"}'; var tmpStrs: TIdStringList; str: string; h: TIdHTTP; jo: ISuperObject; begin //Error(ARM_2_MP3_URL, 'TGroupService.OnMessage'); 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 begin h := TIdHTTP.Create(nil); try tmpStrs := TIdStringList.Create; str := Format(BODY, [AContent]); tmpStrs.Add(str); h.Request.ContentType := 'application/json'; AContent := h.Post(TConditionConfig.GetConfig.Arm2Mp3Host, tmpStrs); jo := SO(AContent); if (jo <> nil) and (jo.I['ret'] = 1) then MainForm.WebSocketRecivedbroadcastmesssage('', ATeamID, ASender, AStyle, '[voice-src="' + jo.S['url'] + '"]', ASendTime); tmpStrs.Free; except on e: Exception do begin Error(e.Message, 'arm to mp3'); tmpStrs.Free; end; end; end 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 MainForm.WebSocketSendReadTeamInfo(ATeam.TeamID); 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.SetTeams(const Value: TStringList); begin FTeams := Value; 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; {$IFDEF OldGroup} FGroupClient.MessageMiscMust(ATeam.TeamID); {$ENDIF} 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.