unit GroupClient; interface uses superobject, GroupUtility, WebSocket2, WebSocketClient, Classes, Graphics, blcksock, SysUtils, DateUtils, GroupConfig, GroupProtocols, synautil,RealICQModel; type //表情类 // TFace = class // private // FName: String; // FShortCut: String; // FFileName: String; // FMD5Code: String; // FCategory: String; // procedure SetFileName(const Value: String); // public //// constructor Create(AFileName, AShortCut, AName, AMD5Code: String; ACategory: String); //// procedure Assign(AFace: TFace); //// procedure SetFileName(Value: String); // published // property Name: String read FName write FName; // property ShortCut: String read FShortCut write FShortCut; // property FileName: String read FFileName write SetFileName; // property MD5Code: String read FMD5Code write FMD5Code; // property Category: String read FCategory write FCategory; // end; TGroupClient = class private FClient: TTestWebSocketClientConnection; FProtocol: TGroupProtocol; FLoginName: string; FConnected: Boolean; FGroupMonitor: TObject; FLastRecvMsg: ISuperObject; procedure GetMyGroups; procedure OnOpen(aSender: TWebSocketCustomConnection); procedure OnRead(aSender: TWebSocketCustomConnection; aFinal, aRes1, aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream); procedure OnClose(aSender: TWebSocketCustomConnection; aCloseCode: integer; aCloseReason: string; aClosedByPeer: boolean); public constructor Create(); destructor Destroy; override; procedure Send(AData: string); overload; procedure Send(AProtocol: string; AData: ISuperObject); overload; procedure Ping; function Connect(ALoginName: string = ''): Boolean; procedure Disconnect; { TODO -olqq -c : 群组操作 2015/6/2 9:50:42 } procedure CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: string; ATeamMembers: TStringList; AIsTempTeam: Boolean); procedure RemoveTeam(ATeamID: string); procedure UpdateTeamInfo(ATeamID, AIntro, ANotice, AName: string; AAuth: Integer); procedure SearchTeam(ATeamID, AName, AIntro, ANotice: string; AMatchingType: TRealICQMatchingType; ASkip: Integer = 0; ALimit: Integer = 20); procedure AsynTeam(ATeamID: string); { TODO -olqq -c : 群成员操作 2015/6/2 10:03:30 } procedure AddTeamMembers(ATeamID: string; AMembersID, AManagersID: TStringList); procedure RemoveTeamMembers(ATeamID: string; AMembersID, AManagersID: TStringList); procedure SetAlias(ATeamID, AMemberID, Alias: string); function GetAlias(ATeamID, AMemberID: string): string; procedure InviteJoin(ATeamID,AOperatorID,AOperatorMsg: string;AMembers: TStringList); procedure JoinTeam(ATeamID, AMsg: string); procedure JoinTeamResponse(ATeamID, ALoginName, ATag: string; Accepted: Boolean); { TODO -olqq -c : 群消息 2015/6/2 10:11:20 } procedure SendTeamMessage(ATeamID, ASender, AMsg: string; AFont: TFont; AFaces: TStringList; Attachs: String); procedure GetOffineMessage; procedure MessageMisc(ATeamID: string); procedure MessageMiscMust(ATeamID: string); { TODO -olqq -c : 群图片 2015/6/3 9:39:26 } function UploadFile(Hash, FileName, ID, GroupID: string): Boolean; procedure SendFilesRequest(AGroupId, AUserId, FileName: string); property Connected: Boolean read FConnected write FConnected; end; implementation uses IdHTTP, LoggerImport, GroupMonitor, xFonts, {MainFrm,} IdMultipartFormData, HTTPApp, RealICQClient; const UPLOAD_URL: string = 'http://%s:%d/file/upload'; { TGroupClient } procedure TGroupClient.CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: String; ATeamMembers: TStringList; AIsTempTeam: Boolean); var createGroup:String; jo, AData: ISuperObject; AMemebers: TSuperArray; iLoop: Integer; begin jo := SO(GROUP_CREATE_JSON); jo.S['id'] := ''; jo.S['group.name'] := Trim(ATeamName); jo.I['group.type'] := 0; jo.S['group.creator'] := FLoginName; jo.S['group.intro'] := Trim(ATeamIntro); jo.S['group.notice'] := Trim(ATeamCallBoard); AMemebers := jo.A['group.members']; for iLoop := 0 to ATeamMembers.Count - 1 do AMemebers.S[iloop] := ATeamMembers[iLoop]; Send(GROUP_CREATE_REQUEST, jo); end; procedure TGroupClient.RemoveTeam(ATeamID: String); var jo: ISuperObject; begin jo := SO('{"id":"", "group":{"id":""}}'); jo.S['group.id'] := ATeamID; Send(GROUP_DEL_REQUEST, jo); end; procedure TGroupClient.UpdateTeamInfo(ATeamID, AIntro, ANotice, AName: string; AAuth: Integer); var jo: ISuperObject; begin jo := SO('{"id":"", "group":{"id":"","intro":"","notice":"","name":"","auth":0}}'); jo.S['group.id'] := ATeamID; jo.S['group.intro'] := AIntro; jo.S['group.notice'] := ANotice; jo.S['group.name'] := AName; jo.I['group.auth'] := AAuth; Send(GROUP_UPDATE_REQUEST, jo); end; procedure TGroupClient.AsynTeam(ATeamID: String); var jo: ISuperObject; begin jo := SO('{"id":"","group":{"id":""}}'); jo.S['group.id'] := ATeamID; Send(GROUP_GET_REQUEST, jo); end; procedure TGroupClient.SearchTeam(ATeamID, AName, AIntro, ANotice: string; AMatchingType: TRealICQMatchingType; ASkip: Integer = 0; ALimit: Integer = 20); var jo: ISuperObject; SearchGroup: String; begin jo := SO('{"id":"","group":{"id":"","intro":"","name":"","notice":""},"skip":0,"limit":0}'); jo.S['group.id'] := ATeamID; if AIntro <> '' then begin if AMatchingType = mtLikeSearch then jo.S['group.intro'] := '*' + AIntro else jo.S['group.intro'] := AIntro; end; if AName <> '' then begin if AMatchingType = mtLikeSearch then jo.S['group.name'] := '*' + AName else jo.S['group.name'] := AName; end; if ANotice <> '' then begin if AMatchingType = mtLikeSearch then jo.S['group.notice'] := '*' + ANotice else jo.S['group.notice'] := ANotice; end; jo.I['skip'] := ASkip; jo.I['limit'] := ALimit; Send(GROUP_QUERY_REQUEST, jo); end; procedure TGroupClient.AddTeamMembers(ATeamID: string; AMembersID, AManagersID: TStringList); var jo :ISuperObject; ja,ja1: TSuperArray; iLoop : Integer; begin jo := SO('{"id":"", "group":{"id":"","members":[],"managers": []}}'); jo.S['group.id'] := ATeamID; ja := jo.A['group.members']; if (AMembersID <> nil) then for iLoop := 0 to AMembersID.Count - 1 do ja.S[iloop] := AMembersID[iLoop]; ja1 := jo.A['group.managers']; if (AManagersID <> nil) then for iLoop := 0 to AManagersID.Count - 1 do ja1.S[iloop] := AManagersID[iLoop]; Send(MEMBER_ADD_REQUEST, jo); end; procedure TGroupClient.RemoveTeamMembers(ATeamID: string; AMembersID, AManagersID: TStringList); var jo :ISuperObject; ja,ja1: TSuperArray; iLoop : Integer; begin jo := SO('{"id":"", "group":{"id":"","members":[],"managers": []}}'); jo.S['group.id'] := ATeamID; if AMembersID <> nil then begin ja := jo.A['group.members']; for iLoop := 0 to AMembersID.Count - 1 do ja.S[iloop] := AMembersID[iLoop]; end; if AManagersID <> nil then begin ja1 := jo.A['group.managers']; for iLoop := 0 to AManagersID.Count - 1 do ja1.S[iloop] := AManagersID[iLoop]; end; Send(MEMBER_DEL_REQUEST, jo); end; procedure TGroupClient.SetAlias(ATeamID, AMemberID, Alias: string); var jo,jo1: ISuperObject; ja: TSuperArray; begin jo := SO('{"id":"","group":{"id":"","members":[]}}'); jo1:= SO('{"id":"","alias":""}'); jo.S['group.id']:= ATeamID; jo1.S['id'] := AMemberID; jo1.S['alias'] := Alias; ja := jo.A['group.members']; ja.Add(jo1); Send(MEMBER_UPDATE_REQUEST, jo); end; procedure TGroupClient.InviteJoin(ATeamID, AOperatorID, AOperatorMsg: string; AMembers: TStringList); var jo: ISuperObject; ja: TSuperArray; ILoop : Integer; begin jo := SO('{"id":"","group":{"id":"","members":[], "operator":{"id":"","msg":""}}}'); jo.S['group.id']:= ATeamID; jo.S['group.operator.id']:= AOperatorID; jo.S['group.operator.msg']:= AOperatorMsg; ja := jo.A['group.members']; for iLoop := 0 to AMembers.Count - 1 do ja.S[iloop] := AMembers[iLoop]; Send(INVITE_REQUEST, jo); end; procedure TGroupClient.JoinTeam(ATeamID, AMsg: string); var jo: ISuperObject; begin jo := SO('{"group":{"id":"","apply":{"uid":"","msg":""}}}'); jo.S['group.id'] := ATeamID; jo.S['group.apply.msg'] := AMsg; jo.S['group.apply.uid'] := FLoginName; Send(MEMBER_APPLY_REQUEST, jo); end; procedure TGroupClient.JoinTeamResponse(ATeamID, ALoginName, ATag: string; Accepted: Boolean); var jo: ISuperObject; begin jo := SO('{"id":"","group":{"id":"","apply":{"uid":""},"reply":{"uid":"", "ret":0}}}'); jo.S['group.id'] := ATeamID; jo.S['group.apply.uid'] := ALoginName; jo.S['group.reply.uid'] := FLoginName; jo.S['group.reply.msg'] := ATag; if Accepted then jo.I['group.reply.ret'] := 1 else jo.I['group.reply.ret'] := 0; Send(MEMBER_REPLY_REQUEST, jo); end; procedure TGroupClient.SendTeamMessage(ATeamID, ASender, AMsg: String; AFont: TFont; AFaces: TStringList; Attachs: String); var jo, jofile, joNotify, joFont: ISuperObject; ja, jaHashs: TSuperArray; iLoop : Integer; sendstr: String; AFace: TFace; IMG_TAG, ATT_TAG: string; begin if Attachs <> '' then ATT_TAG := ',"attach":[]'; if AFaces.Count > 0 then IMG_TAG := ',"img":[]'; jo := SO('{"group":{"id":""},"content":""}'); // if (Attachs = '') and (AFaces.Count = 0) then // jo := SO('{"group":{"id":""},"txt":""}') // else if (Attachs = '') and (AFaces.Count > 0) then // jo := SO('{"grou p":{"id":""},"txt":"","img":[]}') // else if (Attachs <> '') and (AFaces.Count = 0) then // jo := SO('{"group":{"id":""},"txt":"","attach":[]}') // else // jo := SO('{"group":{"id":""},"txt":"","img":[],"attach":[]}'); jo.S['group.id'] := ATeamID; jo.S['content'] := AMsg; jo.I['isDes'] := 0; jo.I['msgType'] := 1; jo.I['fromClient'] := 0; jo.I['networkType'] := 0; joFont := FontToJson(AFont); if joFont <> nil then jo.O['style'] := joFont; if Attachs <> '' then begin jo.A['attach'].S[0] := Attachs; end; if AFaces.Count > 0 then begin joNotify := SO('{"group":{"id":""},"hashs":[]}'); joNotify.S['group.id'] := ATeamID; jaHashs := joNotify.A['hashs']; for iLoop := 0 to AFaces.Count - 1 do begin AFace := AFaces.Objects[iLoop] as TFace; jofile := SO(); jofile.S['file'] := ExtractFileName(AFace.FileName); jofile.S['hash'] := LowerCase(AFace.MD5Code); // jo.A['img'].Add(jofile); if UploadFile(jofile.S['hash'], jofile.S['file'], '', ATeamID) then jaHashs.Add(jofile); end; Send(MESSAGE_SAY_REQUEST, jo); if jaHashs.Length > 0 then Send(FILE_UPLOADED_REQUEST, joNotify); Exit; end; Send(MESSAGE_SAY_REQUEST, jo); MessageMisc(ATeamID); end; procedure TGroupClient.MessageMisc(ATeamID: string); var ATick: Cardinal; begin ATick := FLastRecvMsg.I[ATeamID]; if (ATick <> 0) and (GetTick - ATick < 5000) then Exit; MessageMiscMust(ATeamID); FLastRecvMsg.I[ATeamID] := GetTick; end; procedure TGroupClient.MessageMiscMust(ATeamID: string); var jo: ISuperObject; begin jo := SO('{"id":"","msg":[], ev:[]}'); jo.A['msg'].S[0] := ATeamID; Send(MARK_MK_REQUEST, jo); end; function GetSID(AResponseStr: string): string; var ACode: Byte; AStream: TStringStream; Len: Int64; begin Result := ''; AStream := TStringStream.Create(AResponseStr); try AStream.Position :=1; Len := 0; AStream.Read(ACode, 1); while ACode <> $FF do begin Len := Len * 10; Inc(Len, ACode); AStream.Read(ACode, 1); end; //Code AStream.Read(ACode, 1); Result := AStream.ReadString(AStream.Size - AStream.Position); finally FreeAndNil(AStream); end; end; //{"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}} function GatewayResponse(AJsonStr: string): Boolean; var jo: ISuperObject; config: TGroupConfig; begin Result := False; jo := SO(AJsonStr); if jo = nil then Exit; config := TGroupConfig.GetConfig; config.IP := jo.S['socket.host']; config.Port := jo.I['socket.port']; Success(Format('群组服务器:%s:%d', [config.IP, config.Port]), 'GatewayResponse'); config.ImageIP := jo.S['storage.host']; config.ImagePort := jo.I['storage.port']; Result := True; end; function TGroupClient.Connect(ALoginName: string = ''): Boolean; var AIdHttp:TIdHTTP; ResponeStr,sid: string; config: TGroupConfig; AURL: string; begin if ALoginName <> '' then FLoginName := ALoginName; if Trim(FLoginName) = '' then Exit; AIdHttp:= TIdHTTP.Create(nil); try config := TGroupConfig.GetConfig; if config.GatewayEnable then begin config.RandomGatewayServer; AURL := Format(GATEWAY_URL, [config.GatewayIP, config.GatewayPort]); ResponeStr := AIdHttp.Get(AURL); if not GatewayResponse(ResponeStr) then Exit; end; AURL := Format(SHAKEHANDS_STEP1, [config.IP, config.Port, HTTPEncode(AnsiToUtf8(FLoginName)), (DateTimeToUnix(Now) - 8*60*60) * 1000]); ResponeStr := AIdHttp.get(AURL); ResponeStr := GetSID(ResponeStr); sid := SO(ResponeStr).S['sid']; AURL := Format(SHAKEHANDS_STEP2, [config.IP, config.Port, HTTPEncode(AnsiToUtf8(FLoginName)), (DateTimeToUnix(Now) - 8*60*60) * 1000, sid]); ResponeStr := AIdHttp.get(AURL); if FClient <> nil then FreeAndNil(FClient); AURL := Format(WEBSOCKET_URL, [HTTPEncode(AnsiToUtf8(FLoginName)), sid]); FClient := TTestWebSocketClientConnection.Create(config.IP, IntToStr(config.Port), AURL, '-', 'ws'); FClient.OnRead := OnRead; FClient.OnClose := OnClose; FClient.OnOpen := OnOpen; FClient.Start; except on E: Exception do begin Freeandnil(AIdHttp); Error(E.Message, 'TGroupClient.Connect'); Exit; end; end; Freeandnil(AIdHttp); end; function TGroupClient.UploadFile(Hash, FileName, ID, GroupID: String): Boolean; var AHttp: TIdHttp; MutPartForm: TIdMultiPartFormDataStream; Ret:TStringStream; response,UpUrl: String; jo,t,jofile: ISuperObject; SendStr: String; config: TGroupConfig; begin Result := False; config := TGroupConfig.GetConfig; UpUrl := Format(UPLOAD_URL, [config.ImageIP, config.ImagePort]); AHttp := Tidhttp.Create(nil); AHttp.Request.ContentType:='multipart/form-data'; AHttp.HandleRedirects := true; AHttp.AllowCookies := true; MutPartForm := TIdMultiPartFormDataStream.Create; MutPartForm.AddFile('file1', TRealICQClient.GetReceivedFaceDir+FileName,''); try response := AHttp.Post(UpUrl, MutPartForm); finally MutPartForm.Free; AHttp.Free; end; if response = 'ok' then Result := True; end; constructor TGroupClient.Create; begin FGroupMonitor := TGroupMonitor.Create; FProtocol := TGroupProtocol.Create(Self); FLastRecvMsg := SO('{}'); end; destructor TGroupClient.Destroy; var PInt: PInteger; begin FreeAndNil(FGroupMonitor); if FClient <> nil then FreeAndNil(FClient); FLastRecvMsg := nil; FProtocol.Free; inherited; end; procedure TGroupClient.Disconnect; begin (FGroupMonitor as TGroupMonitor).Stop; (FGroupMonitor as TGroupMonitor).KeepAlive := False; if FConnected then begin FClient.Close(wsCloseNormal, 'goodbye'); FConnected := False; end; end; function TGroupClient.GetAlias(ATeamID, AMemberID: string): string; begin end; procedure TGroupClient.GetMyGroups; var jo: ISuperObject; begin jo := SO('{}'); jo.S['user'] := FLoginName; Send(USER_LI_REQUEST, jo); end; procedure TGroupClient.GetOffineMessage; var jo: ISuperObject; begin // jo := SO('{}'); // jo.S['uid'] := FLoginName; // Send(MESSAGE_OFFLINE_REQUEST, jo); end; procedure TGroupClient.OnClose(aSender: TWebSocketCustomConnection; aCloseCode: integer; aCloseReason: string; aClosedByPeer: boolean); begin FConnected := False; FClient := nil; (FGroupMonitor as TGroupMonitor).Stop; if (aClosedByPeer) or (aCloseCode <> 1000) then begin Error(Format('异常断开. Code:%d;Reson:%s;ClolsedByPeer:%s;', [aCloseCode, aCloseReason, BoolToStr(aClosedByPeer)]), 'TGroupClient.OnClose'); end else Success(Format('正常断开. Code:%d;Reson:%s;ClolsedByPeer:%s;', [aCloseCode, aCloseReason, BoolToStr(aClosedByPeer)]), 'TGroupClient.OnClose'); end; procedure TGroupClient.OnOpen(aSender: TWebSocketCustomConnection); begin Success(FLoginName, 'OnOpen'); FConnected := True; FClient.SendText('2probe'); (FGroupMonitor as TGroupMonitor).Start(Self); (FGroupMonitor as TGroupMonitor).KeepAlive := True; // GetMyGroups; end; procedure TGroupClient.OnRead(aSender: TWebSocketCustomConnection; aFinal, aRes1, aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream); var s,Recvdata: string; c: TTestWebSocketClientConnection; begin try (FGroupMonitor as TGroupMonitor).ReflashLastTime; c := TTestWebSocketClientConnection(aSender); s := ReadStrFromStream(c.ReadStream, c.ReadStream.size{min(c.ReadStream.size, 10 * 1024)}); if (c.ReadCode = wsCodeText) then Recvdata := utf8toansi(s)//CharsetConversion(s, UTF_8, GetCurCP) else Recvdata := s; if SameText(Recvdata, '3probe') then begin FClient.SendText('5'); GetMyGroups; Exit; end; Success(Recvdata, 'TGroupClient.OnRead'); if (Length(Recvdata) < 4) or (FProtocol = nil) then Exit; FProtocol.Proccess(Recvdata); except on E: Exception do Error(E.Message, 'TGroupClient.OnRead('+Recvdata+')'); end; end; procedure TGroupClient.Ping; begin if (FClient <> nil) and (not FClient.Closed) then FClient.SendText('2'); end; procedure TGroupClient.Send(AProtocol: string; AData: ISuperObject); var AJo: ISuperObject; begin AJo := SO('[]'); AJo.AsArray.S[0] := AProtocol; AJo.AsArray.O[1] := AData; Send('42' + AJo.Asjson); end; procedure TGroupClient.Send(AData: string); begin try if (FClient <> nil) and (not FClient.Closed) then FClient.SendText(AnsiToUTF8(AData)); Success(AData, 'TGroupClient.Send'); except on E: Exception do begin Error(E.Message, 'TGroupClient.Send('+AData+')'); end; end; end; procedure TGroupClient.SendFilesRequest(AGroupId, AUserId, FileName: String); begin end; end.