RealICQClient/Client/Group/GroupClient.pas

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.