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;
///
/// 打包并发送
/// 试用于$D4+总长(2byte)+次协议(1byte)+JSON长(2byte)+JSON字符串的形式
///
/// 次协议
/// JSON对象
///
/// true表示符合包的长度限制,false则表示超出包的长度限制
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.