| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679 |
- 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.
|