RealICQClient/GroupClient/GroupClient.pas

unit GroupClient;

interface

uses
  superobject, GroupUtility, WebSocket2, WebSocketClient, Classes, Graphics,
  blcksock, SysUtils, DateUtils, GroupConfig, GroupProtocols, synautil;

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;

    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 SearchTeamById(ATeamID: string);
    procedure SearchTeam(ATeamID, AName, AIntro, ANotice: string; ASkip: Integer; ALimit: Integer = 20);
    { 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, AApplyId, AApplyMsg,AReplyId,AReplyUid,AReplyMsg: String);
    { TODO -olqq -c : 群消息 2015/6/2 10:11:20 }
    procedure SendTeamMessage(ATeamID, ASender, AMsg: string; AFont: TFont; AFaces: TStringList; Attachs: String);
    procedure MessageMisc(AMessagesID, AEventId: TStringList);
    { TODO -olqq -c : 群图片 2015/6/3 9:39:26 }
    procedure UploadFile(Hash, FileName, ID, GroupID: string);
    procedure DownloadTeamFace(AMD5String, AFileName, Path: string);
    procedure SendFilesRequest(AGroupId, AUserId, FileName: string);



    procedure Leave(ATeamID: string);
    procedure AddManager(ATeamID, AName: string);
    procedure RemoveManager(ATeamID, AName: string);
    procedure RemoveMember(ATeamID,AName: string);
    Procedure SendGetTeamInfo(ATeamID: string);



    property Connected: Boolean read FConnected write FConnected;
  end;

implementation

uses
  IdHTTP, LoggerImport, GroupMonitor, xFonts, {MainFrm,} IdMultipartFormData;

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.SearchTeamById(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; ASkip: Integer; 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;
  jo.S['group.intro'] := AName;
  jo.S['group.name'] := AIntro;
  jo.S['group.notice'] := ANotice;
  jo.I['group.skip'] := ASkip;
  jo.I['group.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'];
  for iLoop := 0 to AMembersID.Count - 1 do
    ja.S[iloop] := AMembersID[iLoop];

  ja1 := jo.A['group.managers'];
  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;
  ja := jo.A['group.members'];
  for iLoop := 0 to AMembersID.Count - 1 do
    ja.S[iloop] := AMembersID[iLoop];

  ja1 := jo.A['group.managers'];
  for iLoop := 0 to AManagersID.Count - 1 do
    ja1.S[iloop] := AManagersID[iLoop];

  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('{"id":"","group":{"id":"","apply":{"uid":"","msg":""}}}');
  jo.S['group.id']    := ATeamID;
  jo.S['group.apply.msg'] := AMsg;
  Send(MEMBER_REPLY_REQUEST, jo);
end;

procedure TGroupClient.JoinTeamResponse(ATeamID, AApplyId, AApplyMsg,AReplyId,AReplyUid,AReplyMsg: string);
var
  jo: ISuperObject;
begin
  jo := SO('{"id":"","group":{"id":"","apply":{"uid":"","msg":""},"reply":{"id":"", "uid":"", "ret":0, "msg":""}}}');
  jo.S['group.id']    := ATeamID;
  jo.S['group.apply.id'] := AApplyId;
  jo.S['group.apply.msg'] := AApplyMsg;

  jo.S['group.reply.id'] := AReplyId;
  jo.S['group.reply.uid'] := AReplyUid;
  jo.S['group.reply.msg'] := AReplyMsg;

  Send(MEMBER_REPLY_RESPONSE, jo);
end;

procedure TGroupClient.SendTeamMessage(ATeamID, ASender, AMsg: String;
  AFont: TFont; AFaces: TStringList; Attachs: String);
var
  jo, jofile: ISuperObject;
  ja: TSuperArray;
  iLoop : Integer;
  sendstr: String;
  AFace: TFace;
begin
  jo := SO('{"id":"","group":{"id":[]},"msg":{"id":"","sender":"","style":[],"ts":"","txt":"","img":[],"attach":[]}}');
  ja := jo.A['group.id'];
  ja.S[0] := ATeamID;
  jo.S['msg.txt'] := AMsg;
  jo.S['msg.sender'] := ASender;
  jo.A['msg.style'].S[0] := AFont.Name;
  jo.A['msg.style'].S[1] := inttostr(AFont.Size);
  jo.A['msg.style'].S[2] := ColorToString(AFont.Color);
  jo.A['msg.style'].S[3] := FontStyleToString(AFont);
  jo.A['msg.attach'].S[0] := Attachs;
  jo.S['msg.ts'] := IntToStr((DateTimeToUnix(Now) - 8*60*60) * 1000);

  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'] := UpperCase(AFace.MD5Code);
    jo.A['msg.img'].Add(jofile);
  end;

  Send(MESSAGE_SAY_REQUEST, jo);
end;

procedure TGroupClient.MessageMisc(AMessagesID, AEventId: TStringList);
var
  jo: ISuperObject;
  ja,ja1: TSuperArray;
  iLoop : Integer;
  sendstr: String;
begin
  jo := SO('{"id":"","message":{"id":[]},"event":{"id":[]}}');
  ja := jo.A['message.id'];
  for iLoop := 0 to AMessagesID.Count - 1 do
    ja.S[iloop] := AMessagesID[iLoop];

  ja1 := jo.A['event.id'];
  for iLoop := 0 to AEventId.Count - 1 do
    ja1.S[iloop] := AEventId[iLoop];

  Send(MARK_MK_REQUEST, jo);
end;

procedure TGroupClient.AddManager(ATeamID, AName: String);
begin

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;

function TGroupClient.Connect(ALoginName: string = ''): Boolean;
var
  AIdHttp:TIdHTTP;
  ResponeStr,sid: string;
  config: TGroupConfig;
begin
  if ALoginName <> '' then       
    FLoginName := ALoginName;
  if Trim(FLoginName) = '' then
    Exit;
    
  AIdHttp:= TIdHTTP.Create(nil);
  try
    config := TGroupConfig.GetConfig;
    ResponeStr := AIdHttp.get(Format(SHAKEHANDS_STEP1, [config.IP, config.Port, ALoginName, (DateTimeToUnix(Now) - 8*60*60) * 1000]));
    ResponeStr := GetSID(ResponeStr);
    sid :=  SO(ResponeStr).S['sid'];
    ResponeStr := AIdHttp.get(Format(SHAKEHANDS_STEP2, [config.IP, config.Port, ALoginName, (DateTimeToUnix(Now) - 8*60*60) * 1000, sid]));
    if FClient <> nil then
      FreeAndNil(FClient);
    FClient := TTestWebSocketClientConnection.Create(config.IP, IntToStr(config.Port),Format(WEBSOCKET_URL, [ALoginName, sid]),'-','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;

procedure TGroupClient.UploadFile(Hash, FileName, ID, GroupID: String);
var
  AHttp: TIdHttp;
  MutPartForm: TIdMultiPartFormDataStream;
  Ret:TStringStream;
  response,UpUrl: String;
  jo,t,jofile: ISuperObject;
  SendStr: String;
  config: TGroupConfig;
begin
  config := TGroupConfig.GetConfig;
  UpUrl := Format(UPLOAD_URL, [config.ImageIP, config.Port]);
  AHttp := Tidhttp.Create(nil);
  AHttp.Request.ContentType:='multipart/form-data';
  AHttp.HandleRedirects := true;
  AHttp.AllowCookies := true;
  MutPartForm := TIdMultiPartFormDataStream.Create;
  MutPartForm.AddFile('file1', FileName,'');

  try
    response := AHttp.Post(UpUrl, MutPartForm);
  finally
    MutPartForm.Free;
    AHttp.Free;
  end;

  if response = 'ok' then
  begin
//    jo := SO();
//    jo.S['name'] := 'group.file';
//    jo.S['args.id'] := id;
//    jo.S['args.groupid'] := GroupId;
//    t := SA([]);
//    jofile := SO();
//    jofile.S['file'] := ExtractFileName(filename);
//    jofile.S['hash'] := hash;
//    t.AsArray.Add(jofile);
//    jo['args.files'] := t;
//    SendStr := '5:::' + jo.AsJSon(False,False);
//    Send(SendStr);
  end;
end;

procedure TGroupClient.DownloadTeamFace(AMD5String, AFileName, Path: String);
var
  FileStream: TFileStream;
  idHTTP: TIDHTTP;
  URL: String;
  ss: String;
begin
{
  URL := Format(DOWNLOAD_URL, [FImageIP, FImagePort, AMD5String]);
  FDownFile.OnComplete := DownFaceFileComplete;
  FDownFile.ThreadDownFile(URL,TRealICQClient.GetReceivedFaceDir+AFileName);
  }
end;

constructor TGroupClient.Create;
begin
  FGroupMonitor := TGroupMonitor.Create;
end;

destructor TGroupClient.Destroy;
begin
  FreeAndNil(FGroupMonitor);
  if FClient <> nil then   
    FreeAndNil(FClient);
  inherited;
end;


procedure TGroupClient.Disconnect;
begin
  (FGroupMonitor as TGroupMonitor).Stop;
  (FGroupMonitor as TGroupMonitor).KeepAlive := False;
  FClient.Close(wsCloseNormal, 'goodbye');
end;

function TGroupClient.GetAlias(ATeamID, AMemberID: string): string;
begin

end;


procedure TGroupClient.Leave(ATeamID: string);
begin

end;



procedure TGroupClient.OnClose(aSender: TWebSocketCustomConnection;
  aCloseCode: integer; aCloseReason: string; aClosedByPeer: boolean);
begin
  FConnected := False;
  FClient := nil;
  (FGroupMonitor as TGroupMonitor).Stop;
  { TODO -olqq -c : 先把定时器关掉再开 2014/12/12 15:32:22 }
  if (aClosedByPeer) or (aCloseCode <> 1000) then
  begin
    Error(Format('异常断开. Code:%d;Reson:%s;ClolsedByPeer:%s;', [aCloseCode, aCloseReason, BoolToStr(aClosedByPeer)]), 'TGroup.OnClose');
//    Reconnect;
  end
  else
    Success(Format('正常断开. Code:%d;Reson:%s;ClolsedByPeer:%s;', [aCloseCode, aCloseReason, BoolToStr(aClosedByPeer)]), 'TGroup.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;
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
      FClient.SendText('5');
    

    Success(Recvdata, 'TGroupClient.OnRead');
    if 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.RemoveManager(ATeamID, AName: String);
begin

end;

procedure TGroupClient.RemoveMember(ATeamID, AName: String);
begin

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));
  except
    on E: Exception do
    begin
      Error(E.Message, 'TGroupClient.Send('+AData+')');
    end;
  end;
end;

procedure TGroupClient.SendFilesRequest(AGroupId, AUserId, FileName: String);
begin

end;

procedure TGroupClient.SendGetTeamInfo(ATeamID: String);
begin

end;

{ TFace }

procedure TFace.SetFileName(const Value: String);
begin
  FFileName := Value;
end;

end.