GroupService.pas 20 KB

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