GroupService.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679
  1. unit GroupService;
  2. interface
  3. uses
  4. StrUtils, SysUtils, Windows, superobject, Classes, GroupClient, RealICQModel,
  5. xFonts, Graphics, DownloadFileFromWeb, DateUtils;
  6. type
  7. TGroupService = class
  8. private
  9. FTeams: TStringList;
  10. FLoginName: string;
  11. FGroupClient: TGroupClient;
  12. FDownFile: TDownFile;
  13. function RemoveMembers(AMembers: string; ARemoveMembers: TStrings): string;
  14. function AddMembers(AMembers: string; ANewMembers: TStrings): string;
  15. procedure DownFaceFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
  16. function AddMember(AMembers, ANewMember: string): string;
  17. procedure SetTeams(const Value: TStringList);
  18. public
  19. procedure Init(ALoginName: string);
  20. procedure Uninstall;
  21. class function GetService: TGroupService; static;
  22. constructor Create;
  23. destructor Destroy; override;
  24. { TODO -olqq -c : 群组请求 2015/6/8 11:09:05 }
  25. procedure QuitTeam(ATeamID: string);
  26. procedure DisbandTeam(ATeamID: string);
  27. procedure UpdateTeam(ATeamID, AIntro, ANotice, AName: string; AAuth: Integer);
  28. procedure HandOverTeam(ATeamID, ALoginName: string);
  29. procedure CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: string; ATeamMembers: TStringList; AIsTempTeam: Boolean; ATeamValidateType: TRealICQTeamValidateType);
  30. procedure SearchTeam(AKey: string; ASearchType: TRealICQTeamSearchType; AMatchingType: TRealICQMatchingType; APage: Integer);
  31. procedure AddTeamMembers(ATeamID: string; AAddMembers: TStringList);
  32. procedure RemoveTeamMembers(ATeamID: string; ARemoveMembers: TStringList);
  33. procedure UpdateTeamMembers(ATeamID: string; AOldMembers, ANewMembers: TStringList);
  34. function RemoveManager(ATeamID, ALoginName: string): Boolean;
  35. function AddManager(ATeamID, ALoginName: string): Boolean;
  36. procedure SetAlias(ATeamID, ALoginName, Alias: string);
  37. function GetAlias(ATeamID, ALoginName: string): string;
  38. procedure JoinTeam(ATeamID, ATag: string);
  39. procedure JoinTeamResponse(ATeamID, ALoginName, ATag: string; Accepted: Boolean);
  40. procedure SendTeamMessage(ATeamID, ASender, AMsg: string; AFont: TFont; AFaces: TStringList; Attachs: string);
  41. function IsTeamManager(ATeamID, ALoginName: string): Boolean;
  42. function IsTeamCreater(ATeamID, ALoginName: string): Boolean;
  43. function GetTeam(ATeamID: string): TRealICQTeam;
  44. function GetTeams: TStringList;
  45. procedure MessageMiscMust(ATeamID: string);
  46. { TODO -olqq -c : 群组信息反馈 2015/6/8 11:08:43 }
  47. procedure OnMessageReaded(ATeamID: string; ts: Int64);
  48. procedure OnAddedTeam(ATeam: TRealICQTeam; ts: Int64 = 0; NeedLoadHistory: Boolean = false);
  49. procedure OnDeletedTeam(ATeamID: string);
  50. procedure OnTeamInfoChange(ATeam: TRealICQTeam);
  51. procedure OnSearched(ARecords: TStringList; ASkip, ALimit: Integer); overload;
  52. procedure OnAddedMembers(ATeamID: string; AMembers: TStrings);
  53. procedure OnAddedManagers(ATeamID: string; AManagers: TStrings);
  54. procedure OnDeletedMembers(ATeamID: string; AMembers: TStrings);
  55. procedure OnDeletedManagers(ATeamID: string; AManagers: TStrings);
  56. procedure OnReceivedApplyBoardcast(ATeamID, ALoginName, ATag: string);
  57. procedure OnReceivedReplyBoardcast(ATeamID, ALoginName, ATag: string; ARet: Integer);
  58. procedure OnMessage(ATeamID, ASender, AContent, AStyle: string; ASendTime: TDateTime; AMSGType, ALength: Integer);
  59. procedure OnUploaded(ADownloadURL, AFileName: string);
  60. property Teams: TStringList read FTeams write SetTeams;
  61. end;
  62. {$INCLUDE LXTalk.inc}
  63. implementation
  64. uses
  65. MainFrm, SearchTeamFrm, RealICQUtils, ShareUtils, RealICQClient, LoggerImport,
  66. RealICQUtility, ConditionConfig, IdURI, IdHTTP, HTTPApp, IdTStrings, Dialogs;
  67. var
  68. AGroupService: TGroupService;
  69. procedure ClearStringList(AStringList: TStringList);
  70. var
  71. AObj: TObject;
  72. begin
  73. if AStringList = nil then
  74. Exit;
  75. while AStringList.Count > 0 do
  76. begin
  77. Aobj := AStringList.Objects[0];
  78. AStringList.Delete(0);
  79. FreeAndNil(AObj);
  80. end;
  81. end;
  82. { TGroupService }
  83. function TGroupService.AddManager(ATeamID, ALoginName: string): Boolean;
  84. var
  85. AManagers: TStringList;
  86. begin
  87. if Trim(ALoginName) = '' then
  88. Exit;
  89. AManagers := TStringList.Create;
  90. try
  91. AManagers.Add(ALoginName);
  92. FGroupClient.AddTeamMembers(ATeamID, nil, AManagers);
  93. finally
  94. AManagers.Free;
  95. end;
  96. end;
  97. function TGroupService.AddMembers(AMembers: string; ANewMembers: TStrings): string;
  98. var
  99. iLoop: Integer;
  100. AMemberList: TStrings;
  101. begin
  102. iLoop := 0;
  103. Result := '';
  104. AMemberList := SplitString(AMembers, Chr(10));
  105. try
  106. for iLoop := AMemberList.Count - 1 downto 0 do
  107. begin
  108. if Length(Trim(AMemberList[iLoop])) = 0 then
  109. AMemberList.Delete(iLoop);
  110. end;
  111. for iLoop := 0 to ANewMembers.Count - 1 do
  112. if AMemberList.IndexOf(ANewMembers[iLoop]) < 0 then
  113. AMemberList.Add(ANewMembers[iLoop]);
  114. iLoop := 0;
  115. while iLoop < AMemberList.Count - 1 do
  116. begin
  117. Result := Result + AMemberList[iLoop] + Chr(10);
  118. Inc(iLoop);
  119. end;
  120. Result := Result + AMemberList[iLoop]
  121. finally
  122. AMemberList.Free;
  123. end;
  124. end;
  125. function TGroupService.AddMember(AMembers: string; ANewMember: string): string;
  126. begin
  127. Result := AMembers;
  128. if Pos(ANewMember, AMembers) > 0 then
  129. Exit;
  130. Result := AMembers + Chr(10) + ANewMember;
  131. end;
  132. procedure TGroupService.AddTeamMembers(ATeamID: string; AAddMembers: TStringList);
  133. begin
  134. FGroupClient.AddTeamMembers(ATeamID, AAddMembers, nil);
  135. end;
  136. constructor TGroupService.Create;
  137. begin
  138. FTeams := TStringList.Create;
  139. FGroupClient := TGroupClient.Create;
  140. FDownFile := TDownFile.Create;
  141. inherited;
  142. end;
  143. procedure TGroupService.CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: string; ATeamMembers: TStringList; AIsTempTeam: Boolean; ATeamValidateType: TRealICQTeamValidateType);
  144. begin
  145. //FGroupClient.CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro, ATeamMembers, AIsTempTeam);
  146. FGroupClient.CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro, ATeamMembers, AIsTempTeam, ATeamValidateType);
  147. end;
  148. procedure TGroupService.RemoveTeamMembers(ATeamID: string; ARemoveMembers: TStringList);
  149. begin
  150. FGroupClient.RemoveTeamMembers(ATeamID, ARemoveMembers, nil);
  151. end;
  152. destructor TGroupService.Destroy;
  153. begin
  154. ClearStringList(FTeams);
  155. FreeAndNil(FGroupClient);
  156. FreeAndNil(FDownFile);
  157. inherited;
  158. end;
  159. procedure TGroupService.DisbandTeam(ATeamID: string);
  160. begin
  161. FGroupClient.RemoveTeam(ATeamID);
  162. end;
  163. function TGroupService.GetAlias(ATeamID, ALoginName: string): string;
  164. begin
  165. end;
  166. class function TGroupService.GetService: TGroupService;
  167. begin
  168. if AGroupService = nil then
  169. AGroupService := TGroupService.Create;
  170. Result := AGroupService;
  171. end;
  172. function TGroupService.GetTeam(ATeamID: string): TRealICQTeam;
  173. var
  174. iIndex: Integer;
  175. ATeam: TRealICQTeam;
  176. begin
  177. ATeam := nil;
  178. iIndex := FTeams.IndexOf(ATeamID);
  179. if iIndex > -1 then
  180. ATeam := FTeams.Objects[iIndex] as TRealICQTeam;
  181. Result := ATeam;
  182. end;
  183. function TGroupService.GetTeams: TStringList;
  184. begin
  185. Result := FTeams;
  186. end;
  187. procedure TGroupService.Init(ALoginName: string);
  188. begin
  189. FLoginName := ALoginName;
  190. FGroupClient.Connect(ALoginName);
  191. end;
  192. procedure TGroupService.HandOverTeam(ATeamID, ALoginName: string);
  193. var
  194. iIndex: Integer;
  195. ATempTeam: TRealICQTeam;
  196. begin
  197. iIndex := FTeams.IndexOf(ATeamID);
  198. if iIndex < 0 then
  199. Exit;
  200. ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  201. FGroupClient.UpdateTeamCreator(ATeamID, ATempTeam.TeamIntro, ATempTeam.TeamCallBoard, ATempTeam.TeamCaption, Integer(ATempTeam.TeamValidate), ALoginName);
  202. if not IsTeamManager(ATeamID, ALoginName) then
  203. AddManager(ATeamID, ALoginName);
  204. end;
  205. function TGroupService.IsTeamCreater(ATeamID, ALoginName: string): Boolean;
  206. var
  207. iIndex: Integer;
  208. ATempTeam: TRealICQTeam;
  209. begin
  210. Result := False;
  211. iIndex := FTeams.IndexOf(ATeamID);
  212. if iIndex < 0 then
  213. Exit;
  214. ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  215. Result := AnsiSameText(ALoginName, ATempTeam.TeamCreater);
  216. end;
  217. function TGroupService.IsTeamManager(ATeamID, ALoginName: string): Boolean;
  218. var
  219. iIndex: Integer;
  220. ATempTeam: TRealICQTeam;
  221. begin
  222. iIndex := FTeams.IndexOf(ATeamID);
  223. ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  224. if (AnsiPos(Chr(10) + ALoginName + Chr(10), Chr(10) + ATempTeam.TeamManagers + Chr(10)) > 0) or (AnsiSameText(ALoginName, ATempTeam.TeamCreater)) then
  225. Result := True
  226. else
  227. Result := False;
  228. end;
  229. procedure TGroupService.JoinTeam(ATeamID, ATag: string);
  230. begin
  231. FGroupClient.JoinTeam(ATeamID, ATag);
  232. end;
  233. procedure TGroupService.JoinTeamResponse(ATeamID, ALoginName, ATag: string; Accepted: Boolean);
  234. begin
  235. FGroupClient.JoinTeamResponse(ATeamID, ALoginName, ATag, Accepted);
  236. end;
  237. procedure TGroupService.OnAddedManagers(ATeamID: string; AManagers: TStrings);
  238. var
  239. iLoop, iIndex: Integer;
  240. ATempTeam: TRealICQTeam;
  241. begin
  242. iIndex := FTeams.IndexOf(ATeamID);
  243. if iIndex < 0 then
  244. Exit;
  245. ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  246. ATempTeam.TeamManagers := AddMembers(ATempTeam.TeamManagers, AManagers);
  247. MainForm.WebSocketSendReadTeamInfo(ATempTeam.TeamID);
  248. end;
  249. procedure TGroupService.OnAddedMembers(ATeamID: string; AMembers: TStrings);
  250. var
  251. iLoop, iIndex: Integer;
  252. ATempTeam: TRealICQTeam;
  253. begin
  254. iIndex := FTeams.IndexOf(ATeamID);
  255. if iIndex < 0 then
  256. begin
  257. FGroupClient.AsynTeam(ATeamID);
  258. Exit;
  259. end;
  260. ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  261. ATempTeam.TeamMembers := AddMembers(ATempTeam.TeamMembers, AMembers);
  262. MainForm.WebSocketSendReadTeamInfo(ATempTeam.TeamID);
  263. end;
  264. procedure TGroupService.OnAddedTeam(ATeam: TRealICQTeam; ts: Int64; NeedLoadHistory: Boolean);
  265. var
  266. iIndex: Integer;
  267. ATempTeam: TObject;
  268. LastMessageTime: TDateTime;
  269. LastMessageTimeTs: Int64;
  270. begin
  271. iIndex := FTeams.IndexOf(ATeam.TeamID);
  272. if iIndex > -1 then
  273. begin
  274. ATempTeam := FTeams.Objects[iIndex];
  275. if ATempTeam <> nil then
  276. FreeAndNil(ATempTeam);
  277. FTeams.Delete(iIndex);
  278. end;
  279. FTeams.AddObject(ATeam.TeamID, ATeam.Clone);
  280. MainForm.WebSocketSendReadTeamInfo(ATeam.TeamID);
  281. if not NeedLoadHistory then
  282. Exit;
  283. {$IFNDEF OldGroup}
  284. LastMessageTime := MainForm.DBHistory.GetLastMessageTimeByTeamID(ATeam.TeamID);
  285. if (LastMessageTime = 0) and (ts <= 0) then
  286. Exit
  287. else if (ts > LastMessageTime) then
  288. FGroupClient.GetHistoryMessages(ATeam.TeamID, ts)
  289. else
  290. begin
  291. LastMessageTimeTs := (DateTimeToUnix(LastMessageTime) - 8 * 60 * 60) * 1000;
  292. FGroupClient.GetHistoryMessages(ATeam.TeamID, LastMessageTimeTs);
  293. end;
  294. {$ENDIF}
  295. end;
  296. procedure TGroupService.OnDeletedManagers(ATeamID: string; AManagers: TStrings);
  297. var
  298. iLoop, iIndex: Integer;
  299. ATempTeam: TRealICQTeam;
  300. begin
  301. iIndex := FTeams.IndexOf(ATeamID);
  302. if iIndex < 0 then
  303. Exit;
  304. ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  305. ATempTeam.TeamManagers := RemoveMembers(ATempTeam.TeamManagers, AManagers);
  306. MainForm.WebSocketSendReadTeamInfo(ATempTeam.TeamID);
  307. end;
  308. procedure TGroupService.OnDeletedMembers(ATeamID: string; AMembers: TStrings);
  309. var
  310. iLoop, iIndex: Integer;
  311. ATempTeam: TRealICQTeam;
  312. begin
  313. iIndex := FTeams.IndexOf(ATeamID);
  314. if iIndex < 0 then
  315. Exit;
  316. for iLoop := 0 to AMembers.Count - 1 do
  317. if SameText(FLoginName, AMembers[iLoop]) then
  318. begin
  319. MainForm.WebSocketQuitTeam(ATeamID);
  320. ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  321. if ATempTeam <> nil then
  322. FreeAndNil(ATempTeam);
  323. FTeams.Delete(iIndex);
  324. Exit;
  325. end;
  326. ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  327. ATempTeam.TeamMembers := RemoveMembers(ATempTeam.TeamMembers, AMembers);
  328. ATempTeam.TeamManagers := RemoveMembers(ATempTeam.TeamManagers, AMembers);
  329. MainForm.WebSocketSendReadTeamInfo(ATempTeam.TeamID);
  330. end;
  331. procedure TGroupService.OnDeletedTeam(ATeamID: string);
  332. var
  333. iIndex: Integer;
  334. begin
  335. iIndex := FTeams.IndexOf(ATeamID);
  336. if iIndex >= 0 then
  337. begin
  338. MainForm.WebSocketRemoveTeamResponse(ATeamID);
  339. FTeams.Delete(iIndex);
  340. end;
  341. end;
  342. procedure TGroupService.OnMessage(ATeamID, ASender, AContent, AStyle: string; ASendTime: TDateTime; AMSGType: Integer; ALength: Integer);
  343. const
  344. AParam: string = '?center=%s&marker=%s&lat=%s&lng=%s';
  345. //ARM_2_MP3_URL: string = 'http://120.26.126.129:3001/api/amr2mp3';
  346. BODY: string = '{"data":"%s"}';
  347. var
  348. tmpStrs: TIdStringList;
  349. str: string;
  350. h: TIdHTTP;
  351. jo: ISuperObject;
  352. begin
  353. //Error(ARM_2_MP3_URL, 'TGroupService.OnMessage');
  354. if AMSGType = 2 then
  355. MainForm.WebSocketRecivedbroadcastmesssage('', ATeamID, ASender, AStyle, '[image-src="' + AContent + '"]', ASendTime)
  356. else if AMSGType = 3 then
  357. MainForm.RealICQClientReceivedOfflineFile(nil, ASender, AContent, ALength, ASendTime)
  358. else if AMSGType = 4 then
  359. begin
  360. h := TIdHTTP.Create(nil);
  361. try
  362. tmpStrs := TIdStringList.Create;
  363. str := Format(BODY, [AContent]);
  364. tmpStrs.Add(str);
  365. h.Request.ContentType := 'application/json';
  366. AContent := h.Post(TConditionConfig.GetConfig.Arm2Mp3Host, tmpStrs);
  367. jo := SO(AContent);
  368. if (jo <> nil) and (jo.I['ret'] = 1) then
  369. MainForm.WebSocketRecivedbroadcastmesssage('', ATeamID, ASender, AStyle, '[voice-src="' + jo.S['url'] + '"]', ASendTime);
  370. tmpStrs.Free;
  371. except
  372. on e: Exception do
  373. begin
  374. Error(e.Message, 'arm to mp3');
  375. tmpStrs.Free;
  376. end;
  377. end;
  378. end
  379. else if AMSGType = 5 then
  380. begin
  381. tmpStrs := TRealICQUtility.SplitString(AContent, ':');
  382. try
  383. AContent := '[map-src="' + (TConditionConfig.GetConfig.MapHost + Format(AParam, [HTTPEncode(UTF8Encode(tmpStrs[0])), HTTPEncode(UTF8Encode(tmpStrs[1])), tmpStrs[2], tmpStrs[3]])) + '"]';
  384. MainForm.WebSocketRecivedbroadcastmesssage('', ATeamID, ASender, AStyle, AContent, ASendTime)
  385. finally
  386. tmpStrs.Free;
  387. end;
  388. end
  389. else
  390. MainForm.WebSocketRecivedbroadcastmesssage('', ATeamID, ASender, AStyle, AContent, ASendTime);
  391. end;
  392. procedure TGroupService.OnMessageReaded(ATeamID: string; ts: Int64);
  393. var
  394. AList: TList;
  395. i: Integer;
  396. begin
  397. i := MainForm.NotReadMessages.IndexOf(MainFrm.TeamMessageID + ATeamID);
  398. if i > -1 then
  399. begin
  400. AList := MainForm.NotReadMessages.Objects[i] as TList;
  401. MainForm.NotReadMessages.Delete(i);
  402. TRealICQUtility.FreeList(AList);
  403. MainForm.StopHeadImageFlash(ATeamID);
  404. end;
  405. end;
  406. procedure TGroupService.OnReceivedApplyBoardcast(ATeamID, ALoginName, ATag: string);
  407. begin
  408. MainForm.WebSocketJionTeamRequest(ATeamID, ALoginName, ATag);
  409. end;
  410. procedure TGroupService.OnReceivedReplyBoardcast(ATeamID, ALoginName, ATag: string; ARet: Integer);
  411. var
  412. iIndex: Integer;
  413. ATempTeam: TRealICQTeam;
  414. begin
  415. if SameText(ALoginName, FLoginName) then
  416. case ARet of
  417. 0:
  418. begin
  419. MainForm.RealICQClientJoinTeamResponse(nil, ATeamID, '管理员', ATag, False);
  420. end;
  421. 1:
  422. begin
  423. FGroupClient.AsynTeam(ATeamID);
  424. MainForm.RealICQClientJoinTeamResponse(nil, ATeamID, '管理员', ATag, True);
  425. end;
  426. 5:
  427. begin
  428. MessageBox(SearchTeamForm.Handle, PChar('群组不允许任何人加入!!!'), '提示', MB_ICONINFORMATION);
  429. end;
  430. end
  431. else
  432. begin
  433. if ARet = 1 then
  434. begin
  435. iIndex := FTeams.IndexOf(ATeamID);
  436. if iIndex < 0 then
  437. Exit;
  438. ATempTeam := FTeams.Objects[iIndex] as TRealICQTeam;
  439. ATempTeam.TeamMembers := AddMember(ATempTeam.TeamMembers, ALoginName);
  440. MainForm.WebSocketSendReadTeamInfo(ATempTeam.TeamID);
  441. end;
  442. end;
  443. end;
  444. procedure TGroupService.OnSearched(ARecords: TStringList; ASkip, ALimit: Integer);
  445. begin
  446. SearchTeamForm.ShowTeamSearchResult(ARecords);
  447. end;
  448. procedure TGroupService.OnTeamInfoChange(ATeam: TRealICQTeam);
  449. var
  450. iIndex: Integer;
  451. ATempTeam: TRealICQTeam;
  452. begin
  453. MainForm.WebSocketSendReadTeamInfo(ATeam.TeamID);
  454. end;
  455. procedure TGroupService.OnUploaded(ADownloadURL, AFileName: string);
  456. begin
  457. FDownFile.OnComplete := DownFaceFileComplete;
  458. FDownFile.ThreadDownFile(ADownloadURL, TRealICQClient.GetReceivedFaceDir + AFileName);
  459. end;
  460. procedure TGroupService.DownFaceFileComplete(Source_file, Dest_file: string; blStatus: boolean; ErrMessage: string);
  461. begin
  462. if not blStatus then
  463. begin
  464. Error(ErrMessage, '下载群图片');
  465. Exit;
  466. end;
  467. ShowGettedFace(Dest_file);
  468. end;
  469. procedure TGroupService.QuitTeam(ATeamID: string);
  470. var
  471. AMembers: TStringList;
  472. begin
  473. AMembers := TStringList.Create;
  474. try
  475. AMembers.Add(FLoginName);
  476. FGroupClient.RemoveTeamMembers(ATeamID, AMembers, nil);
  477. finally
  478. AMembers.Free;
  479. end;
  480. end;
  481. function TGroupService.RemoveManager(ATeamID, ALoginName: string): Boolean;
  482. var
  483. AManagers: TStringList;
  484. begin
  485. if Trim(ALoginName) = '' then
  486. Exit;
  487. AManagers := TStringList.Create;
  488. try
  489. AManagers.Add(ALoginName);
  490. FGroupClient.RemoveTeamMembers(ATeamID, nil, AManagers);
  491. finally
  492. AManagers.Free;
  493. end;
  494. // FGroupClient.RemoveManager();
  495. end;
  496. function TGroupService.RemoveMembers(AMembers: string; ARemoveMembers: TStrings): string;
  497. var
  498. iLoop, iIndex: Integer;
  499. AMemberList: TStrings;
  500. begin
  501. iLoop := 0;
  502. Result := '';
  503. AMemberList := SplitString(AMembers, Chr(10));
  504. try
  505. for iLoop := AMemberList.Count - 1 downto 0 do
  506. begin
  507. if Length(Trim(AMemberList[iLoop])) = 0 then
  508. AMemberList.Delete(iLoop);
  509. end;
  510. for iLoop := 0 to ARemoveMembers.Count - 1 do
  511. begin
  512. iIndex := AMemberList.IndexOf(ARemoveMembers[iLoop]);
  513. if iIndex > -1 then
  514. AMemberList.Delete(iIndex);
  515. end;
  516. iLoop := 0;
  517. while iLoop < AMemberList.Count - 1 do
  518. begin
  519. Result := Result + AMemberList[iLoop] + Chr(10);
  520. Inc(iLoop);
  521. end;
  522. Result := Result + AMemberList[iLoop]
  523. finally
  524. AMemberList.Free;
  525. end;
  526. end;
  527. procedure TGroupService.SearchTeam(AKey: string; ASearchType: TRealICQTeamSearchType; AMatchingType: TRealICQMatchingType; APage: Integer);
  528. begin
  529. case ASearchType of
  530. tsByTeamID:
  531. FGroupClient.SearchTeam(AKey, '', '', '', AMatchingType, 0, 500);
  532. tsByTeamCaption:
  533. FGroupClient.SearchTeam('', AKey, '', '', AMatchingType, 0, 500);
  534. tsByTeamIntro:
  535. FGroupClient.SearchTeam('', '', AKey, '', AMatchingType, 0, 500);
  536. // tsByTeamCreater: FGroupClient.SearchTeam('', '', '', '', 0, 500);
  537. end;
  538. end;
  539. procedure TGroupService.SendTeamMessage(ATeamID, ASender, AMsg: string; AFont: TFont; AFaces: TStringList; Attachs: string);
  540. begin
  541. FGroupClient.SendTeamMessage(ATeamID, ASender, AMsg, AFont, AFaces, Attachs);
  542. end;
  543. procedure TGroupService.SetAlias(ATeamID, ALoginName, Alias: string);
  544. begin
  545. end;
  546. procedure TGroupService.SetTeams(const Value: TStringList);
  547. begin
  548. FTeams := Value;
  549. end;
  550. procedure TGroupService.Uninstall;
  551. var
  552. iIndex: Integer;
  553. ATeam: TRealICQTeam;
  554. begin
  555. ATeam := nil;
  556. for iIndex := 0 to FTeams.Count - 1 do
  557. begin
  558. ATeam := FTeams.Objects[iIndex] as TRealICQTeam;
  559. {$IFDEF OldGroup}
  560. FGroupClient.MessageMiscMust(ATeam.TeamID);
  561. {$ENDIF}
  562. end;
  563. FGroupClient.Disconnect;
  564. end;
  565. procedure TGroupService.MessageMiscMust(ATeamID: string);
  566. begin
  567. FGroupClient.MessageMiscMust(ATeamID);
  568. end;
  569. procedure TGroupService.UpdateTeam(ATeamID, AIntro, ANotice, AName: string; AAuth: Integer);
  570. begin
  571. FGroupClient.UpdateTeamInfo(ATeamID, AIntro, ANotice, AName, AAuth);
  572. end;
  573. procedure TGroupService.UpdateTeamMembers(ATeamID: string; AOldMembers, ANewMembers: TStringList);
  574. var
  575. iLoop: Integer;
  576. ATeamAddMembers, ATeamRemoveMembers: TStringList;
  577. MemberListChanged: Boolean;
  578. begin
  579. ATeamAddMembers := TStringList.Create;
  580. ATeamRemoveMembers := TStringList.Create;
  581. MemberListChanged := False;
  582. for iLoop := 0 to ANewMembers.Count - 1 do
  583. begin
  584. if AOldMembers.IndexOf(ANewMembers[iLoop]) = -1 then
  585. begin
  586. MemberListChanged := True;
  587. ATeamAddMembers.Add(ANewMembers[iLoop]);
  588. end;
  589. end;
  590. if MemberListChanged then
  591. AddTeamMembers(ATeamID, ATeamAddMembers);
  592. MemberListChanged := False;
  593. for iLoop := 0 to AOldMembers.Count - 1 do
  594. begin
  595. if Length(Trim(AOldMembers[iLoop])) = 0 then
  596. Continue;
  597. if ANewMembers.IndexOf(AOldMembers[iLoop]) = -1 then
  598. begin
  599. MemberListChanged := True;
  600. ATeamRemoveMembers.Add(AOldMembers[iLoop]);
  601. end;
  602. end;
  603. if MemberListChanged then
  604. RemoveTeamMembers(ATeamID, ATeamRemoveMembers);
  605. ATeamAddMembers.Free;
  606. ATeamRemoveMembers.Free;
  607. end;
  608. end.