RealICQClient/Client/Services/BaseService.pas

unit BaseService;

interface

uses
  RealICQContacterTreeView, Classes, SysUtils, superobject, RealICQModel,
  Windows, RealICQClient;

type
  TBaseService = class
  private

  protected


  public
    class function GetServerID(ALoginName: string): string;
    class function GetAndClearServerID(var ALoginName: string): string;
    class function ClearServerID(ALoginName: string): string; static;
    class function FullLoginName(ACenterServerID, AServerID, ALoginName: string): string; static;
    class function GetLocalUID(ALoginName: string): string;

    class procedure InitUserObject(AUser: TRealICQUser; AJo: ISuperObject); overload;
    class procedure InitUserObject(AUser: TRealICQUser; AJson: string); overload;
    
    class function GetSimpleUserJsons(AUsers: TStringList): TInterfaceList;
    class function GetUserStatusJsons(AUsers: TStringList): TInterfaceList;
    class function GetLoginNamesJsons(ALoginNames: TStrings): TInterfaceList; overload;
    class function GetLoginNamesJsons(ALoginNames: array of string): TInterfaceList; overload;
    class function ToJsonObject(AUser: TRealICQUser): ISuperObject;

    /// <summary>
    ///  打包并发送
    /// 试用于$D4+总长（2byte）+次协议（1byte）+JSON长（2byte）+JSON字符串的形式
    /// </summary>
    /// <param name="AProtocol">次协议</param>
    /// <param name="AJo">JSON对象</param>
    /// <param name="ARealICQClient"></param>
    /// <returns>true表示符合包的长度限制，false则表示超出包的长度限制</returns>
    function PacketAndSend(AProtocol: Byte; AJo: ISuperObject; ARealICQClient: TRealICQClient): Boolean;

    class function GetTreeView(AKey: string): TRealICQContacterTreeView;
    procedure FreeStringList(AStringList: TStringList);
    procedure ClearStringList(AStringList: TStringList);
  end;

implementation

uses
  MainFrm, LoggerImport, UsersService, Forms, Dialogs;

class function TBaseService.GetSimpleUserJsons(AUsers: TStringList): TInterfaceList;
var
  iLoop, iIndex, jLoop: Integer;
  AJo, AjoSimpleUser: ISuperObject;
  AJa: TSuperArray;
  AUser: TRealICQUser;
  AServerID: string;

begin
//  AJo := SO('[]');
  Result := TInterfaceList.Create;

  for iLoop := 0 to AUsers.Count - 1 do
  begin
    AJo := nil;
    AUser := AUsers.Objects[iLoop] as TRealICQUser;
    if AUser.IsComparedVer then
      Continue;
    AUser.IsComparedVer := true;
    AServerID := GetServerID(AUser.LoginName);
    for jLoop := 0 to Result.Count - 1 do
      if SameText(AServerID, (Result[jLoop] as ISuperObject).S['s']) then
      begin
        AJo := Result[jLoop] as ISuperObject;
        if AJo.A['us'].Length > 80 then
        begin
          AJo := SO();
          AJo.S['s'] := AServerID;
          AJo.N['us'] := SO('[]');
          Result.Insert(0, AJo);
        end;
        Break;
      end;
    if AJo = nil then
    begin
      AJo := SO();
      AJo.S['s'] := AServerID;
      AJo.N['us'] := SO('[]');
      Result.Add(AJo);
    end;
    AJa := AJo.A['us'];
    AjoSimpleUser := SO();
    AjoSimpleUser.S['l'] := ClearServerID(AUser.LoginName);
    AjoSimpleUser.I['v'] := AUser.CurrentExInfoVersion;
    AJa.Add(AjoSimpleUser);
  end;
end;

class function TBaseService.GetLoginNamesJsons(ALoginNames: TStrings): TInterfaceList;
var
  iLoop, iIndex, jLoop: Integer;
  AJo, AjoSimpleUser: ISuperObject;
  AJa: TSuperArray;
  ALoginName: string;
  AServerID: string;
begin
  Result := TInterfaceList.Create;

  for iLoop := 0 to ALoginNames.Count - 1 do
  begin
    AJo := nil;
    ALoginName := ALoginNames[iLoop];
    AServerID := GetServerID(ALoginName);
    for jLoop := 0 to Result.Count - 1 do
      if SameText(AServerID, (Result[jLoop] as ISuperObject).S['s']) then
      begin
        AJo := Result[jLoop] as ISuperObject;
        if AJo.A['us'].Length > 100 then
        begin
          AJo := SO();
          AJo.S['s'] := AServerID;
          AJo.N['us'] := SO('[]');
          Result.Insert(0, AJo);
        end;
        
        Break;
      end;
    if AJo = nil then
    begin
      AJo := SO();
      AJo.S['s'] := AServerID;
      AJo.N['us'] := SO('[]');
      Result.Add(AJo);
    end;
    AJo.A['us'].Add(ALoginName);
  end;
end;

class function TBaseService.GetLoginNamesJsons(
  ALoginNames: array of string): TInterfaceList;
var
  ALoginNameStrings: TStringList;
  iLoop: Integer;
begin      
  ALoginNameStrings := TStringList.Create;
  try
    for iLoop := 0 to Length(ALoginnames) - 1 do
      ALoginNameStrings.Add(ALoginNames[iLoop]);
    Result := GetLoginNamesJsons(ALoginNameStrings);
  finally
    FreeAndNil(ALoginNameStrings);
  end;
end;

procedure TBaseService.ClearStringList(AStringList: TStringList);
var
  AObj: TObject;
begin
  if AStringList = nil then
    Exit;
  while AStringList.Count > 0 do
  begin
    Aobj := AStringList.Objects[0];
    AStringList.Delete(0);
    FreeAndNil(AObj);
  end;
end;

procedure TBaseService.FreeStringList(AStringList: TStringList);
var
  AObj: TObject;
begin
  if AStringList = nil then
    Exit;
  while AStringList.Count > 0 do
  begin
    Aobj := AStringList.Objects[0];
    AStringList.Delete(0);
    FreeAndNil(AObj);
  end;

  FreeAndNil(AStringList);
end;

class function TBaseService.GetTreeView(AKey: string): TRealICQContacterTreeView;
var
  iIndex: Integer;
begin
  Result := nil;
  iIndex := MainForm.ContacterTreeViews.IndexOf(AKey);
  if iIndex < 0 then
    Exit;

  Result := MainForm.ContacterTreeViews.Objects[iIndex] as TRealICQContacterTreeView;
end;

class function TBaseService.GetUserStatusJsons(
  AUsers: TStringList): TInterfaceList;
var
  iLoop, iIndex, jLoop: Integer;
  AJo, AjoSimpleUser: ISuperObject;
  AJa: TSuperArray;
  AUser: TRealICQUser;
  AServerID: string;
begin
  Result := TInterfaceList.Create;

  for iLoop := 0 to AUsers.Count - 1 do
  begin
    AJo := nil;
    AUser := AUsers.Objects[iLoop] as TRealICQUser;
    if AUser = nil then
      AUser := TUsersService.GetUsersService.GetOrRequestUser(AUsers[iLoop]);
    if not AUser.IsNeedRequestUserStatus then
      Continue;
    AServerID := GetServerID(AUser.LoginName);
    for jLoop := 0 to Result.Count - 1 do
      if SameText(AServerID, (Result[jLoop] as ISuperObject).S['s']) then
      begin
        AJo := Result[jLoop] as ISuperObject;
        if AJo.A['us'].Length > 200 then
        begin
          AJo := SO();
          AJo.S['s'] := AServerID;
          AJo.N['us'] := SO('[]');
          Result.Insert(0, AJo);
        end;
        Break;
      end;
    if AJo = nil then
    begin
      AJo := SO();
      AJo.S['s'] := AServerID;
      AJo.N['us'] := SO('[]');
      Result.Add(AJo);
    end;
    AJa := AJo.A['us'];
    AjoSimpleUser := SO();
    AjoSimpleUser.S['l'] := ClearServerID(AUser.LoginName);
    AjoSimpleUser.I['os'] := Integer(AUser.LoginState);
    AJa.Add(AjoSimpleUser);
  end;
end;

class procedure TBaseService.InitUserObject(AUser: TRealICQUser;
  AJo: ISuperObject);
begin
  if (AUser = nil) or (AJo = nil) then
    Exit;

  AUser.LoginName := AJo.S['l'];
  AUser.Sex:= TRealICQSexType(AJo.I['sex']);
  AUser.Mobile := AJo.S['mob'];
  AUser.BranchID := AJo.S['bid'];
  AUser.Position := AJo.D['position'];
  AUser.Secret := TRealICQExInfoSecretLevel(AJo.I['secret']);
  AUser.CurrentExInfoVersion := AJo.I['v'];
//  AUser.Remark := AJo.O['remark'].AsString;
  AUser.ShortMobile := AJo.S['sMob'];
  AUser.Tel := AJo.S['tel'];
  AUser.Watchword := AJo.S['Watchword'];
  AUser.Email := AJo.S['email'];
  AUser.Branch := AJo.S['branch'];
  AUser.DisplayName := AJo.S['name'];
  AUser.TrueName := AUser.DisplayName;
  AUser.HeadImageFileType := TRealICQHeadImageFileType(AJo.I['iconType']);
  AUser.HeadImageHashValue := AJo.S['icon'];
  AUser.Duty := AJo.S['duty'];
  AUser.Company := AJo.S['comp'];
  AUser.OfficeID := AJo.S['officeID'];
end;

class procedure TBaseService.InitUserObject(AUser: TRealICQUser; AJson: string);
var
  jo: ISuperObject;
begin
  jo := SO(AJson);
  if jo = nil then
  begin
    Error('Json解析错误:' + AJson, 'TBaseService.InitUserObject');
  end
  else  
    InitUserObject(AUser, jo);
end;

class function TBaseService.GetServerID(ALoginName: string): string;
var
  iStart, iEnd, Len: Integer;
begin
  Result := '';
  iEnd := AnsiPos('-', ALoginName);
  if iEnd < 0 then
    Exit;

  iStart := AnsiPos('+', ALoginName);
  if iStart < 0 then
    iStart := 0;
  if iEnd <= iStart + 1then
    Exit;

  Result := Copy(ALoginName, iStart + 1, iEnd - iStart - 1);
end;

class function TBaseService.GetAndClearServerID(var ALoginName: string): string;
var
  iStart, iEnd, Len: Integer;
begin
  Result := '';
  iEnd := AnsiPos('-', ALoginName);
  if iEnd < 0 then
    Exit;

  iStart := AnsiPos('+', ALoginName);
  if iStart < 0 then
    iStart := 0;
  if iEnd <= iStart + 1then
    Exit;

  Result := Copy(ALoginName, iStart + 1, iEnd - iStart - 1);
  ALoginName := Copy(ALoginName, iEnd + 1, Length(ALoginName) - iEnd);
end;


class function TBaseService.ClearServerID(ALoginName: string): string;
var
  iStart: Integer;
begin
  Result := ALoginName;
  iStart := AnsiPos('-', ALoginName);
  if iStart < 0 then
    Exit;

  Result := Copy(ALoginName, iStart + 1, Length(ALoginName) - iStart);
end;

class function TBaseService.GetLocalUID(ALoginName: string): string;
begin
  Result := FullLoginName(MainForm.RealICQClient.CenterServerID, MainForm.RealICQClient.ServerID, ALoginName);
end;

class function TBaseService.FullLoginName(ACenterServerID, AServerID, ALoginName: string): string;
var
  iStart, iEnd, Len: Integer;
begin
  Result := ALoginName;
  if AServerID = '' then
    Exit;
  
  if AnsiPos('-', Result) <= 0 then
  begin
    if AnsiPos('+', Result) <= 0 then
      Result := AServerID + '-' + Result
    else
      Insert(AServerID + '-', Result, AnsiPos('+', Result) + 1);
  end;

  if ACenterServerID = '' then
    Exit;
    
  if AnsiPos('+', Result) <= 0 then
    Result := ACenterServerID + '+' + Result;
end;

function TBaseService.PacketAndSend(AProtocol: Byte; AJo: ISuperObject;
  ARealICQClient: TRealICQClient): Boolean;
var
  nIndex,AJsonLength, ALength: Integer;
  SendBuffer: array of Byte;
  AJson: string;
begin
  try
    Result := True;
    if AJo <> nil then
      AJson := AJo.AsJSon();

    AJsonLength := Length(AJson);
    ALength := 6 + Length(AJson);

    if (ALength > 4096) then
    begin
      Result := False;
      Exit;
    end;

    SetLength(SendBuffer, ALength);
    nIndex := 0;

     //填充 (1)协议类型（0xD4）            1byte
    SendBuffer[nIndex] := $D4;
    Inc(nIndex, 1);

    //填充 (2)消息总长度                  2byte
    CopyMemory(@SendBuffer[nIndex], @ALength, 2);
    Inc(nIndex, 2);

    SendBuffer[nIndex] := AProtocol;
    Inc(nIndex, 1);

    //填充 (2)JSON总长度                  2byte
    CopyMemory(@SendBuffer[nIndex], @AJsonLength, 2);
    Inc(nIndex, 2);

    //填充（4）JSON                    动态长度
    CopyMemory(@SendBuffer[nIndex], PChar(AJson), AJsonLength);


    ARealICQClient.TCPClient.SendBuffer(SendBuffer[0], ALength);
  except
    on E: Exception do
      Log(E.Message, 'TUsersService.InitBuffer('+AJson+')');
  end;
end;

class function TBaseService.ToJsonObject(AUser: TRealICQUser): ISuperObject;
var
  jo: ISuperObject;
begin
  Result := nil;
  if (AUser = nil) or (AUser.LoginName = '') then
    Exit;
  jo := TSuperObject.Create;

  jo.S['l'] := AUser.LoginName;
  Jo.I['sex'] := Integer(AUser.Sex);
  Jo.S['mob'] := AUser.Mobile;
  Jo.S['bid'] := AUser.BranchID;
  Jo.D['position'] := AUser.Position;
  Jo.I['secret'] := Integer(AUser.Secret);
  Jo.I['v'] := AUser.CurrentExInfoVersion;
//  Jo.S['remark'] := AUser.Remark ;
  Jo.S['sMob'] := AUser.ShortMobile;
  Jo.S['tel'] := AUser.Tel;
  Jo.S['watchword'] := AUser.Watchword;
  Jo.S['email'] := AUser.Email;
  Jo.S['branch'] := AUser.Branch;
  Jo.S['name'] := AUser.DisplayName;
  Jo.I['iconType'] := Integer(AUser.HeadImageFileType);
  Jo.S['icon'] := AUser.HeadImageHashValue;
  Jo.S['duty'] := AUser.Duty;
  Jo.S['comp'] := AUser.Company;
  Jo.S['officeID'] := AUser.OfficeID;
//  jo.B['GettedExInfo'] := AUser.FGettedExInfo;
//  jo.B['GettedOffliceAutoResponseSet'] := AUser.GettedOffliceAutoResponseSet;
  Result := jo;
end;

end.