Groups.pas 50 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772
  1. unit Groups;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  5. StdCtrls, WebSocket2, CustomServer2, blcksock,Idhttp, superobject,
  6. WebSocketClient, ExtCtrls, Forms, Dialogs, IniFiles, LoggerImport,
  7. DownloadFileFromWeb, GroupMonitor;
  8. type
  9. TOnGetTeamInfo = procedure (aTeamID: String) of Object;
  10. //群组成员数据
  11. TProtocolMethod = procedure(Data: String) of Object;
  12. TTeamMemberCard = class
  13. private
  14. FTeamID: string;
  15. FID: String;
  16. FServerID: String;
  17. FUserID: String;
  18. FAlias: String;
  19. FTimesTamp: Int64;
  20. public
  21. property ID: String read FID;
  22. property ServerID: String read FServerID;
  23. property UserID: String read FUserID;
  24. property Alias: String read FAlias Write FAlias;
  25. property TimesTamp: Int64 read FTimesTamp;
  26. end;
  27. TGroup = class
  28. private
  29. FIP: String;
  30. FPort: Integer;
  31. FImageIP: String;
  32. FImagePort: Integer;
  33. FClient: TWebSocketClientConnection;
  34. FProtocolsList: TStringList;
  35. FTeams: TStringList;
  36. FTempSendFileList: TStringlist;
  37. FEnable: Boolean;
  38. FLoginName: string;
  39. FDownFile: TDownFile;
  40. FTeamMemberCards: TStringList;
  41. FOnGetTeamInfo : TOnGetTeamInfo;
  42. procedure UpdateTeamInfoFromJson(AJo: ISuperObject);
  43. function GetOrCreateTeam(ATeamID: string): TObject;
  44. function GetTeam(ATeamID: string): TObject;
  45. function FormatStrFromServer(AStr: string): string;
  46. function FormatStrToServer(AStr: string): string;
  47. procedure SetGetTeamInfo(const Value: TOnGetTeamInfo);
  48. procedure ProcessOnGroupSubscribeResponse(Data: String);
  49. procedure ProcessOnGroupAddResponse(Data: String);
  50. procedure ProcessOnGroupAddBroadCast(Data: String);
  51. procedure ProcessOnGroupRemoveResponse(Data: String);
  52. procedure ProcessOnGroupRemoveBroadcast(Data: String);
  53. procedure ProcessOnGroupSayResponse(Data: String);
  54. procedure ProcessOnGroupSayBroadCast(Data: String);
  55. procedure ProcessOnGroupInfoRead(Data: String);
  56. procedure ProcessOnGroupInfoUpdate(Data: String);
  57. procedure ProcessOnGroupInfoUpdateBroadCast(Data: String);
  58. procedure ProcessOngroupMemberaddresponse(Data: String);
  59. procedure ProcessOnGroupMemberaddBroadcast(Data: String);
  60. procedure ProcessOnGroupManagerAddResponse(Data: String);
  61. procedure ProcessOnGroupManagerAddBroadCast(Data: String);
  62. procedure ProcessOnGroupMemberRemoveResponse(Data: String);
  63. procedure ProcessOnGroupMemberRemoveBroadCast(Data: String);
  64. procedure ProcessOnGroupManagerRemoveResponse(Data: String);
  65. procedure ProcessOnGroupManagerRemoveBroadCast(Data: String);
  66. procedure ProcessOnGroupMemberLeaveRespone(Data: String);
  67. procedure ProcessOnGroupMemberleaveBroadCast(Data: String);
  68. procedure ProcessOnGroupSearch(Data: String);
  69. procedure ProcessOngroupMemberApplyConfirm(Data: String);
  70. procedure ProcessOnGroupMemberApplyResponse(Data: String);
  71. procedure ProcessOnGroupFileBroadCast(Data: String);
  72. procedure ProcessOnGroupFileUploadResponse(Data: String);
  73. procedure ProcessOnGroupMemberUpdateResponse(Data: String);
  74. function GetTeams:TStringList;
  75. function GetMemberCard(ATeamID, ALoginName: string): TTeamMemberCard;
  76. procedure DownFaceFileComplete(Source_file, Dest_file: String; blStatus: boolean; ErrMessage: String);
  77. procedure SetLoginName(const Value: string);
  78. function InitMemebers(ATeamID: string; AJoUser: ISuperObject): string;
  79. function ConcateMembers(AMemebersStr: string; ANewMembers: TSuperArray): string;
  80. public
  81. constructor Create();
  82. destructor Destroy; override;
  83. procedure Start;
  84. procedure Close;
  85. procedure SendMessage(Data: String);
  86. Procedure TestEvent;
  87. procedure Send(Data: string);
  88. procedure UploadFile(Hash, FileName, ID, GroupID: String);
  89. procedure DownloadTeamFace(AMD5String, AFileName, Path: String);
  90. procedure SendFilesRequest(AGroupId, AUserId, FileName: String);
  91. procedure UpdateTeamInfo(ATeamID, AIntro, ANotice, AName: string; AAuth: Integer);
  92. procedure SendTeamMessage(ATeamID, ASender, AMsg: String; AFont: TFont; AFaces: TStringList; Attachs: String);
  93. procedure Subscribe;
  94. procedure UnSubscribe;
  95. procedure Search(AKey, AName, ATeamID, ACreator: String);
  96. procedure Leave(ATeamID: string);
  97. procedure AddManager(ATeamID, AName: String);
  98. procedure RemoveManager(ATeamID, AName: String);
  99. procedure AddTeamMembers(ATeamID: String; AUsers: TStringList);
  100. procedure RemoveTeamMembers(ATeamID: string; AUsers: TStringList);
  101. procedure RemoveMember(ATeamID,AName: String);
  102. procedure SetAlias(ATeamID, ALoginName, Alias: String);
  103. function GetAlias(ATeamID, ALoginName: string): string;
  104. Procedure SendGetTeamInfo(ATeamID: String);
  105. procedure RemoveTeam(ATeamID: string);
  106. procedure CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: String; ATeamMembers: TStringList; AIsTempTeam: Boolean);
  107. procedure JoinTeam(ATeamID, ATag: String);
  108. procedure JoinTeamResponse(ATeamID, ALoginName, AMsg: String; ARet : Integer);
  109. procedure Reconnect;
  110. procedure StopReconnect; //MainForm.TimerForreconnectgroup.Enabled := False;
  111. procedure OnOpen(aSender: TWebSocketCustomConnection);
  112. procedure OnRead(aSender: TWebSocketCustomConnection; aFinal, aRes1, aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream);
  113. procedure OnWrite(aSender: TWebSocketCustomConnection; aFinal, aRes1, aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream);
  114. procedure OnClose(aSender: TWebSocketCustomConnection; aCloseCode: integer; aCloseReason: string; aClosedByPeer: boolean);
  115. procedure OnConnectionSocket(Sender: TObject; Reason: THookSocketReason; const Value: String);
  116. published
  117. property IP: String read FIP write FIP;
  118. property Port: Integer read FPort write FPort;
  119. property ImageIP: String read FImageIP write FImageIP;
  120. property ImagePort: Integer read FImagePort write FImagePort;
  121. property Teams: TStringList read GetTeams;
  122. property Enable: Boolean read FEnable;
  123. property LoginName: string read FLoginName write SetLoginName;
  124. property TempSendFileList: TStringlist read FTempSendFileList;
  125. property OnGetTeamInfo : TOnGetTeamInfo Read FOnGetTeamInfo write SetGetTeamInfo;
  126. end;
  127. var
  128. Group: TGroup;
  129. implementation
  130. uses synsock, synachar, StrUtils, synautil, math, TypInfo, BClasses, DateUtils,
  131. CreateTeamFrm, MainFrm, SearchTeamFrm, IdMultipartFormData, MD5, xFonts,
  132. ShareUtils, RealICQClient, RealICQUtils, DataProviderImport, InterfaceDataProvider,
  133. RealICQModel;
  134. const
  135. UPLOAD_URL: string = 'http://%s:%d/file/upload';
  136. DOWNLOAD_URL: string = 'http://%s:%d/file/%s';
  137. ADDMEMBERS_PROTOCOL: string = '{"name":"group.member.add","args":{"id":"","users":[]}}';
  138. REMOVEMEMBER_PROTOCOL: string = '5:::{"name":"group.member.remove","args":{"id":"%s","userid":"%s"}}';
  139. REMOVEMEMBERS_PROTOCOL: string = '{"name":"group.member.remove","args":{"id":"","users":[]}}';
  140. ADDMANAGER_PROTOCOL: string = '5:::{"name":"group.manager.add","args":{"id":"%s","managers":["%s"]}}';
  141. REMOVEMANAGER_PROTOCOL: string = '5:::{"name":"group.manager.remove","args":{"id":"%s","managers":["%s"]}}';
  142. SUBSCRIBE_PROTOCOL: string = '5:::{"name":"group.subscribe","args":{"id":"%s"}}';
  143. UNSUBSCRIBE_PROTOCOL: string = '5:::{"name":"group.unsubscribe","args":{"id":"%s"}}';
  144. LEAVE_PROTOCOL: string = '5:::{"name":"group.member.leave","args":{"id":"%s","userid":"%s"}}';
  145. REMOVETEAM_PROTOCOL: string = '5:::{"name":"group.remove","args":{"id":"%s"}}';
  146. MEMBERCARD_KEY: string = '%s:%s';
  147. {$REGION '---'}
  148. { TGroup }
  149. procedure TGroup.Close;
  150. begin
  151. if (FClient <> nil) and (not FClient.Closed) then
  152. begin
  153. FClient.Close(wsCloseNormal, 'goodbye');
  154. WaitForSingleObject(FClient.Handle, 60 * 1000);
  155. end;
  156. end;
  157. constructor TGroup.Create();
  158. begin
  159. inherited Create;
  160. FEnable := False;
  161. FDownFile:= TDownFile.Create;
  162. FTeamMemberCards:= TStringList.Create;
  163. FProtocolsList := TStringList.Create;
  164. FTeams := TStringList.Create;
  165. FTempSendFileList := TStringlist.Create;
  166. FProtocolsList.Add('group.subscribe.response');
  167. FProtocolsList.Add('group.add.response');
  168. FProtocolsList.Add('group.remove.response');
  169. FProtocolsList.Add('group.say.response');
  170. FProtocolsList.Add('group.say.broadcast');
  171. FProtocolsList.Add('group.info.response');
  172. FProtocolsList.Add('group.member.add.response');
  173. FProtocolsList.Add('group.member.remove.response');
  174. FProtocolsList.Add('group.add.broadcast');
  175. FProtocolsList.Add('group.remove.broadcast');
  176. FProtocolsList.Add('group.member.add.broadcast');
  177. FProtocolsList.Add('group.member.remove.broadcast');
  178. FProtocolsList.Add('group.member.leave.response');
  179. FProtocolsList.Add('group.member.leave.broadcast');
  180. FProtocolsList.Add('group.manager.add.response');
  181. FProtocolsList.Add('group.manager.add.broadcast');
  182. FProtocolsList.Add('group.manager.remove.response');
  183. FProtocolsList.Add('group.update.response');
  184. FProtocolsList.Add('group.update.broadcast');
  185. FProtocolsList.Add('group.manager.remove.broadcast');
  186. FProtocolsList.Add('group.search.response');
  187. FProtocolsList.Add('group.member.apply.confirm');
  188. FProtocolsList.Add('group.member.apply.response');
  189. FProtocolsList.Add('group.file.broadcast');
  190. FProtocolsList.Add('file.upload.response');
  191. FProtocolsList.Add('group.member.update.response');
  192. FProtocolsList.Add('group.member.update.broadcast');
  193. end;
  194. destructor TGroup.Destroy;
  195. var
  196. iLoop: Integer;
  197. RealICQTeam: TRealICQTeam;
  198. MemberCard: TTeamMemberCard;
  199. begin
  200. FreeAndNil(FProtocolsList);
  201. FreeAndNil(FDownFile);
  202. while FTeams.Count > 0 do
  203. begin
  204. RealICQTeam := FTeams.Objects[0] as TRealICQTeam;
  205. FTeams.Delete(0);
  206. FreeAndNil(RealICQTeam);
  207. end;
  208. FreeAndNil(FTeams);
  209. //注意
  210. while FTempSendFileList.Count > 0 do
  211. begin
  212. RealICQTeam := FTempSendFileList.Objects[0] as TRealICQTeam;
  213. FTeams.Delete(0);
  214. FreeAndNil(RealICQTeam);
  215. end;
  216. FreeAndNil(FTempSendFileList);
  217. while FTeamMemberCards.Count > 0 do
  218. begin
  219. MemberCard := FTeamMemberCards.Objects[0] as TTeamMemberCard;
  220. FTeamMemberCards.Delete(0);
  221. FreeAndNil(MemberCard);
  222. end;
  223. FreeAndNil(FTeamMemberCards);
  224. inherited Destroy;
  225. end;
  226. function TGroup.GetTeams: TStringList;
  227. begin
  228. if not Assigned(FTeams) then
  229. FTeams := TStringList.Create;
  230. Result := FTeams;
  231. end;
  232. procedure TGroup.OnClose(aSender: TWebSocketCustomConnection; aCloseCode: integer; aCloseReason: string; aClosedByPeer: boolean);
  233. begin
  234. //GrpMonitor.Stop;
  235. { TODO -olqq -c : 先把定时器关掉再开 2014/12/12 15:32:22 }
  236. if (aClosedByPeer) or (aCloseCode <> 1000) then
  237. begin
  238. Error(Format('异常断开. Code:%d;Reson:%s;ClolsedByPeer:%s;', [aCloseCode, aCloseReason, BoolToStr(aClosedByPeer)]), 'TGroup.OnClose');
  239. Reconnect;
  240. end
  241. else
  242. Success(Format('正常断开. Code:%d;Reson:%s;ClolsedByPeer:%s;', [aCloseCode, aCloseReason, BoolToStr(aClosedByPeer)]), 'TGroup.OnClose');
  243. end;
  244. procedure TGroup.OnConnectionSocket(Sender: TObject; Reason: THookSocketReason;
  245. const Value: String);
  246. begin
  247. end;
  248. procedure TGroup.OnOpen(aSender: TWebSocketCustomConnection);
  249. begin
  250. StopReconnect;
  251. Subscribe;
  252. //GrpMonitor.Start;
  253. end;
  254. procedure TGroup.OnRead(aSender: TWebSocketCustomConnection; aFinal, aRes1,
  255. aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream);
  256. var
  257. s,Recvdata: string;
  258. c: TTestWebSocketClientConnection;
  259. jo: ISuperObject;
  260. protocol:string;
  261. RecvMethod: TProtocolMethod;
  262. begin
  263. try
  264. //GrpMonitor.ReflashLastTime;
  265. c := TTestWebSocketClientConnection(aSender);
  266. s := ReadStrFromStream(c.ReadStream, c.ReadStream.size{min(c.ReadStream.size, 10 * 1024)});
  267. if (c.ReadCode = wsCodeText) then
  268. Recvdata := utf8toansi(s)//CharsetConversion(s, UTF_8, GetCurCP)
  269. else
  270. Recvdata := s;
  271. { TODO -olqq -c : 统一发送调用 2014/12/13 12:38:42 }
  272. if Recvdata = '2::' then
  273. Send('2::');
  274. Recvdata := copy(Recvdata,5,length(Recvdata));
  275. if Recvdata <> '' then
  276. begin
  277. jo := SO(Recvdata);
  278. protocol := jo['name'].AsString;
  279. case FProtocolsList.IndexOf(protocol) of
  280. 0:ProcessOnGroupSubscribeResponse(Recvdata);
  281. 1:ProcessOnGroupAddResponse(Recvdata);
  282. 2:ProcessOnGroupRemoveResponse(Recvdata);
  283. 3:ProcessOnGroupSayResponse(Recvdata);
  284. 4:ProcessOnGroupSayBroadCast(Recvdata);
  285. 5:ProcessOnGroupInfoRead(Recvdata);
  286. 6:ProcessOngroupmemberaddresponse(Recvdata);
  287. 7:ProcessOnGroupMemberRemoveResponse(Recvdata);
  288. 8:ProcessOnGroupAddBroadCast(Recvdata);
  289. 9:ProcessOnGroupRemoveBroadcast(Recvdata);
  290. 10:ProcessOnGroupMemberaddBroadcast(Recvdata);
  291. 11:ProcessOnGroupMemberRemoveBroadCast(Recvdata);
  292. 12:ProcessOnGroupMemberLeaveRespone(Recvdata);
  293. 13:ProcessOnGroupMemberleaveBroadCast(Recvdata);
  294. 14:ProcessOnGroupManagerAddResponse(Recvdata);
  295. 15:ProcessOnGroupManagerAddBroadCast(Recvdata);
  296. 16:ProcessOnGroupManagerRemoveResponse(Recvdata);
  297. 17:ProcessOnGroupInfoUpdate(Recvdata);
  298. 18:ProcessOnGroupInfoUpdateBroadCast(Recvdata);
  299. 19:ProcessOnGroupManagerRemoveBroadCast(Recvdata);
  300. 20:ProcessOnGroupSearch(Recvdata);
  301. 21:ProcessOngroupmemberapplyconfirm(Recvdata);
  302. 22:ProcessOnGroupMemberApplyResponse(Recvdata);
  303. 23:ProcessOnGroupFileBroadCast(Recvdata);
  304. 24:ProcessOnGroupFileUploadResponse(Recvdata);
  305. 25:ProcessOnGroupMemberUpdateResponse(Recvdata);
  306. 26:ProcessOnGroupMemberUpdateResponse(Recvdata);
  307. end;
  308. end;
  309. except
  310. on E: Exception do
  311. Log(E.Message+Recvdata, 'TGroup.OnRead('+Recvdata+')');
  312. end;
  313. end;
  314. procedure TGroup.OnWrite(aSender: TWebSocketCustomConnection; aFinal, aRes1,
  315. aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream);
  316. begin
  317. end;
  318. procedure TGroup.ProcessOnGroupAddBroadCast(Data: String);
  319. var
  320. jo: ISuperObject;
  321. ja: TSuperArray;
  322. nTeamID: String;
  323. IsTemp: Integer;
  324. begin
  325. jo := SO(Data);
  326. ja := jo['args'].AsArray;
  327. nTeamID := ja[0]['id'].AsString;
  328. IsTemp := ja[0]['type'].AsInteger;
  329. if IsTemp = 0 then
  330. SendGetTeamInfo(nTeamID);
  331. end;
  332. procedure TGroup.ProcessOnGroupAddResponse(Data: String);
  333. var
  334. jo: ISuperObject;
  335. ja: TSuperArray;
  336. HWnd:THandle;
  337. nTeamID: String;
  338. TeamCreated: Boolean;
  339. TeamCaption,
  340. FailingCause: String;
  341. RealICQTeam: TRealICQTeam;
  342. begin
  343. jo := SO(Data);
  344. ja := jo['args'].AsArray;
  345. nTeamID := ja[0]['id'].AsString;
  346. TeamCreated := not ja[0]['ret'].AsBoolean;
  347. TeamCaption := '';
  348. FailingCause := ja[0]['msg'].AsString;
  349. SendGetTeamInfo(nTeamID);
  350. // CreateTeamForm.CreateTeamResult(nil,TeamCaption,TeamCreated,nTeamID,FailingCause);
  351. //
  352. // RealICQTeam := TRealICQTeam.Create;
  353. // RealICQTeam.TeamID := nTeamID;
  354. //
  355. // if assigned(FTeams) then
  356. // begin
  357. // try
  358. // FTeams.AddObject(nTeamID, RealICQTeam);
  359. // except
  360. // on e:Exception do
  361. // showmessage(e.message);
  362. // end;
  363. // end;
  364. end;
  365. procedure TGroup.ProcessOnGroupFileBroadCast(Data: String);
  366. var
  367. jo: ISuperObject;
  368. jaargs,jafiles: TSuperArray;
  369. iLoop: Integer;
  370. filename,hash: String;
  371. begin
  372. jo := SO(Data);
  373. jaargs := jo['args'].AsArray;
  374. jafiles := jaargs[0]['files'].AsArray;
  375. for ILoop := 0 to jafiles.Length - 1 do
  376. begin
  377. filename := jafiles[iLoop]['file'].AsString;
  378. hash := jafiles[iLoop]['hash'].AsString;
  379. DownloadTeamFace(Hash,FileName,'');
  380. end;
  381. end;
  382. procedure TGroup.ProcessOnGroupFileUploadResponse(Data: String);
  383. var
  384. jo: ISuperObject;
  385. jaargs,jafiles: TSuperArray;
  386. nTeamID: String;
  387. msg: String;
  388. iLoop: Integer;
  389. filename,hash: String;
  390. ret,itemindex: Integer;
  391. begin
  392. jo := SO(Data);
  393. jaargs := jo['args'].AsArray;
  394. nTeamID := jaargs[0]['id'].AsString;
  395. msg := jaargs[0]['msg'].AsString;
  396. jafiles := jaargs[0]['files'].AsArray;
  397. for ILoop := 0 to jafiles.Length - 1 do
  398. begin
  399. filename := jafiles[iLoop]['file'].AsString;
  400. hash := jafiles[iLoop]['hash'].AsString;
  401. ret := jafiles[iLoop]['ret'].AsInteger;
  402. if ret = 0 then
  403. begin
  404. { TODO -olqq -c : 上传成功 2014/12/19 19:01:52 }
  405. end
  406. else
  407. begin
  408. { TODO -olqq -c : 上传失败 2014/12/19 19:01:52 }
  409. end;
  410. end;
  411. end;
  412. function ManagersConvertToStr(AManagers: TSuperArray): string;
  413. var
  414. iLoop: Integer;
  415. begin
  416. iLoop := 0;
  417. Result := '';
  418. while iLoop < AManagers.Length - 1 do
  419. begin
  420. Result := Result + AManagers[iLoop].AsString + Chr(10);
  421. Inc(iLoop);
  422. end;
  423. Result := Result + AManagers[iLoop].AsString
  424. end;
  425. function TGroup.InitMemebers(ATeamID: string; AJoUser: ISuperObject): string;
  426. var
  427. AKey: String;
  428. AItem: TSuperAvlEntry;
  429. AMemberCard: TTeamMemberCard;
  430. begin
  431. Result := '';
  432. for AItem in AJoUser.AsObject do
  433. begin
  434. AKey := Format(MEMBERCARD_KEY, [ATeamID, AItem.Value['id'].AsString]);
  435. Result := Result + AItem.Value['id'].AsString + Chr(10);
  436. if FTeamMemberCards.IndexOf(AKey) > 0 then
  437. Continue;
  438. AMemberCard := TTeamMemberCard.create;
  439. AMemberCard.FID := AItem.Value['id'].AsString;
  440. AMemberCard.FServerID := AItem.Value['serverid'].AsString;
  441. AMemberCard.FUserID := AItem.Value['userid'].AsString;
  442. AMemberCard.FAlias := AItem.Value['alias'].AsString;
  443. AMemberCard.FTimesTamp := AItem.Value['timestamp'].AsInteger;
  444. FTeamMemberCards.AddObject(AKey, AMemberCard);
  445. end;
  446. Result := Copy(Result, 0, Length(Result) - 1);
  447. end;
  448. procedure TGroup.UpdateTeamInfoFromJson(AJo: ISuperObject);
  449. var
  450. ATeam : TRealICQTeam;
  451. ATeamID: String;
  452. begin
  453. try
  454. ATeamID := AJo.S['id'];
  455. if ATeamID = '' then
  456. Exit;
  457. ATeam := GetOrCreateTeam(ATeamID) as TRealICQTeam;
  458. ATeam.TeamCaption := AJo.S['name'];
  459. ATeam.TeamCreater := AJo.S['creator'];
  460. ATeam.IsTempTeam := AJo.B['type'];
  461. ATeam.TeamIntro := FormatStrFromServer(AJo.S['intro']);;
  462. ATeam.TeamCallBoard := FormatStrFromServer(AJo.S['notice']);
  463. ATeam.TeamValidate := TRealICQTeamValidateType(AJo.I['auth']);
  464. ATeam.TeamManagers := ManagersConvertToStr(AJo.A['managers']);
  465. ATeam.TeamMembers := InitMemebers(ATeamID, AJo.O['users']);
  466. except
  467. on E: Exception do
  468. Log(E.Message, 'TGroup.UpdateTeamInfo');
  469. end;
  470. end;
  471. procedure TGroup.ProcessOnGroupInfoRead(Data: String);
  472. var
  473. jo,jo1,jo2: ISuperObject;
  474. ja,ja2: TSuperArray;
  475. ATeamID: string;
  476. begin
  477. try
  478. jo := SO(Data);
  479. ja := jo['args'].AsArray;
  480. jo1 := SO(ja[0].AsString);
  481. ja2 := jo1['groups'].AsArray;
  482. jo2 := SO(ja2[0].AsString);
  483. ATeamID := jo2.S['id'];
  484. if ATeamID = '' then
  485. Exit;
  486. GetMapTeamUsersProvider.Insert(jo2.S['id'], jo2.AsJSon(), jo2.I['ver']);
  487. UpdateTeamInfoFromJson(jo2);
  488. MainForm.WebSocketSendReadTeamInfo(ATeamID);
  489. except
  490. on E: Exception do
  491. Log(E.Message, 'TGroup.ProcessOnGroupInfoRead');
  492. end;
  493. end;
  494. procedure TGroup.ProcessOnGroupInfoUpdate(Data: String);
  495. var
  496. jo,joGroup: ISuperObject;
  497. ja : TSuperArray;
  498. ATeamID: String;
  499. ATeam : TRealICQTeam;
  500. begin
  501. jo := SO(Data);
  502. ja := jo['args'].AsArray;
  503. joGroup := SO(ja[0]['group'].AsString);
  504. ATeamID := joGroup.S['id'];
  505. if ATeamID = '' then
  506. Exit;
  507. ATeam := GetOrCreateTeam(ATeamID) as TRealICQTeam;
  508. ATeam.TeamCaption := joGroup.S['name'];
  509. ATeam.TeamIntro := FormatStrFromServer(joGroup.S['intro']);;
  510. ATeam.TeamCallBoard := FormatStrFromServer(joGroup.S['notice']);
  511. ATeam.TeamValidate := TRealICQTeamValidateType(joGroup.I['auth']);
  512. MainForm.WebSocketSendReadTeamInfo(ATeamID);
  513. end;
  514. procedure TGroup.ProcessOnGroupInfoUpdateBroadCast(Data: String);
  515. var
  516. jo: ISuperObject;
  517. ja,jaManagers: TSuperArray;
  518. nTeamID: String;
  519. RealICQTeam : TRealICQTeam;
  520. I,ItemIndex: Integer;
  521. begin
  522. jo := SO(Data);
  523. ja := jo['args'].AsArray;
  524. nTeamID := ja[0]['id'].AsString;
  525. ItemIndex := FTeams.indexof(nTeamID);
  526. if ItemIndex >= 0 then
  527. begin
  528. SendGetTeamInfo(nTeamID);
  529. end;
  530. end;
  531. procedure TGroup.ProcessOnGroupManagerAddBroadCast(Data: String);
  532. var
  533. jo: ISuperObject;
  534. ja,jaManagers: TSuperArray;
  535. nTeamID, strManagers: String;
  536. ATeam : TRealICQTeam;
  537. I: Integer;
  538. begin
  539. jo := SO(Data);
  540. ja := jo['args'].AsArray;
  541. nTeamID := ja[0]['id'].AsString;
  542. jaManagers := ja[0]['managers'].AsArray;
  543. ATeam := GetTeam(nTeamID) as TRealICQTeam;
  544. if ATeam = nil then
  545. begin
  546. SendGetTeamInfo(nTeamID);
  547. Exit;
  548. end;
  549. strManagers := ManagersConvertToStr(jaManagers);
  550. if Trim(ATeam.TeamManagers) <> '' then
  551. ATeam.TeamManagers := ATeam.TeamManagers + char(10) + strManagers
  552. else
  553. ATeam.TeamManagers := strManagers;
  554. MainForm.WebSocketSendReadTeamInfo(nTeamID);
  555. end;
  556. procedure TGroup.ProcessOnGroupManagerAddResponse(Data: String);
  557. var
  558. jo: ISuperObject;
  559. ja,jaManagers: TSuperArray;
  560. nTeamID, strManagers: String;
  561. ATeam : TRealICQTeam;
  562. I: Integer;
  563. begin
  564. jo := SO(Data);
  565. ja := jo['args'].AsArray;
  566. nTeamID := ja[0]['id'].AsString;
  567. jaManagers := ja[0]['managers'].AsArray;
  568. ATeam := GetTeam(nTeamID) as TRealICQTeam;
  569. if ATeam = nil then
  570. begin
  571. SendGetTeamInfo(nTeamID);
  572. Exit;
  573. end;
  574. strManagers := ManagersConvertToStr(jaManagers);
  575. if Trim(ATeam.TeamManagers) <> '' then
  576. ATeam.TeamManagers := ATeam.TeamManagers + char(10) + strManagers
  577. else
  578. ATeam.TeamManagers := strManagers;
  579. MainForm.WebSocketSendReadTeamInfo(nTeamID);
  580. end;
  581. procedure TGroup.ProcessOnGroupManagerRemoveBroadCast(Data: String);
  582. var
  583. jo: ISuperObject;
  584. ja,jaManagers: TSuperArray;
  585. nTeamID: String;
  586. ATeam : TRealICQTeam;
  587. I: Integer;
  588. begin
  589. jo := SO(Data);
  590. ja := jo['args'].AsArray;
  591. nTeamID := ja[0]['id'].AsString;
  592. jaManagers := ja[0]['managers'].AsArray;
  593. ATeam := GetTeam(nTeamID) as TRealICQTeam;
  594. SendGetTeamInfo(nTeamID);
  595. // if ATeam = nil then
  596. // begin
  597. // SendGetTeamInfo(nTeamID);
  598. // Exit;
  599. // end;
  600. // for I := 0 to jaManagers.Length - 1 do
  601. // begin
  602. // ATeam.TeamManagers := StringReplace(Chr(10) + ATeam.TeamManagers + Chr(10), Chr(10) + jaManagers[i].AsString + char(10),char(10),[rfReplaceAll]);
  603. // ATeam.TeamManagers := Copy(ATeam.TeamManagers, 2, Length(ATeam.TeamManagers) - 1);
  604. // end;
  605. // MainForm.WebSocketSendReadTeamInfo(nTeamID);
  606. end;
  607. procedure TGroup.ProcessOnGroupManagerRemoveResponse(Data: String);
  608. var
  609. jo: ISuperObject;
  610. ja,jaManagers: TSuperArray;
  611. nTeamID: String;
  612. ATeam : TRealICQTeam;
  613. I: Integer;
  614. begin
  615. jo := SO(Data);
  616. ja := jo['args'].AsArray;
  617. nTeamID := ja[0]['id'].AsString;
  618. jaManagers := ja[0]['managers'].AsArray;
  619. ATeam := GetTeam(nTeamID) as TRealICQTeam;
  620. SendGetTeamInfo(nTeamID);
  621. // if ATeam = nil then
  622. // begin
  623. // SendGetTeamInfo(nTeamID);
  624. // Exit;
  625. // end;
  626. // for I := 0 to jaManagers.Length - 1 do
  627. // begin
  628. // ATeam.TeamManagers := StringReplace(Chr(10) +ATeam.TeamManagers + Chr(10), Chr(10) +jaManagers[i].AsString + char(10),char(10),[rfReplaceAll]);
  629. // ATeam.TeamManagers := Copy(ATeam.TeamManagers, 2, Length(ATeam.TeamManagers) - 1);
  630. // end;
  631. // MainForm.WebSocketSendReadTeamInfo(nTeamID);
  632. end;
  633. procedure TGroup.ProcessOnGroupMemberaddBroadcast(Data: String);
  634. var
  635. jo: ISuperObject;
  636. ja, jaMemebers: TSuperArray;
  637. ATeam : TRealICQTeam;
  638. nTeamID: String;
  639. I: Integer;
  640. begin
  641. try
  642. jo := SO(Data);
  643. ja := jo['args'].AsArray;
  644. nTeamID := ja[0]['id'].AsString;
  645. jaMemebers := ja[0]['users'].AsArray;
  646. ATeam := GetTeam(nTeamID) as TRealICQTeam;
  647. if ATeam = nil then
  648. begin
  649. SendGetTeamInfo(nTeamID);
  650. Exit;
  651. end;
  652. ATeam.TeamMembers := ConcateMembers(ATeam.TeamMembers, jaMemebers);
  653. MainForm.WebSocketSendReadTeamInfo(nTeamID);
  654. except
  655. on E: Exception do
  656. Error(E.Message, 'TGroup.ProcessOnGroupMemberaddBroadcast(' + Data +')')
  657. end;
  658. end;
  659. function TGroup.ConcateMembers(AMemebersStr: string; ANewMembers: TSuperArray): string;
  660. var
  661. AMemberList: TStrings;
  662. iLoop, jLoop: Integer;
  663. isAdd: Boolean;
  664. begin
  665. Result := '';
  666. AMemberList := SplitString(AMemebersStr, Chr(10));
  667. try
  668. for iLoop := AMemberList.Count - 1 downto 0 do
  669. if Length(Trim(AMemberList[iLoop])) = 0 then
  670. AMemberList.Delete(iLoop);
  671. for jLoop := ANewMembers.Length - 1 downto 0 do
  672. begin
  673. isAdd := True;
  674. for iLoop := AMemberList.Count - 1 downto 0 do
  675. if SameText(ANewMembers.S[jLoop], AMemberList[iLoop]) then
  676. begin
  677. isAdd := False;
  678. Break;
  679. end;
  680. if isAdd then
  681. AMemberList.Add(ANewMembers.S[jLoop]);
  682. end;
  683. for iLoop := AMemberList.Count - 1 downto 0 do
  684. if iLoop = 0 then
  685. Result := Result + AMemberList[iLoop]
  686. else
  687. Result := Result + AMemberList[iLoop] + Chr(10);
  688. finally
  689. FreeAndNil(AMemberList);
  690. end;
  691. end;
  692. procedure TGroup.ProcessOngroupmemberaddresponse(Data: String);
  693. var
  694. jo: ISuperObject;
  695. ja, jaMemebers: TSuperArray;
  696. ATeam : TRealICQTeam;
  697. nTeamID: String;
  698. I: Integer;
  699. begin
  700. try
  701. jo := SO(Data);
  702. ja := jo['args'].AsArray;
  703. nTeamID := ja[0]['id'].AsString;
  704. jaMemebers := ja[0]['users'].AsArray;
  705. ATeam := GetTeam(nTeamID) as TRealICQTeam;
  706. if ATeam = nil then
  707. begin
  708. SendGetTeamInfo(nTeamID);
  709. Exit;
  710. end;
  711. ATeam.TeamMembers := ConcateMembers(ATeam.TeamMembers, jaMemebers);
  712. // for I := 0 to jaMemebers.Length - 1 do
  713. // ATeam.TeamMembers := ConcateMembers(ATeam.TeamMembers, jaMemebers.S[I]);
  714. MainForm.WebSocketSendReadTeamInfo(nTeamID);
  715. except
  716. on E: Exception do
  717. Error(E.Message, 'TGroup.ProcessOngroupmemberaddresponse(' + Data +')')
  718. end;
  719. end;
  720. procedure TGroup.ProcessOngroupmemberapplyconfirm(Data: String);
  721. var
  722. jo: ISuperObject;
  723. ja: TSuperArray;
  724. nTeamID: String;
  725. name: String;
  726. msg: String;
  727. begin
  728. try
  729. jo := SO(Data);
  730. ja := jo['args'].AsArray;
  731. nTeamID := ja[0]['groupid'].AsString;
  732. name := ja[0]['userid'].AsString;
  733. msg := ja[0]['msg'].AsString;
  734. MainForm.WebSocketJionTeamRequest(nTeamID,name,msg);
  735. except
  736. on E: Exception do
  737. Error(E.Message, 'TGroup.ProcessOngroupmemberapplyconfirm(' + Data +')');
  738. end;
  739. end;
  740. procedure TGroup.ProcessOnGroupMemberApplyResponse(Data: String);
  741. var
  742. jo: ISuperObject;
  743. ja: TSuperArray;
  744. nTeamID : String;
  745. msg: String;
  746. begin
  747. try
  748. jo := SO(Data);
  749. ja := jo['args'].AsArray;
  750. nTeamID := ja[0]['groupid'].AsString;
  751. msg := ja[0]['msg'].AsString;
  752. if ja[0]['ret'].AsString = '5' then
  753. begin
  754. MessageBox(SearchTeamForm.Handle, PChar('申请加入的群组不允许任何人加入!!!'), '提示', MB_ICONINFORMATION);
  755. end;
  756. if ja[0]['ret'].AsString = '1' then
  757. MainForm.RealICQClientJoinTeamResponse(nil,nTeamID,'管理员',msg,False);
  758. // MessageBox(SearchTeamForm.Handle, PChar('申请加入的群组不允许任何人加入!!!'), '提示', MB_ICONINFORMATION);
  759. if ja[0]['ret'].AsString = '0' then
  760. begin
  761. SendGetTeamInfo(nTeamID);
  762. MainForm.RealICQClientJoinTeamResponse(nil,nTeamID,'管理员',msg,True);
  763. end;
  764. except
  765. on E: Exception do
  766. Error(E.Message, 'TGroup.ProcessOnGroupMemberApplyResponse(' + Data +')');
  767. end;
  768. end;
  769. procedure TGroup.ProcessOnGroupMemberleaveBroadCast(Data: String);
  770. var
  771. jo: ISuperObject;
  772. ja,jauser: TSuperArray;
  773. nTeamID: String;
  774. name: String;
  775. iLoop,jLoop: Integer;
  776. RealICQTeam: TRealICQTeam;
  777. index,itemIndex:Integer;
  778. ATeamMembers: TStringList;
  779. begin
  780. jo := SO(Data);
  781. ja := jo['args'].AsArray;
  782. nTeamID := ja[0]['id'].AsString;
  783. name := ja[0]['userid'].AsString;
  784. SendGetTeamInfo(nTeamID);
  785. // itemIndex := FTeams.IndexOf(nTeamID);
  786. // try
  787. // if itemindex >= 0 then
  788. // begin
  789. // RealICQTeam := FTeams.Objects[itemIndex] as TRealICQTeam;
  790. // if not AnsiSameText(name, MainForm.RealICQClient.LoginName) then
  791. // begin
  792. // RealICQTeam.TeamMembers := StringReplace(Chr(10) +RealICQTeam.TeamMembers + Chr(10), Chr(10) +name + char(10),char(10),[rfReplaceAll]);
  793. // RealICQTeam.TeamMembers := Copy(RealICQTeam.TeamMembers, 2, Length(RealICQTeam.TeamMembers) - 1);
  794. // MainForm.WebSocketSendReadTeamInfo(nteamID);
  795. // end
  796. // else
  797. // begin
  798. // MainForm.WebSocketQuitTeam(RealICQTeam.TeamID);
  799. // FTeams.Delete(itemIndex);
  800. // end;
  801. // end;
  802. // except
  803. // on E: Exception do
  804. // Error(E.Message, 'TGroup.ProcessOnGroupMemberleaveBroadCast(' + Data +')');
  805. // end;
  806. end;
  807. procedure TGroup.ProcessOnGroupMemberLeaveRespone(Data: String);
  808. var
  809. jo: ISuperObject;
  810. ja: TSuperArray;
  811. nTeamID: String;
  812. itemIndex: Integer;
  813. begin
  814. jo := SO(Data);
  815. ja := jo['args'].AsArray;
  816. nTeamID := ja[0]['id'].AsString;
  817. itemIndex := FTeams.IndexOf(nTeamID);
  818. if itemIndex > -1 then
  819. begin
  820. MainForm.WebSocketQuitTeam(nTeamID);
  821. FTeams.Delete(itemIndex);
  822. end;
  823. end;
  824. procedure TGroup.ProcessOnGroupMemberRemoveBroadCast(Data: String);
  825. var
  826. jo: ISuperObject;
  827. ja,jauser: TSuperArray;
  828. ISSucceed: Boolean;
  829. nTeamID: String;
  830. msg: String;
  831. name: String;
  832. iLoop,jLoop: Integer;
  833. RealICQTeam: TRealICQTeam;
  834. index,itemIndex:Integer;
  835. begin
  836. jo := SO(Data);
  837. ja := jo['args'].AsArray;
  838. nTeamID := ja[0]['id'].AsString;
  839. jauser := ja[0]['users'].AsArray;
  840. itemIndex := Fteams.IndexOf(nTeamID);
  841. if itemindex >= -1 then
  842. begin
  843. RealICQTeam := FTeams.Objects[itemIndex] as TRealICQTeam;
  844. for jLoop := 0 to jauser.Length - 1 do
  845. begin
  846. try
  847. name := jauser[jLoop].AsString;
  848. if AnsiSameText(name, MainForm.RealICQClient.LoginName) then
  849. begin
  850. //MainForm.WebSocketRemoveTeamResponse(RealICQTeam.FTeamID);
  851. MainForm.WebSocketQuitTeam(nTeamID);
  852. FTeams.Delete(itemIndex);
  853. Exit;
  854. end;
  855. except
  856. on E: Exception do
  857. Error(E.Message, 'TGroup.ProcessOnGroupMemberRemoveBroadCast(' + Data +')');
  858. end;
  859. end;
  860. SendGetTeamInfo(nTeamID);
  861. end;
  862. end;
  863. procedure TGroup.ProcessOnGroupMemberRemoveResponse(Data: String);
  864. var
  865. jo: ISuperObject;
  866. ja,jauser: TSuperArray;
  867. ISSucceed: Boolean;
  868. nTeamID: String;
  869. msg: String;
  870. name: String;
  871. iLoop,jLoop: Integer;
  872. RealICQTeam: TRealICQTeam;
  873. index,itemIndex:Integer;
  874. begin
  875. jo := SO(Data);
  876. ja := jo['args'].AsArray;
  877. ISSucceed := not ja[0]['ret'].AsBoolean;
  878. nTeamID := ja[0]['id'].AsString;
  879. msg := ja[0]['msg'].AsString;
  880. jauser := ja[0]['users'].AsArray;
  881. SendGetTeamInfo(nTeamID);
  882. // itemIndex := Fteams.IndexOf(nTeamID);
  883. // if itemindex >= 0 then
  884. // begin
  885. // RealICQTeam := FTeams.Objects[itemIndex] as TRealICQTeam;
  886. // for jLoop := 0 to jauser.Length - 1 do
  887. // begin
  888. // try
  889. // name := jauser[jLoop].AsString;
  890. // if not AnsiSameText(name, MainForm.RealICQClient.LoginName) then
  891. // begin
  892. // RealICQTeam.TeamMembers := StringReplace(Chr(10) +RealICQTeam.TeamMembers + Chr(10), Chr(10) +name + char(10),char(10),[rfReplaceAll]);
  893. // RealICQTeam.TeamMembers := Copy(RealICQTeam.TeamMembers, 2, Length(RealICQTeam.TeamMembers) - 1);
  894. // MainForm.WebSocketSendReadTeamInfo(nteamID);
  895. // end
  896. // else
  897. // begin
  898. // MainForm.WebSocketRemoveTeamResponse(RealICQTeam.TeamID);
  899. // FTeams.Delete(itemIndex);
  900. // end;
  901. // except
  902. // on E: Exception do
  903. // Error(E.Message, 'TGroup.ProcessOnGroupMemberRemoveResponse(' + Data +')');
  904. // end;
  905. // end;
  906. // end;
  907. end;
  908. function TGroup.GetAlias(ATeamID, ALoginName: string): string;
  909. var
  910. itemIndex: Integer;
  911. MemberCard: TTeamMemberCard;
  912. begin
  913. Result := '';
  914. MemberCard := GetMemberCard(ATeamID, ALoginName);
  915. if MemberCard <> nil then
  916. Result := MemberCard.Alias;
  917. end;
  918. function TGroup.GetMemberCard(ATeamID, ALoginName: string): TTeamMemberCard;
  919. var
  920. itemIndex: Integer;
  921. begin
  922. Result := nil;
  923. itemIndex := FTeamMemberCards.IndexOf(Format(MEMBERCARD_KEY, [ATeamID, ALoginName]));
  924. if ItemIndex >= 0 then
  925. Result := FTeamMemberCards.Objects[itemIndex] as TTeamMemberCard;
  926. end;
  927. function TGroup.GetOrCreateTeam(ATeamID: string): TObject;
  928. var
  929. iIndex: Integer;
  930. ATeam: TRealICQTeam;
  931. begin
  932. iIndex := FTeams.IndexOf(ATeamID);
  933. if iIndex = -1 then
  934. begin
  935. ATeam := TRealICQTeam.Create;
  936. ATeam.TeamID := ATeamID;
  937. iIndex := FTeams.AddObject(ATeamID, ATeam);
  938. end;
  939. ATeam := FTeams.objects[iIndex] as TRealICQTeam;
  940. Result := ATeam;
  941. end;
  942. function TGroup.GetTeam(ATeamID: string): TObject;
  943. var
  944. iIndex: Integer;
  945. ATeam: TRealICQTeam;
  946. begin
  947. ATeam := nil;
  948. iIndex := FTeams.IndexOf(ATeamID);
  949. if iIndex > -1 then
  950. ATeam := FTeams.objects[iIndex] as TRealICQTeam;
  951. Result := ATeam;
  952. end;
  953. procedure TGroup.ProcessOnGroupMemberUpdateResponse(Data: String);
  954. var
  955. jo: ISuperObject;
  956. ja,jaUser: TSuperArray;
  957. nTeamID: String;
  958. UserID,Alias: String;
  959. ret,ItemIndex,UserIndex: Integer;
  960. RealICQTeam : TRealICQTeam;
  961. MemberCard: TTeamMemberCard;
  962. begin
  963. jo := SO(Data);
  964. ja := jo['args'].AsArray;
  965. nTeamID := ja[0]['id'].AsString;
  966. jaUser := ja[0]['users'].AsArray;
  967. UserID := jaUser[0]['id'].AsString;
  968. Alias := jaUser[0]['alias'].AsString;
  969. MemberCard := GetMemberCard(nTeamID, UserID);
  970. if MemberCard <> nil then
  971. begin
  972. MemberCard.Alias := Alias;
  973. MainForm.WebSocketSendReadTeamInfo(nteamID);
  974. end;
  975. end;
  976. procedure TGroup.ProcessOnGroupRemoveBroadcast(Data: String);
  977. var
  978. jo: ISuperObject;
  979. ja: TSuperArray;
  980. nTeamID:String;
  981. itemIndex: Integer;
  982. begin
  983. jo := SO(Data);
  984. ja := jo['args'].AsArray;
  985. nTeamID := ja[0]['id'].AsString;
  986. itemIndex := FTeams.IndexOf(nTeamID);
  987. if itemIndex >= 0 then
  988. begin
  989. MainForm.WebSocketRemoveTeamResponse(nTeamID);
  990. FTeams.Delete(itemIndex);
  991. end;
  992. end;
  993. procedure TGroup.ProcessOnGroupRemoveResponse(Data: String);
  994. var
  995. jo: ISuperObject;
  996. ja: TSuperArray;
  997. HWnd:THandle;
  998. itemIndex: Integer;
  999. nTeamID: String;
  1000. TeamCreated: Boolean;
  1001. TeamCaption,
  1002. FailingCause: String;
  1003. RealICQTeam: TRealICQTeam;
  1004. begin
  1005. jo := SO(Data);
  1006. ja := jo['args'].AsArray;
  1007. nTeamID := ja[0]['id'].AsString;
  1008. TeamCreated := not ja[0]['ret'].AsBoolean;
  1009. FailingCause := ja[0]['msg'].AsString;
  1010. TeamCaption := '';
  1011. itemIndex := FTeams.IndexOf(nTeamID);
  1012. if itemIndex >= 0 then
  1013. begin
  1014. RealICQTeam := FTeams.Objects[itemIndex] as TRealICQTeam;
  1015. MainForm.WebSocketRemoveTeamResponse(nTeamID);
  1016. FTeams.Delete(itemIndex);
  1017. FreeAndNil(RealICQTeam);
  1018. end;
  1019. end;
  1020. procedure TGroup.ProcessOnGroupSayBroadCast(Data: String);
  1021. const
  1022. cUnixStartDate: TDateTime = 25569.0;
  1023. var
  1024. jo: ISuperObject;
  1025. ja,jastyle: TSuperArray;
  1026. ID: String;
  1027. Groupid: String;
  1028. Sayer: String;
  1029. Style: String;
  1030. Msg: String;
  1031. TimesTamp: Int64;
  1032. Hwnd: THandle;
  1033. aDateTime: TDateTime;
  1034. FontName,FontSize,FontsStyle,FontColor: String;
  1035. jaImgs: TSuperArray;
  1036. FileName,Hash: String;
  1037. ret,iLoop,itemindex: Integer;
  1038. begin
  1039. jo := SO(Data);
  1040. ja := jo['args'].AsArray;
  1041. ID := ja[0]['id'].AsString;
  1042. Groupid := ja[0]['groupid'].AsString;
  1043. Sayer := ja[0]['sender'].AsString;
  1044. jastyle := ja[0]['style'].AsArray;
  1045. FontName := jastyle[0].AsString;
  1046. FontColor := jastyle[2].AsString;
  1047. FontSize := jastyle[1].AsString;
  1048. FontsStyle := jastyle[3].AsString;
  1049. Style := Format('"%s", %s, [%s], [%s]',[Fontname, FontSize, FontsStyle, FontColor]);
  1050. Msg := ja[0]['msg'].AsString;
  1051. TimesTamp := ja[0]['timestamp'].AsInteger;
  1052. aDateTime := UnixToDateTime(Round(TimesTamp / 1000)+8*60*60);
  1053. Msg := StringReplace(Msg, '\r\n', #13#10, [rfReplaceAll]);
  1054. Msg := StringReplace(Msg, '[\r][\n]', '\r\n', [rfReplaceAll]);
  1055. jaImgs := ja[0]['imgs'].AsArray;
  1056. for ILoop := 0 to jaImgs.Length - 1 do
  1057. begin
  1058. ret := jaImgs[iLoop]['ret'].AsInteger;
  1059. if ret =1 then
  1060. begin
  1061. Hash := jaImgs[iLoop]['hash'].AsString;
  1062. FileName := jaImgs[iLoop]['file'].AsString;
  1063. DownloadTeamFace(Hash,FileName,'');
  1064. end;
  1065. end;
  1066. MainForm.WebSocketRecivedbroadcastmesssage(ID,Groupid,Sayer,Style,Msg,aDateTime);
  1067. end;
  1068. procedure TGroup.ProcessOnGroupSayResponse(Data: String);
  1069. var
  1070. ret: Integer;
  1071. jo: ISuperObject;
  1072. jaArgs,jaImgs: TSuperArray;
  1073. FileName,Hash,ID,GroupId: String;
  1074. iLoop,itemindex: Integer;
  1075. begin
  1076. //showmessage(Data);
  1077. jo := SO(Data);
  1078. jaArgs := jo['args'].AsArray;
  1079. ID := jaArgs[0]['id'].AsString;
  1080. GroupId := jaArgs[0]['groupid'].AsString;
  1081. jaImgs := jaArgs[0]['imgs'].AsArray;
  1082. for ILoop := 0 to jaImgs.Length - 1 do
  1083. begin
  1084. ret := jaImgs[iLoop]['ret'].AsInteger;
  1085. Hash := jaImgs[iLoop]['hash'].AsString;
  1086. FileName := jaImgs[iLoop]['file'].AsString;
  1087. if ret = 0 then
  1088. begin
  1089. UploadFile(hash,TRealICQClient.GetReceivedFaceDir+FileName,id,GroupId);
  1090. end;
  1091. end;
  1092. end;
  1093. procedure TGroup.ProcessOnGroupSearch(Data: String);
  1094. var
  1095. jo : ISuperObject;
  1096. ja,jaGroups : TSuperArray;
  1097. searchTeams: TStringList;
  1098. SearchTeam: TSearchTeamResultRecord;
  1099. iLoop: Integer;
  1100. begin
  1101. jo := SO(Data);
  1102. ja := jo['args'].AsArray;
  1103. jaGroups := ja[0]['groups'].AsArray;
  1104. searchTeams := TStringList.Create;
  1105. try
  1106. for iLoop := 0 to jaGroups.Length - 1 do
  1107. begin
  1108. SearchTeam := TSearchTeamResultRecord.Create;
  1109. SearchTeam.TeamID := jaGroups[iLoop]['id'].AsString;
  1110. SearchTeam.TeamCaption := jaGroups[iLoop]['name'].AsString;
  1111. SearchTeam.TeamCreater := jaGroups[iLoop]['creator'].AsString;
  1112. searchTeams.AddObject(IntToStr(iLoop),SearchTeam);
  1113. end;
  1114. SearchTeamForm.ShowTeamSearchResult(searchTeams);
  1115. finally
  1116. searchTeams.Free;
  1117. end;
  1118. end;
  1119. procedure TGroup.ProcessOnGroupSubscribeResponse(Data: String);
  1120. var
  1121. jo, joFromDB: ISuperObject;
  1122. ja,ja2, jaVers: TSuperArray;
  1123. i, versionFromServer, versionFromDB: Integer;
  1124. RealICQTeam: TRealICQTeam;
  1125. nTeamID, AJson: String;
  1126. HWnd: THandle;
  1127. AKeyValue: TKeyValue;
  1128. begin
  1129. FTeams.Clear;
  1130. jo := SO(Data);
  1131. ja := jo.A['args'];
  1132. ja2 := ja[0].A['groups'];
  1133. jaVers := ja[0].A['vers'];
  1134. for I := 0 to ja2.Length - 1 do
  1135. begin
  1136. nTeamID := ja2.S[i];
  1137. if (jaVers <> nil) and (i <= jaVers.Length - 1) then
  1138. versionFromServer := jaVers.I[i]
  1139. else
  1140. begin
  1141. SendGetTeamInfo(nTeamID);
  1142. Continue;
  1143. end;
  1144. AKeyValue := GetMapTeamUsersProvider.FindKeyValue(nTeamID);
  1145. versionFromDB := StrToIntDef(AKeyValue[2], -1);
  1146. AJson := AKeyValue[1];
  1147. if (versionFromDB < 0) or (versionFromDB <> versionFromServer) or (AJson = '') then
  1148. begin
  1149. SendGetTeamInfo(nTeamID);
  1150. end
  1151. else
  1152. begin
  1153. joFromDB := SO(AJson);
  1154. UpdateTeamInfoFromJson(joFromDB);
  1155. MainForm.WebSocketSendReadTeamInfo(nTeamID);
  1156. end;
  1157. end;
  1158. // for I := 0 to ja2.Length - 1 do
  1159. // begin
  1160. // nTeamID := ja2.O[i].S['id'];
  1161. // versionFromServer := ja2.O[i].I['ver'];
  1162. // AKeyValue := GetMapTeamUsersProvider.FindKeyValue(nTeamID);
  1163. // versionFromDB := StrToIntDef(AKeyValue[2], -1);
  1164. // AJson := AKeyValue[1];
  1165. // if (versionFromDB < 0) or (versionFromDB <> versionFromServer) or (AJson = '') then
  1166. // begin
  1167. // SendGetTeamInfo(nTeamID);
  1168. // end
  1169. // else
  1170. // begin
  1171. // joFromDB := SO(AJson);
  1172. // UpdateTeamInfoFromJson(joFromDB);
  1173. // MainForm.WebSocketSendReadTeamInfo(nTeamID);
  1174. // end;
  1175. // end;
  1176. end;
  1177. { TODO -olqq -c : 统一Send方法发送数据,统一异常处理 2014/12/13 23:03:17 }
  1178. procedure TGroup.Send(Data: string);
  1179. begin
  1180. try
  1181. if (FClient <> nil) and (not FClient.Closed) then
  1182. FClient.SendText(AnsiToUTF8(Data));
  1183. except
  1184. on E: Exception do
  1185. begin
  1186. Error(E.Message, 'TGroup.Send('+Data+')');
  1187. end;
  1188. end;
  1189. end;
  1190. procedure TGroup.SendGetTeamInfo(ATeamID: String);
  1191. var
  1192. SendStr:String;
  1193. jo: ISuperObject;
  1194. begin
  1195. SendStr := '5:::'+ '{"name":"group.info","args":{"id":"","groups":[{"id":"'+ATeamID+'","ver":0}]}}';
  1196. { TODO -olqq -c : 统一发送调用 2014/12/13 12:38:42 }
  1197. Send(SendStr);
  1198. //FClient.SendText(AnsiToUTF8(SendStr));//, GetCurCP, UTF_8));
  1199. end;
  1200. procedure TGroup.SendMessage(Data: String);
  1201. begin
  1202. { TODO -olqq -c : 统一发送调用 2014/12/13 12:38:42 }
  1203. Send(Data);
  1204. //FClient.SendText({CharsetConversion(Dat a, GetCurCP, UTF_8)}AnsiToUTF8(Data));
  1205. end;
  1206. procedure TGroup.SetGetTeamInfo(const Value: TOnGetTeamInfo);
  1207. begin
  1208. FOnGetTeamInfo := Value;
  1209. end;
  1210. procedure TGroup.SetLoginName(const Value: string);
  1211. begin
  1212. FLoginName := Value;
  1213. end;
  1214. procedure TGroup.Start;
  1215. var
  1216. IdHttp:TIdHTTP;
  1217. ResponeStr: String;
  1218. ResourceName: String;
  1219. tempstringlist : TStringList;
  1220. heartbeatTimeOut: Integer;
  1221. begin
  1222. IdHttp:= TIdHTTP.Create(nil);
  1223. try
  1224. ResponeStr := Idhttp.get('http://'+FIP+':'+inttostr(FPort)+'/socket.io/1/');
  1225. except
  1226. on E: Exception do
  1227. begin
  1228. Freeandnil(IdHttp);
  1229. Error(E.Message, 'TGroup.Start');
  1230. Reconnect;
  1231. Exit;
  1232. end;
  1233. end;
  1234. Freeandnil(IdHttp);
  1235. tempstringlist := TStringList.create;
  1236. try
  1237. tempstringlist.Delimiter := ':';
  1238. tempstringlist.DelimitedText := ResponeStr;
  1239. ResourceName := tempstringlist[0];
  1240. heartbeatTimeOut := StrToInt(tempstringlist[1]);
  1241. except
  1242. on E: Exception do
  1243. begin
  1244. tempstringlist.Free;
  1245. Error(E.Message, 'TGroup.Start');
  1246. Reconnect;
  1247. Exit;
  1248. end;
  1249. end;
  1250. tempstringlist.Free;
  1251. FClient := TTestWebSocketClientConnection.Create(FIP, inttostr(FPort), '/socket.io/1/websocket/'+ResourceName,'-','ws');
  1252. FClient.OnRead := OnRead;
  1253. FClient.OnWrite := OnWrite;
  1254. FClient.OnClose := OnClose;
  1255. FClient.OnOpen := OnOpen;
  1256. //fClient.Socket.OnSyncStatus := OnConnectionSocket;
  1257. // FClient.SSL := FUseSSL;
  1258. FClient.Start;
  1259. { TODO -olqq -c : 服务端已经有心跳发送 2014/12/12 16:07:11 }
  1260. end;
  1261. procedure TGroup.StopReconnect;
  1262. begin
  1263. MainForm.TimerForreconnectgroup.Enabled := False;
  1264. end;
  1265. procedure TGroup.TestEvent;
  1266. begin
  1267. if Assigned(FOnGetTeamInfo) then
  1268. try
  1269. FOnGetTeamInfo('11111122');
  1270. except
  1271. on e:Exception do
  1272. showmessage(e.Message);
  1273. end;
  1274. end;
  1275. {$ENDREGION}
  1276. {$REGION '请求'}
  1277. { TODO -olqq -c : 代替TMainForm.WebSocketInHttpSendFile 2014/12/16 12:53:56 }
  1278. procedure TGroup.UploadFile(Hash, FileName, ID, GroupID: String);
  1279. var
  1280. AHttp: TIdHttp;
  1281. MutPartForm:TIdMultiPartFormDataStream;
  1282. Ret:TStringStream;
  1283. response,UpUrl: String;
  1284. jo,t,jofile: ISuperObject;
  1285. SendStr: String;
  1286. begin
  1287. UpUrl := Format(UPLOAD_URL, [FImageIP, FImagePort]);
  1288. AHttp := Tidhttp.Create(nil);
  1289. AHttp.Request.ContentType:='multipart/form-data';
  1290. AHttp.HandleRedirects := true;
  1291. AHttp.AllowCookies := true;
  1292. MutPartForm := TIdMultiPartFormDataStream.Create;
  1293. MutPartForm.AddFile('file1', FileName,'');
  1294. try
  1295. response := AHttp.Post(UpUrl, MutPartForm);
  1296. Application.ProcessMessages;
  1297. finally
  1298. MutPartForm.Free;
  1299. AHttp.Free;
  1300. end;
  1301. if response = 'ok' then
  1302. begin
  1303. jo := SO();
  1304. jo.S['name'] := 'group.file';
  1305. jo.S['args.id'] := id;
  1306. jo.S['args.groupid'] := GroupId;
  1307. t := SA([]);
  1308. jofile := SO();
  1309. jofile.S['file'] := ExtractFileName(filename);
  1310. jofile.S['hash'] := hash;
  1311. t.AsArray.Add(jofile);
  1312. jo['args.files'] := t;
  1313. SendStr := '5:::' + jo.AsJSon(False,False);
  1314. Send(SendStr);
  1315. end;
  1316. end;
  1317. procedure TGroup.AddTeamMembers(ATeamID: String; AUsers: TStringList);
  1318. var
  1319. jo :ISuperObject;
  1320. iLoop : Integer;
  1321. moreusers: String;
  1322. begin
  1323. jo := SO(ADDMEMBERS_PROTOCOL);
  1324. jo.S['args.id'] := ATeamID;
  1325. for iLoop := 0 to AUsers.Count - 1 do
  1326. jo.A['args.users'].Add(TSuperObject.Create(AUsers[iLoop]));
  1327. moreusers := '5:::' + jo.AsJSon(False,False);
  1328. Send(moreusers);
  1329. end;
  1330. procedure TGroup.RemoveTeamMembers(ATeamID: string; AUsers: TStringList);
  1331. var
  1332. jo :ISuperObject;
  1333. iLoop : Integer;
  1334. moreusers: String;
  1335. begin
  1336. jo := SO(REMOVEMEMBERS_PROTOCOL);
  1337. jo.S['args.id'] := ATeamID;
  1338. for iLoop := 0 to AUsers.Count - 1 do
  1339. begin
  1340. jo.A['args.users'].Add(TSuperObject.Create(AUsers[iLoop]));
  1341. end;
  1342. moreusers := '5:::' + jo.AsJSon(False,False);
  1343. Send(moreusers);
  1344. end;
  1345. procedure TGroup.UpdateTeamInfo(ATeamID, AIntro, ANotice, AName: string; AAuth: Integer);
  1346. var
  1347. TeamInfo: String;
  1348. obj: ISuperObject;
  1349. begin
  1350. AIntro := StringReplace(AIntro, '\r\n', '[\r][\n]', [rfReplaceAll]);
  1351. AIntro := StringReplace(AIntro, #13#10, '\r\n', [rfReplaceAll]);
  1352. ANotice := StringReplace(ANotice, '\r\n', '[\r][\n]', [rfReplaceAll]);
  1353. ANotice := StringReplace(ANotice, #13#10, '\r\n', [rfReplaceAll]);
  1354. obj := SO();
  1355. obj['name'] := TSuperObject.Create('group.update');
  1356. obj['args.id'] := TSuperObject.Create(ATeamID);
  1357. obj['args.group.intro'] := TSuperObject.Create(AIntro);
  1358. obj['args.group.notice'] := TSuperObject.Create(ANotice);
  1359. obj['args.group.name'] := TSuperObject.Create(AName);
  1360. obj['args.group.auth'] := TSuperObject.Create(AAuth);
  1361. TeamInfo := '5:::' + obj.AsJSon(False,False);
  1362. Send(TeamInfo);
  1363. end;
  1364. procedure TGroup.SendTeamMessage(ATeamID, ASender, AMsg: String; AFont: TFont; AFaces: TStringList; Attachs: String);
  1365. var
  1366. jo : ISuperObject;
  1367. joStyle: ISuperObject;
  1368. tFile,jofile: ISuperObject;
  1369. tAttach,joattach: ISuperObject;
  1370. sendstr: String;
  1371. MD5HashValue: MD5Digest;
  1372. MD5HashString: String;
  1373. iLoop: Integer;
  1374. AFace: TFace;
  1375. begin
  1376. AMsg := StringReplace(AMsg, '\r\n', '[\r][\n]', [rfReplaceAll]);
  1377. AMsg := StringReplace(AMsg, #13#10, '\r\n', [rfReplaceAll]);
  1378. jo := SO();
  1379. jo.S['name'] := 'group.say';
  1380. jo.S['args.id'] := '';
  1381. jo.S['args.groupid'] := ATeamID;
  1382. jo.S['args.sender'] := ASender;
  1383. joStyle := SA([]);
  1384. joStyle.AsArray.S[0] := AFont.Name;
  1385. joStyle.AsArray.S[1] := inttostr(AFont.Size);
  1386. joStyle.AsArray.S[2] := ColorToString(AFont.Color);
  1387. joStyle.AsArray.S[3] := FontStyleToString(AFont);
  1388. jo['args.style'] := joStyle;
  1389. jo.S['args.msg'] := AMsg;
  1390. jo.S['args.timestamp'] :='';
  1391. tFile := SA([]);
  1392. for iLoop := 0 to AFaces.Count - 1 do
  1393. begin
  1394. AFace := AFaces.Objects[iLoop] as TFace;
  1395. jofile := SO();
  1396. jofile.S['file'] := ExtractFileName(AFace.FileName);
  1397. jofile.S['hash'] := UpperCase(AFace.MD5Code);
  1398. tFile.AsArray.Add(jofile);
  1399. end;
  1400. jo['args.imgs'] := tFile;
  1401. tAttach := SA([]);
  1402. jo['args.attachs'] := tAttach;
  1403. sendstr := '5:::' + jo.AsJSon(False,False);
  1404. Send(sendstr);
  1405. end;
  1406. procedure TGroup.Subscribe;
  1407. var
  1408. str:String;
  1409. begin
  1410. str := Format(SUBSCRIBE_PROTOCOL, [FLoginName]);
  1411. Send(str);
  1412. end;
  1413. procedure TGroup.UnSubscribe;
  1414. var
  1415. str:String;
  1416. begin
  1417. str := Format(UNSUBSCRIBE_PROTOCOL, [FLoginName]);
  1418. Send(str);
  1419. end;
  1420. procedure TGroup.Search(AKey, AName, ATeamID, ACreator: String);
  1421. var
  1422. jo: ISuperObject;
  1423. SearchStr: String;
  1424. begin
  1425. jo := SO();
  1426. jo['name'] := TSuperObject.Create('group.search');
  1427. jo['args.keyword'] := TSuperObject.Create(AKey);
  1428. jo['args.name'] := TSuperObject.Create(AName);
  1429. jo['args.groupid'] := TSuperObject.Create(ATeamID);
  1430. jo['args.creator'] := TSuperObject.Create(ACreator);
  1431. SearchStr := '5:::' + jo.AsJSon(False,False);
  1432. Send(SearchStr);
  1433. end;
  1434. procedure TGroup.AddManager(ATeamID, AName: String);
  1435. var
  1436. addManager: String;
  1437. begin
  1438. addManager := Format(ADDMANAGER_PROTOCOL, [ATeamID, AName]);
  1439. Send(addManager);
  1440. end;
  1441. procedure TGroup.Reconnect;
  1442. begin
  1443. MainForm.TimerForreconnectgroup.Enabled := False;
  1444. MainForm.TimerForreconnectgroup.Interval := RandomRange(10000,60000);
  1445. Info(IntToStr(MainForm.TimerForreconnectgroup.Interval) + '毫秒之后,开始重连。', 'TGroup.Reconnect');
  1446. MainForm.TimerForreconnectgroup.Enabled := True;
  1447. end;
  1448. procedure TGroup.RemoveManager(ATeamID, AName: String);
  1449. var
  1450. addManager: String;
  1451. begin
  1452. addManager := Format(REMOVEMANAGER_PROTOCOL, [ATeamID, AName]);
  1453. Send(addManager);
  1454. end;
  1455. procedure TGroup.Leave(ATeamID: string);
  1456. var
  1457. MemberQuit: String;
  1458. begin
  1459. MemberQuit := Format(LEAVE_PROTOCOL, [ATeamID, FLoginName]);
  1460. Send(MemberQuit);
  1461. end;
  1462. procedure TGroup.RemoveMember(ATeamID,AName: String);
  1463. var
  1464. RemoveMember: String;
  1465. begin
  1466. RemoveMember := Format(REMOVEMEMBER_PROTOCOL, [ATeamID, AName]);
  1467. Send(RemoveMember);
  1468. end;
  1469. procedure TGroup.RemoveTeam(ATeamID: String);
  1470. var
  1471. DeleteGroup:String;
  1472. begin
  1473. DeleteGroup := Format(REMOVETEAM_PROTOCOL, [ATeamID]);
  1474. Send(DeleteGroup);
  1475. end;
  1476. procedure TGroup.JoinTeamResponse(ATeamID, ALoginName, AMsg: String; ARet : Integer);
  1477. var
  1478. jo: ISuperObject;
  1479. ResponseStr: String;
  1480. begin
  1481. jo := SO();
  1482. jo.S['name'] := 'group.member.apply.confirm.reply';
  1483. jo.S['args.id'] := '';
  1484. jo.S['args.groupid'] := ATeamID;
  1485. jo.S['args.userid'] := ALoginName;
  1486. jo.I['args.ret'] := ARet;
  1487. jo.S['args.msg'] := AMsg;
  1488. ResponseStr := '5:::' + jo.AsJSon(False,False);
  1489. Send(ResponseStr);
  1490. end;
  1491. procedure TGroup.JoinTeam(ATeamID, ATag: String);
  1492. var
  1493. jo : ISuperObject;
  1494. SearchStr: String;
  1495. begin
  1496. if group.Teams.IndexOf(ATeamID) >= 0 then
  1497. raise Exception.CreateFmt('%s 已在群组列表中', [ATeamID]);
  1498. jo := SO();
  1499. jo.S['name'] := 'group.member.apply';
  1500. jo.S['args.id'] := '';
  1501. jo.S['args.groupid'] := ATeamID;
  1502. jo.S['args.userid'] := FLoginName;
  1503. jo.S['args.msg'] := ATag;
  1504. SearchStr := '5:::' + jo.AsJSon(False,False);
  1505. Send(SearchStr);
  1506. end;
  1507. procedure TGroup.DownloadTeamFace(AMD5String, AFileName,
  1508. Path: String);
  1509. var
  1510. FileStream: TFileStream;
  1511. idHTTP: TIDHTTP;
  1512. URL: String;
  1513. ss: String;
  1514. begin
  1515. URL := Format(DOWNLOAD_URL, [FImageIP, FImagePort, AMD5String]);
  1516. FDownFile.OnComplete := DownFaceFileComplete;
  1517. FDownFile.ThreadDownFile(URL,TRealICQClient.GetReceivedFaceDir+AFileName);
  1518. end;
  1519. function TGroup.FormatStrFromServer(AStr: string): string;
  1520. begin
  1521. Result := StringReplace(AStr, '\r\n', #13#10, [rfReplaceAll]);
  1522. Result := StringReplace(Result, '[\r][\n]', '\r\n', [rfReplaceAll]);
  1523. end;
  1524. function TGroup.FormatStrToServer(AStr: string): string;
  1525. begin
  1526. end;
  1527. procedure TGroup.DownFaceFileComplete(Source_file, Dest_file: String;
  1528. blStatus: boolean; ErrMessage: String);
  1529. begin
  1530. ShowGettedFace(Dest_file);
  1531. end;
  1532. procedure TGroup.SetAlias(ATeamID, ALoginName, Alias: String);
  1533. var
  1534. jo,
  1535. jouser,
  1536. t: ISuperObject;
  1537. SendStr: String;
  1538. begin
  1539. jo := SO();
  1540. jo.S['name'] := 'group.member.update';
  1541. jo.S['args.id'] := ATeamID;
  1542. t := SA([]);
  1543. jouser := SO();
  1544. jouser.S['id'] := ALoginName;
  1545. jouser.S['alias'] := Alias;
  1546. t.AsArray.Add(jouser);
  1547. jo['args.users'] := t;
  1548. SendStr := '5:::' + jo.AsJSon(False,False);
  1549. Send(SendStr);
  1550. end;
  1551. procedure TGroup.SendFilesRequest(AGroupId, AUserId,
  1552. FileName: String);
  1553. var
  1554. jo,jofile: ISuperObject;
  1555. t : ISuperObject;
  1556. SendFileStr: String;
  1557. MD5HashValue: MD5Digest;
  1558. MD5HashString: String;
  1559. begin
  1560. MD5HashValue := MD5File(FileName);
  1561. MD5HashString := MD5.MD5Print(MD5HashValue);
  1562. jo := SO();
  1563. jo.S['name'] := 'file.upload';
  1564. jo.S['args.groupid'] := AGroupId;
  1565. jo.S['args.userid'] := AUserId;
  1566. jo.S['args.id'] := '';
  1567. t := SA([]);
  1568. jofile := SO();
  1569. jofile.S['file'] := ExtractFileName(filename);
  1570. jofile.S['hash'] := UpperCase(MD5HashString);
  1571. t.AsArray.Add(jofile);
  1572. jo['args.files'] := t;
  1573. SendFileStr := '5:::' + jo.AsJSon(False,False);
  1574. Send(SendFileStr);
  1575. end;
  1576. procedure TGroup.CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: String;
  1577. ATeamMembers: TStringList; AIsTempTeam: Boolean);
  1578. var
  1579. createGroup:String;
  1580. jo: ISuperObject;
  1581. ja: TSuperArray;
  1582. iLoop: Integer;
  1583. begin
  1584. jo := SO('{"name":"group.add","args":{"name":"","type":"","creator":"","users":[]}}');
  1585. jo.S['args.name'] := Trim(ATeamName);
  1586. jo.I['args.type'] := 0;
  1587. jo.S['args.creator'] := FLoginName;
  1588. ja := jo.A['args.users'];
  1589. for iLoop := 1 to ATeamMembers.Count - 1 do
  1590. ja.S[iloop-1] := ATeamMembers[iLoop];
  1591. createGroup := '5:::'+ jo.AsJSon(False, False);
  1592. Send(createGroup);
  1593. end;
  1594. {$ENDREGION}
  1595. end.