GroupClient.pas 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699
  1. unit GroupClient;
  2. interface
  3. uses
  4. superobject, GroupUtility, WebSocket2, WebSocketClient, Classes, Graphics,
  5. blcksock, SysUtils, DateUtils, GroupConfig, GroupProtocols, synautil,RealICQModel;
  6. type
  7. //表情类
  8. // TFace = class
  9. // private
  10. // FName: String;
  11. // FShortCut: String;
  12. // FFileName: String;
  13. // FMD5Code: String;
  14. // FCategory: String;
  15. // procedure SetFileName(const Value: String);
  16. // public
  17. //// constructor Create(AFileName, AShortCut, AName, AMD5Code: String; ACategory: String);
  18. //// procedure Assign(AFace: TFace);
  19. //// procedure SetFileName(Value: String);
  20. // published
  21. // property Name: String read FName write FName;
  22. // property ShortCut: String read FShortCut write FShortCut;
  23. // property FileName: String read FFileName write SetFileName;
  24. // property MD5Code: String read FMD5Code write FMD5Code;
  25. // property Category: String read FCategory write FCategory;
  26. // end;
  27. TGroupClient = class
  28. private
  29. FClient: TTestWebSocketClientConnection;
  30. FProtocol: TGroupProtocol;
  31. FLoginName: string;
  32. FConnected: Boolean;
  33. FGroupMonitor: TObject;
  34. FLastRecvMsg: ISuperObject;
  35. procedure GetMyGroups;
  36. procedure OnOpen(aSender: TWebSocketCustomConnection);
  37. procedure OnRead(aSender: TWebSocketCustomConnection; aFinal, aRes1, aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream);
  38. procedure OnClose(aSender: TWebSocketCustomConnection; aCloseCode: integer; aCloseReason: string; aClosedByPeer: boolean);
  39. public
  40. constructor Create();
  41. destructor Destroy; override;
  42. procedure Send(AData: string); overload;
  43. procedure Send(AProtocol: string; AData: ISuperObject); overload;
  44. procedure Ping;
  45. function Connect(ALoginName: string = ''): Boolean;
  46. procedure Disconnect;
  47. { TODO -olqq -c : 群组操作 2015/6/2 9:50:42 }
  48. procedure CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: string; ATeamMembers: TStringList; AIsTempTeam: Boolean);
  49. procedure RemoveTeam(ATeamID: string);
  50. procedure UpdateTeamInfo(ATeamID, AIntro, ANotice, AName: string; AAuth: Integer);
  51. procedure SearchTeam(ATeamID, AName, AIntro, ANotice: string; AMatchingType: TRealICQMatchingType; ASkip: Integer = 0; ALimit: Integer = 20);
  52. procedure AsynTeam(ATeamID: string);
  53. procedure GetHistoryMessageCount(ATeamID: string);
  54. procedure GetHistoryMessages(ATeamID: string; ts: Cardinal);
  55. procedure ChangeActiveDevice;
  56. { TODO -olqq -c : 群成员操作 2015/6/2 10:03:30 }
  57. procedure AddTeamMembers(ATeamID: string; AMembersID, AManagersID: TStringList);
  58. procedure RemoveTeamMembers(ATeamID: string; AMembersID, AManagersID: TStringList);
  59. procedure SetAlias(ATeamID, AMemberID, Alias: string);
  60. function GetAlias(ATeamID, AMemberID: string): string;
  61. procedure InviteJoin(ATeamID,AOperatorID,AOperatorMsg: string;AMembers: TStringList);
  62. procedure JoinTeam(ATeamID, AMsg: string);
  63. procedure JoinTeamResponse(ATeamID, ALoginName, ATag: string; Accepted: Boolean);
  64. { TODO -olqq -c : 群消息 2015/6/2 10:11:20 }
  65. procedure SendTeamMessage(ATeamID, ASender, AMsg: string; AFont: TFont; AFaces: TStringList; Attachs: String);
  66. procedure GetOffineMessage;
  67. procedure MessageMisc(ATeamID: string);
  68. procedure MessageMiscMust(ATeamID: string);
  69. { TODO -olqq -c : 群图片 2015/6/3 9:39:26 }
  70. function UploadFile(Hash, FileName, ID, GroupID: string): Boolean;
  71. procedure SendFilesRequest(AGroupId, AUserId, FileName: string);
  72. property Connected: Boolean read FConnected write FConnected;
  73. end;
  74. implementation
  75. uses
  76. IdHTTP, LoggerImport, GroupMonitor, xFonts, {MainFrm,} IdMultipartFormData,
  77. HTTPApp, RealICQClient, RealICQUtility;
  78. const
  79. UPLOAD_URL: string = 'http://%s:%d/file/upload';
  80. { TGroupClient }
  81. procedure TGroupClient.CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: String;
  82. ATeamMembers: TStringList; AIsTempTeam: Boolean);
  83. var
  84. createGroup:String;
  85. jo, AData: ISuperObject;
  86. AMemebers: TSuperArray;
  87. iLoop: Integer;
  88. begin
  89. jo := SO(GROUP_CREATE_JSON);
  90. jo.S['id'] := '';
  91. jo.S['group.name'] := Trim(ATeamName);
  92. jo.I['group.type'] := 0;
  93. jo.S['group.creator'] := FLoginName;
  94. jo.S['group.intro'] := Trim(ATeamIntro);
  95. jo.S['group.notice'] := Trim(ATeamCallBoard);
  96. AMemebers := jo.A['group.members'];
  97. for iLoop := 0 to ATeamMembers.Count - 1 do
  98. AMemebers.S[iloop] := ATeamMembers[iLoop];
  99. Send(GROUP_CREATE_REQUEST, jo);
  100. end;
  101. procedure TGroupClient.RemoveTeam(ATeamID: String);
  102. var
  103. jo: ISuperObject;
  104. begin
  105. jo := SO('{"id":"", "group":{"id":""}}');
  106. jo.S['group.id'] := ATeamID;
  107. Send(GROUP_DEL_REQUEST, jo);
  108. end;
  109. procedure TGroupClient.UpdateTeamInfo(ATeamID, AIntro, ANotice, AName: string;
  110. AAuth: Integer);
  111. var
  112. jo: ISuperObject;
  113. begin
  114. jo := SO('{"id":"", "group":{"id":"","intro":"","notice":"","name":"","auth":0}}');
  115. jo.S['group.id'] := ATeamID;
  116. jo.S['group.intro'] := AIntro;
  117. jo.S['group.notice'] := ANotice;
  118. jo.S['group.name'] := AName;
  119. jo.I['group.auth'] := AAuth;
  120. Send(GROUP_UPDATE_REQUEST, jo);
  121. end;
  122. procedure TGroupClient.AsynTeam(ATeamID: String);
  123. var
  124. jo: ISuperObject;
  125. begin
  126. jo := SO('{"id":"","group":{"id":""}}');
  127. jo.S['group.id'] := ATeamID;
  128. Send(GROUP_GET_REQUEST, jo);
  129. end;
  130. procedure TGroupClient.SearchTeam(ATeamID, AName, AIntro, ANotice: string;
  131. AMatchingType: TRealICQMatchingType; ASkip: Integer = 0; ALimit: Integer = 20);
  132. var
  133. jo: ISuperObject;
  134. SearchGroup: String;
  135. begin
  136. jo := SO('{"id":"","group":{"id":"","intro":"","name":"","notice":""},"skip":0,"limit":0}');
  137. jo.S['group.id'] := ATeamID;
  138. if AIntro <> '' then
  139. begin
  140. if AMatchingType = mtLikeSearch then
  141. jo.S['group.intro'] := '*' + AIntro
  142. else
  143. jo.S['group.intro'] := AIntro;
  144. end;
  145. if AName <> '' then
  146. begin
  147. if AMatchingType = mtLikeSearch then
  148. jo.S['group.name'] := '*' + AName
  149. else
  150. jo.S['group.name'] := AName;
  151. end;
  152. if ANotice <> '' then
  153. begin
  154. if AMatchingType = mtLikeSearch then
  155. jo.S['group.notice'] := '*' + ANotice
  156. else
  157. jo.S['group.notice'] := ANotice;
  158. end;
  159. jo.I['skip'] := ASkip;
  160. jo.I['limit'] := ALimit;
  161. Send(GROUP_QUERY_REQUEST, jo);
  162. end;
  163. procedure TGroupClient.AddTeamMembers(ATeamID: string; AMembersID,
  164. AManagersID: TStringList);
  165. var
  166. jo :ISuperObject;
  167. ja,ja1: TSuperArray;
  168. iLoop : Integer;
  169. begin
  170. jo := SO('{"id":"", "group":{"id":"","members":[],"managers": []}}');
  171. jo.S['group.id'] := ATeamID;
  172. ja := jo.A['group.members'];
  173. if (AMembersID <> nil) then
  174. for iLoop := 0 to AMembersID.Count - 1 do
  175. ja.S[iloop] := AMembersID[iLoop];
  176. ja1 := jo.A['group.managers'];
  177. if (AManagersID <> nil) then
  178. for iLoop := 0 to AManagersID.Count - 1 do
  179. ja1.S[iloop] := AManagersID[iLoop];
  180. Send(MEMBER_ADD_REQUEST, jo);
  181. end;
  182. procedure TGroupClient.RemoveTeamMembers(ATeamID: string; AMembersID,
  183. AManagersID: TStringList);
  184. var
  185. jo :ISuperObject;
  186. ja,ja1: TSuperArray;
  187. iLoop : Integer;
  188. begin
  189. jo := SO('{"id":"", "group":{"id":"","members":[],"managers": []}}');
  190. jo.S['group.id'] := ATeamID;
  191. if AMembersID <> nil then
  192. begin
  193. ja := jo.A['group.members'];
  194. for iLoop := 0 to AMembersID.Count - 1 do
  195. ja.S[iloop] := AMembersID[iLoop];
  196. end;
  197. if AManagersID <> nil then
  198. begin
  199. ja1 := jo.A['group.managers'];
  200. for iLoop := 0 to AManagersID.Count - 1 do
  201. ja1.S[iloop] := AManagersID[iLoop];
  202. end;
  203. Send(MEMBER_DEL_REQUEST, jo);
  204. end;
  205. procedure TGroupClient.SetAlias(ATeamID, AMemberID, Alias: string);
  206. var
  207. jo,jo1: ISuperObject;
  208. ja: TSuperArray;
  209. begin
  210. jo := SO('{"id":"","group":{"id":"","members":[]}}');
  211. jo1:= SO('{"id":"","alias":""}');
  212. jo.S['group.id']:= ATeamID;
  213. jo1.S['id'] := AMemberID;
  214. jo1.S['alias'] := Alias;
  215. ja := jo.A['group.members'];
  216. ja.Add(jo1);
  217. Send(MEMBER_UPDATE_REQUEST, jo);
  218. end;
  219. procedure TGroupClient.InviteJoin(ATeamID, AOperatorID, AOperatorMsg: string;
  220. AMembers: TStringList);
  221. var
  222. jo: ISuperObject;
  223. ja: TSuperArray;
  224. ILoop : Integer;
  225. begin
  226. jo := SO('{"id":"","group":{"id":"","members":[], "operator":{"id":"","msg":""}}}');
  227. jo.S['group.id']:= ATeamID;
  228. jo.S['group.operator.id']:= AOperatorID;
  229. jo.S['group.operator.msg']:= AOperatorMsg;
  230. ja := jo.A['group.members'];
  231. for iLoop := 0 to AMembers.Count - 1 do
  232. ja.S[iloop] := AMembers[iLoop];
  233. Send(INVITE_REQUEST, jo);
  234. end;
  235. procedure TGroupClient.JoinTeam(ATeamID, AMsg: string);
  236. var
  237. jo: ISuperObject;
  238. begin
  239. jo := SO('{"group":{"id":"","apply":{"uid":"","msg":""}}}');
  240. jo.S['group.id'] := ATeamID;
  241. jo.S['group.apply.msg'] := AMsg;
  242. jo.S['group.apply.uid'] := FLoginName;
  243. Send(MEMBER_APPLY_REQUEST, jo);
  244. end;
  245. procedure TGroupClient.JoinTeamResponse(ATeamID, ALoginName, ATag: string; Accepted: Boolean);
  246. var
  247. jo: ISuperObject;
  248. begin
  249. jo := SO('{"id":"","group":{"id":"","apply":{"uid":""},"reply":{"uid":"", "ret":0}}}');
  250. jo.S['group.id'] := ATeamID;
  251. jo.S['group.apply.uid'] := ALoginName;
  252. jo.S['group.reply.uid'] := FLoginName;
  253. jo.S['group.reply.msg'] := ATag;
  254. if Accepted then
  255. jo.I['group.reply.ret'] := 1
  256. else
  257. jo.I['group.reply.ret'] := 0;
  258. Send(MEMBER_REPLY_REQUEST, jo);
  259. end;
  260. procedure TGroupClient.SendTeamMessage(ATeamID, ASender, AMsg: String;
  261. AFont: TFont; AFaces: TStringList; Attachs: String);
  262. var
  263. jo, jofile, joNotify, joFont: ISuperObject;
  264. ja, jaHashs: TSuperArray;
  265. iLoop : Integer;
  266. sendstr: String;
  267. AFace: TFace;
  268. IMG_TAG, ATT_TAG: string;
  269. begin
  270. if Attachs <> '' then
  271. ATT_TAG := ',"attach":[]';
  272. if AFaces.Count > 0 then
  273. IMG_TAG := ',"img":[]';
  274. jo := SO('{"group":{"id":""},"content":""}');
  275. // if (Attachs = '') and (AFaces.Count = 0) then
  276. // jo := SO('{"group":{"id":""},"txt":""}')
  277. // else if (Attachs = '') and (AFaces.Count > 0) then
  278. // jo := SO('{"grou p":{"id":""},"txt":"","img":[]}')
  279. // else if (Attachs <> '') and (AFaces.Count = 0) then
  280. // jo := SO('{"group":{"id":""},"txt":"","attach":[]}')
  281. // else
  282. // jo := SO('{"group":{"id":""},"txt":"","img":[],"attach":[]}');
  283. jo.S['group.id'] := ATeamID;
  284. jo.S['content'] := AMsg;
  285. jo.I['isDes'] := 0;
  286. jo.I['msgType'] := 1;
  287. jo.I['fromClient'] := 0;
  288. jo.I['networkType'] := 0;
  289. joFont := FontToJson(AFont);
  290. if joFont <> nil then
  291. jo.O['style'] := joFont;
  292. if Attachs <> '' then
  293. begin
  294. jo.A['attach'].S[0] := Attachs;
  295. end;
  296. if AFaces.Count > 0 then
  297. begin
  298. joNotify := SO('{"group":{"id":""},"hashs":[]}');
  299. joNotify.S['group.id'] := ATeamID;
  300. jaHashs := joNotify.A['hashs'];
  301. for iLoop := 0 to AFaces.Count - 1 do
  302. begin
  303. AFace := AFaces.Objects[iLoop] as TFace;
  304. jofile := SO();
  305. jofile.S['file'] := ExtractFileName(AFace.FileName);
  306. jofile.S['hash'] := LowerCase(AFace.MD5Code);
  307. // jo.A['img'].Add(jofile);
  308. if UploadFile(jofile.S['hash'], jofile.S['file'], '', ATeamID) then
  309. jaHashs.Add(jofile);
  310. end;
  311. Send(MESSAGE_SAY_REQUEST, jo);
  312. if jaHashs.Length > 0 then
  313. Send(FILE_UPLOADED_REQUEST, joNotify);
  314. Exit;
  315. end;
  316. TRealICQUtility.FreeStringList(AFaces);
  317. Send(MESSAGE_SAY_REQUEST, jo);
  318. // MessageMisc(ATeamID);
  319. ChangeActiveDevice;
  320. end;
  321. procedure TGroupClient.MessageMisc(ATeamID: string);
  322. var
  323. ATick: Cardinal;
  324. begin
  325. ATick := FLastRecvMsg.I[ATeamID];
  326. if (ATick <> 0) and (GetTick - ATick < 5000) then
  327. Exit;
  328. MessageMiscMust(ATeamID);
  329. FLastRecvMsg.I[ATeamID] := GetTick;
  330. end;
  331. procedure TGroupClient.MessageMiscMust(ATeamID: string);
  332. var
  333. jo: ISuperObject;
  334. begin
  335. jo := SO('{"group":[]}');
  336. jo.A['group'].S[0] := ATeamID;
  337. Send(MARK_MK_REQUEST, jo);
  338. end;
  339. function GetSID(AResponseStr: string): string;
  340. var
  341. ACode: Byte;
  342. AStream: TStringStream;
  343. Len: Int64;
  344. begin
  345. Result := '';
  346. AStream := TStringStream.Create(AResponseStr);
  347. try
  348. AStream.Position :=1;
  349. Len := 0;
  350. AStream.Read(ACode, 1);
  351. while ACode <> $FF do
  352. begin
  353. Len := Len * 10;
  354. Inc(Len, ACode);
  355. AStream.Read(ACode, 1);
  356. end;
  357. //Code
  358. AStream.Read(ACode, 1);
  359. Result := AStream.ReadString(AStream.Size - AStream.Position);
  360. finally
  361. FreeAndNil(AStream);
  362. end;
  363. end;
  364. //{"socket":{"id":"639d9b0204f343a2acd5dfc3bf38b7f0","type":"mix","port":6714,"ver":"3.2.0","ip":"192.168.1.43","onlines":0},"storage":{"host":"127.0.0.1","port":6713}}
  365. function GatewayResponse(AJsonStr: string): Boolean;
  366. var
  367. jo: ISuperObject;
  368. config: TGroupConfig;
  369. begin
  370. Result := False;
  371. jo := SO(AJsonStr);
  372. if jo = nil then
  373. Exit;
  374. config := TGroupConfig.GetConfig;
  375. config.IP := jo.S['socket.host'];
  376. config.Port := jo.I['socket.port'];
  377. Success(Format('群组服务器:%s:%d', [config.IP, config.Port]), 'GatewayResponse');
  378. config.ImageIP := jo.S['storage.host'];
  379. config.ImagePort := jo.I['storage.port'];
  380. Result := True;
  381. end;
  382. procedure TGroupClient.ChangeActiveDevice;
  383. var
  384. jo: ISuperObject;
  385. begin
  386. jo := SO();
  387. jo.S['deviceID'] := 'pc';
  388. jo.B['on'] := True;
  389. Send(MARK_A_Q, jo);
  390. end;
  391. function TGroupClient.Connect(ALoginName: string = ''): Boolean;
  392. var
  393. AIdHttp:TIdHTTP;
  394. ResponeStr,sid: string;
  395. config: TGroupConfig;
  396. AURL: string;
  397. begin
  398. if ALoginName <> '' then
  399. FLoginName := ALoginName;
  400. if Trim(FLoginName) = '' then
  401. Exit;
  402. AIdHttp:= TIdHTTP.Create(nil);
  403. try
  404. config := TGroupConfig.GetConfig;
  405. if config.GatewayEnable then
  406. begin
  407. config.RandomGatewayServer;
  408. AURL := Format(GATEWAY_URL, [config.GatewayIP, config.GatewayPort]);
  409. ResponeStr := AIdHttp.Get(AURL);
  410. if not GatewayResponse(ResponeStr) then
  411. Exit;
  412. end;
  413. AURL := Format(SHAKEHANDS_STEP1, [config.IP, config.Port, HTTPEncode(AnsiToUtf8(FLoginName)), (DateTimeToUnix(Now) - 8*60*60) * 1000]);
  414. ResponeStr := AIdHttp.get(AURL);
  415. ResponeStr := GetSID(ResponeStr);
  416. sid := SO(ResponeStr).S['sid'];
  417. AURL := Format(SHAKEHANDS_STEP2, [config.IP, config.Port, HTTPEncode(AnsiToUtf8(FLoginName)), (DateTimeToUnix(Now) - 8*60*60) * 1000, sid]);
  418. ResponeStr := AIdHttp.get(AURL);
  419. if FClient <> nil then
  420. FreeAndNil(FClient);
  421. AURL := Format(WEBSOCKET_URL, [HTTPEncode(AnsiToUtf8(FLoginName)), sid]);
  422. FClient := TTestWebSocketClientConnection.Create(config.IP, IntToStr(config.Port), AURL, '-', 'ws');
  423. FClient.OnRead := OnRead;
  424. FClient.OnClose := OnClose;
  425. FClient.OnOpen := OnOpen;
  426. FClient.Start;
  427. except
  428. on E: Exception do
  429. begin
  430. Freeandnil(AIdHttp);
  431. Error(E.Message, 'TGroupClient.Connect');
  432. Exit;
  433. end;
  434. end;
  435. Freeandnil(AIdHttp);
  436. end;
  437. function TGroupClient.UploadFile(Hash, FileName, ID, GroupID: String): Boolean;
  438. var
  439. AHttp: TIdHttp;
  440. MutPartForm: TIdMultiPartFormDataStream;
  441. Ret:TStringStream;
  442. response,UpUrl: String;
  443. jo,t,jofile: ISuperObject;
  444. SendStr: String;
  445. config: TGroupConfig;
  446. begin
  447. Result := False;
  448. config := TGroupConfig.GetConfig;
  449. UpUrl := Format(UPLOAD_URL, [config.ImageIP, config.ImagePort]);
  450. AHttp := Tidhttp.Create(nil);
  451. AHttp.Request.ContentType:='multipart/form-data';
  452. AHttp.HandleRedirects := true;
  453. AHttp.AllowCookies := true;
  454. MutPartForm := TIdMultiPartFormDataStream.Create;
  455. MutPartForm.AddFile('file1', TRealICQClient.GetReceivedFaceDir+FileName,'');
  456. try
  457. response := AHttp.Post(UpUrl, MutPartForm);
  458. finally
  459. MutPartForm.Free;
  460. AHttp.Free;
  461. end;
  462. if response = 'ok' then
  463. Result := True;
  464. end;
  465. constructor TGroupClient.Create;
  466. begin
  467. FGroupMonitor := TGroupMonitor.Create;
  468. FProtocol := TGroupProtocol.Create(Self);
  469. FLastRecvMsg := SO('{}');
  470. end;
  471. destructor TGroupClient.Destroy;
  472. var
  473. PInt: PInteger;
  474. begin
  475. FreeAndNil(FGroupMonitor);
  476. if FClient <> nil then
  477. FreeAndNil(FClient);
  478. FLastRecvMsg := nil;
  479. FProtocol.Free;
  480. inherited;
  481. end;
  482. procedure TGroupClient.Disconnect;
  483. begin
  484. (FGroupMonitor as TGroupMonitor).Stop;
  485. (FGroupMonitor as TGroupMonitor).KeepAlive := False;
  486. if FConnected then
  487. begin
  488. FClient.Close(wsCloseNormal, 'goodbye');
  489. FConnected := False;
  490. end;
  491. end;
  492. function TGroupClient.GetAlias(ATeamID, AMemberID: string): string;
  493. begin
  494. end;
  495. procedure TGroupClient.GetHistoryMessageCount(ATeamID: string);
  496. var
  497. jo: ISuperObject;
  498. begin
  499. jo := SO();
  500. jo.N['filter'].S['group'] := ATeamID;
  501. Send(HISTORY_C_Q, jo);
  502. end;
  503. {
  504. group: <id>|<Group>, // 群组编号
  505. ts: <Number>|<String>, // * > >= < <= = Number
  506. skip: <Number>, // *偏移
  507. limit: <Number> // *限制
  508. }
  509. procedure TGroupClient.GetHistoryMessages(ATeamID: string; ts: Cardinal);
  510. var
  511. jo, joFilter: ISuperObject;
  512. begin
  513. if ts = 0 then
  514. Exit;
  515. jo := SO();
  516. joFilter := SO();
  517. joFilter.S['group'] := ATeamID;
  518. joFilter.S['ts'] := '<'+ IntToStr(ts);
  519. joFilter.I['limit'] := 10000;
  520. jo.O['filter'] := joFilter;
  521. Send(HISTORY_H_Q, jo);
  522. end;
  523. procedure TGroupClient.GetMyGroups;
  524. var
  525. jo: ISuperObject;
  526. begin
  527. jo := SO('{}');
  528. jo.S['user'] := FLoginName;
  529. Send(USER_LI_REQUEST, jo);
  530. end;
  531. procedure TGroupClient.GetOffineMessage;
  532. var
  533. jo: ISuperObject;
  534. begin
  535. // jo := SO('{}');
  536. // jo.S['uid'] := FLoginName;
  537. // Send(MESSAGE_OFFLINE_REQUEST, jo);
  538. end;
  539. procedure TGroupClient.OnClose(aSender: TWebSocketCustomConnection;
  540. aCloseCode: integer; aCloseReason: string; aClosedByPeer: boolean);
  541. begin
  542. FConnected := False;
  543. FClient := nil;
  544. (FGroupMonitor as TGroupMonitor).Stop;
  545. if (aClosedByPeer) or (aCloseCode <> 1000) then
  546. begin
  547. Error(Format('异常断开. Code:%d;Reson:%s;ClolsedByPeer:%s;', [aCloseCode, aCloseReason, BoolToStr(aClosedByPeer)]), 'TGroupClient.OnClose');
  548. end
  549. else
  550. Success(Format('正常断开. Code:%d;Reson:%s;ClolsedByPeer:%s;', [aCloseCode, aCloseReason, BoolToStr(aClosedByPeer)]), 'TGroupClient.OnClose');
  551. end;
  552. procedure TGroupClient.OnOpen(aSender: TWebSocketCustomConnection);
  553. begin
  554. Success(FLoginName, 'OnOpen');
  555. FConnected := True;
  556. FClient.SendText('2probe');
  557. (FGroupMonitor as TGroupMonitor).Start(Self);
  558. (FGroupMonitor as TGroupMonitor).KeepAlive := True;
  559. // GetMyGroups;
  560. end;
  561. procedure TGroupClient.OnRead(aSender: TWebSocketCustomConnection; aFinal,
  562. aRes1, aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream);
  563. var
  564. s,Recvdata: string;
  565. c: TTestWebSocketClientConnection;
  566. begin
  567. try
  568. (FGroupMonitor as TGroupMonitor).ReflashLastTime;
  569. c := TTestWebSocketClientConnection(aSender);
  570. s := ReadStrFromStream(c.ReadStream, c.ReadStream.size{min(c.ReadStream.size, 10 * 1024)});
  571. if (c.ReadCode = wsCodeText) then
  572. Recvdata := utf8toansi(s)//CharsetConversion(s, UTF_8, GetCurCP)
  573. else
  574. Recvdata := s;
  575. if SameText(Recvdata, '3probe') then
  576. begin
  577. FClient.SendText('5');
  578. GetMyGroups;
  579. Exit;
  580. end;
  581. Success(Recvdata, 'TGroupClient.OnRead');
  582. if (Length(Recvdata) < 4) or (FProtocol = nil) then
  583. Exit;
  584. FProtocol.Proccess(Recvdata);
  585. except
  586. on E: Exception do
  587. Error(E.Message, 'TGroupClient.OnRead('+Recvdata+')');
  588. end;
  589. end;
  590. procedure TGroupClient.Ping;
  591. begin
  592. if (FClient <> nil) and (not FClient.Closed) then
  593. FClient.SendText('2');
  594. end;
  595. procedure TGroupClient.Send(AProtocol: string; AData: ISuperObject);
  596. var
  597. AJo: ISuperObject;
  598. begin
  599. AJo := SO('[]');
  600. AJo.AsArray.S[0] := AProtocol;
  601. AJo.AsArray.O[1] := AData;
  602. Send('42' + AJo.Asjson);
  603. end;
  604. procedure TGroupClient.Send(AData: string);
  605. begin
  606. try
  607. if (FClient <> nil) and (not FClient.Closed) then
  608. FClient.SendText(AnsiToUTF8(AData));
  609. Success(AData, 'TGroupClient.Send');
  610. except
  611. on E: Exception do
  612. begin
  613. Error(E.Message, 'TGroupClient.Send('+AData+')');
  614. end;
  615. end;
  616. end;
  617. procedure TGroupClient.SendFilesRequest(AGroupId, AUserId, FileName: String);
  618. begin
  619. end;
  620. end.