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.