| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772 |
- unit Groups;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
- StdCtrls, WebSocket2, CustomServer2, blcksock,Idhttp, superobject,
- WebSocketClient, ExtCtrls, Forms, Dialogs, IniFiles, LoggerImport,
- DownloadFileFromWeb, GroupMonitor;
- type
- TOnGetTeamInfo = procedure (aTeamID: String) of Object;
- //群组成员数据
- TProtocolMethod = procedure(Data: String) of Object;
- TTeamMemberCard = class
- private
- FTeamID: string;
- FID: String;
- FServerID: String;
- FUserID: String;
- FAlias: String;
- FTimesTamp: Int64;
- public
- property ID: String read FID;
- property ServerID: String read FServerID;
- property UserID: String read FUserID;
- property Alias: String read FAlias Write FAlias;
- property TimesTamp: Int64 read FTimesTamp;
- end;
-
- TGroup = class
- private
- FIP: String;
- FPort: Integer;
- FImageIP: String;
- FImagePort: Integer;
- FClient: TWebSocketClientConnection;
- FProtocolsList: TStringList;
- FTeams: TStringList;
- FTempSendFileList: TStringlist;
- FEnable: Boolean;
- FLoginName: string;
- FDownFile: TDownFile;
- FTeamMemberCards: TStringList;
- FOnGetTeamInfo : TOnGetTeamInfo;
- procedure UpdateTeamInfoFromJson(AJo: ISuperObject);
- function GetOrCreateTeam(ATeamID: string): TObject;
- function GetTeam(ATeamID: string): TObject;
- function FormatStrFromServer(AStr: string): string;
- function FormatStrToServer(AStr: string): string;
- procedure SetGetTeamInfo(const Value: TOnGetTeamInfo);
- procedure ProcessOnGroupSubscribeResponse(Data: String);
- procedure ProcessOnGroupAddResponse(Data: String);
- procedure ProcessOnGroupAddBroadCast(Data: String);
- procedure ProcessOnGroupRemoveResponse(Data: String);
- procedure ProcessOnGroupRemoveBroadcast(Data: String);
- procedure ProcessOnGroupSayResponse(Data: String);
- procedure ProcessOnGroupSayBroadCast(Data: String);
- procedure ProcessOnGroupInfoRead(Data: String);
- procedure ProcessOnGroupInfoUpdate(Data: String);
- procedure ProcessOnGroupInfoUpdateBroadCast(Data: String);
- procedure ProcessOngroupMemberaddresponse(Data: String);
- procedure ProcessOnGroupMemberaddBroadcast(Data: String);
- procedure ProcessOnGroupManagerAddResponse(Data: String);
- procedure ProcessOnGroupManagerAddBroadCast(Data: String);
- procedure ProcessOnGroupMemberRemoveResponse(Data: String);
- procedure ProcessOnGroupMemberRemoveBroadCast(Data: String);
- procedure ProcessOnGroupManagerRemoveResponse(Data: String);
- procedure ProcessOnGroupManagerRemoveBroadCast(Data: String);
- procedure ProcessOnGroupMemberLeaveRespone(Data: String);
- procedure ProcessOnGroupMemberleaveBroadCast(Data: String);
- procedure ProcessOnGroupSearch(Data: String);
- procedure ProcessOngroupMemberApplyConfirm(Data: String);
- procedure ProcessOnGroupMemberApplyResponse(Data: String);
- procedure ProcessOnGroupFileBroadCast(Data: String);
- procedure ProcessOnGroupFileUploadResponse(Data: String);
- procedure ProcessOnGroupMemberUpdateResponse(Data: String);
- function GetTeams:TStringList;
- function GetMemberCard(ATeamID, ALoginName: string): TTeamMemberCard;
- procedure DownFaceFileComplete(Source_file, Dest_file: String; blStatus: boolean; ErrMessage: String);
- procedure SetLoginName(const Value: string);
- function InitMemebers(ATeamID: string; AJoUser: ISuperObject): string;
- function ConcateMembers(AMemebersStr: string; ANewMembers: TSuperArray): string;
- public
- constructor Create();
- destructor Destroy; override;
- procedure Start;
- procedure Close;
- procedure SendMessage(Data: String);
- Procedure TestEvent;
- procedure Send(Data: string);
- procedure UploadFile(Hash, FileName, ID, GroupID: String);
- procedure DownloadTeamFace(AMD5String, AFileName, Path: String);
- procedure SendFilesRequest(AGroupId, AUserId, FileName: String);
- procedure UpdateTeamInfo(ATeamID, AIntro, ANotice, AName: string; AAuth: Integer);
- procedure SendTeamMessage(ATeamID, ASender, AMsg: String; AFont: TFont; AFaces: TStringList; Attachs: String);
- procedure Subscribe;
- procedure UnSubscribe;
- procedure Search(AKey, AName, ATeamID, ACreator: String);
- procedure Leave(ATeamID: string);
- procedure AddManager(ATeamID, AName: String);
- procedure RemoveManager(ATeamID, AName: String);
- procedure AddTeamMembers(ATeamID: String; AUsers: TStringList);
- procedure RemoveTeamMembers(ATeamID: string; AUsers: TStringList);
- procedure RemoveMember(ATeamID,AName: String);
- procedure SetAlias(ATeamID, ALoginName, Alias: String);
- function GetAlias(ATeamID, ALoginName: string): string;
- Procedure SendGetTeamInfo(ATeamID: String);
- procedure RemoveTeam(ATeamID: string);
- procedure CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: String; ATeamMembers: TStringList; AIsTempTeam: Boolean);
- procedure JoinTeam(ATeamID, ATag: String);
- procedure JoinTeamResponse(ATeamID, ALoginName, AMsg: String; ARet : Integer);
- procedure Reconnect;
- procedure StopReconnect; //MainForm.TimerForreconnectgroup.Enabled := False;
- procedure OnOpen(aSender: TWebSocketCustomConnection);
- procedure OnRead(aSender: TWebSocketCustomConnection; aFinal, aRes1, aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream);
- procedure OnWrite(aSender: TWebSocketCustomConnection; aFinal, aRes1, aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream);
- procedure OnClose(aSender: TWebSocketCustomConnection; aCloseCode: integer; aCloseReason: string; aClosedByPeer: boolean);
- procedure OnConnectionSocket(Sender: TObject; Reason: THookSocketReason; const Value: String);
- published
- property IP: String read FIP write FIP;
- property Port: Integer read FPort write FPort;
- property ImageIP: String read FImageIP write FImageIP;
- property ImagePort: Integer read FImagePort write FImagePort;
- property Teams: TStringList read GetTeams;
- property Enable: Boolean read FEnable;
- property LoginName: string read FLoginName write SetLoginName;
- property TempSendFileList: TStringlist read FTempSendFileList;
- property OnGetTeamInfo : TOnGetTeamInfo Read FOnGetTeamInfo write SetGetTeamInfo;
- end;
-
- var
- Group: TGroup;
- implementation
- uses synsock, synachar, StrUtils, synautil, math, TypInfo, BClasses, DateUtils,
- CreateTeamFrm, MainFrm, SearchTeamFrm, IdMultipartFormData, MD5, xFonts,
- ShareUtils, RealICQClient, RealICQUtils, DataProviderImport, InterfaceDataProvider,
- RealICQModel;
- const
- UPLOAD_URL: string = 'http://%s:%d/file/upload';
- DOWNLOAD_URL: string = 'http://%s:%d/file/%s';
- ADDMEMBERS_PROTOCOL: string = '{"name":"group.member.add","args":{"id":"","users":[]}}';
- REMOVEMEMBER_PROTOCOL: string = '5:::{"name":"group.member.remove","args":{"id":"%s","userid":"%s"}}';
- REMOVEMEMBERS_PROTOCOL: string = '{"name":"group.member.remove","args":{"id":"","users":[]}}';
- ADDMANAGER_PROTOCOL: string = '5:::{"name":"group.manager.add","args":{"id":"%s","managers":["%s"]}}';
- REMOVEMANAGER_PROTOCOL: string = '5:::{"name":"group.manager.remove","args":{"id":"%s","managers":["%s"]}}';
- SUBSCRIBE_PROTOCOL: string = '5:::{"name":"group.subscribe","args":{"id":"%s"}}';
- UNSUBSCRIBE_PROTOCOL: string = '5:::{"name":"group.unsubscribe","args":{"id":"%s"}}';
- LEAVE_PROTOCOL: string = '5:::{"name":"group.member.leave","args":{"id":"%s","userid":"%s"}}';
- REMOVETEAM_PROTOCOL: string = '5:::{"name":"group.remove","args":{"id":"%s"}}';
- MEMBERCARD_KEY: string = '%s:%s';
- {$REGION '---'}
- { TGroup }
- procedure TGroup.Close;
- begin
- if (FClient <> nil) and (not FClient.Closed) then
- begin
- FClient.Close(wsCloseNormal, 'goodbye');
- WaitForSingleObject(FClient.Handle, 60 * 1000);
- end;
- end;
- constructor TGroup.Create();
- begin
- inherited Create;
- FEnable := False;
- FDownFile:= TDownFile.Create;
- FTeamMemberCards:= TStringList.Create;
- FProtocolsList := TStringList.Create;
- FTeams := TStringList.Create;
- FTempSendFileList := TStringlist.Create;
- FProtocolsList.Add('group.subscribe.response');
- FProtocolsList.Add('group.add.response');
- FProtocolsList.Add('group.remove.response');
- FProtocolsList.Add('group.say.response');
- FProtocolsList.Add('group.say.broadcast');
- FProtocolsList.Add('group.info.response');
- FProtocolsList.Add('group.member.add.response');
- FProtocolsList.Add('group.member.remove.response');
- FProtocolsList.Add('group.add.broadcast');
- FProtocolsList.Add('group.remove.broadcast');
- FProtocolsList.Add('group.member.add.broadcast');
- FProtocolsList.Add('group.member.remove.broadcast');
- FProtocolsList.Add('group.member.leave.response');
- FProtocolsList.Add('group.member.leave.broadcast');
- FProtocolsList.Add('group.manager.add.response');
- FProtocolsList.Add('group.manager.add.broadcast');
- FProtocolsList.Add('group.manager.remove.response');
- FProtocolsList.Add('group.update.response');
- FProtocolsList.Add('group.update.broadcast');
- FProtocolsList.Add('group.manager.remove.broadcast');
- FProtocolsList.Add('group.search.response');
- FProtocolsList.Add('group.member.apply.confirm');
- FProtocolsList.Add('group.member.apply.response');
- FProtocolsList.Add('group.file.broadcast');
- FProtocolsList.Add('file.upload.response');
- FProtocolsList.Add('group.member.update.response');
- FProtocolsList.Add('group.member.update.broadcast');
- end;
- destructor TGroup.Destroy;
- var
- iLoop: Integer;
- RealICQTeam: TRealICQTeam;
- MemberCard: TTeamMemberCard;
- begin
- FreeAndNil(FProtocolsList);
- FreeAndNil(FDownFile);
- while FTeams.Count > 0 do
- begin
- RealICQTeam := FTeams.Objects[0] as TRealICQTeam;
- FTeams.Delete(0);
- FreeAndNil(RealICQTeam);
- end;
- FreeAndNil(FTeams);
- //注意
- while FTempSendFileList.Count > 0 do
- begin
- RealICQTeam := FTempSendFileList.Objects[0] as TRealICQTeam;
- FTeams.Delete(0);
- FreeAndNil(RealICQTeam);
- end;
- FreeAndNil(FTempSendFileList);
- while FTeamMemberCards.Count > 0 do
- begin
- MemberCard := FTeamMemberCards.Objects[0] as TTeamMemberCard;
- FTeamMemberCards.Delete(0);
- FreeAndNil(MemberCard);
- end;
- FreeAndNil(FTeamMemberCards);
- inherited Destroy;
- end;
- function TGroup.GetTeams: TStringList;
- begin
- if not Assigned(FTeams) then
- FTeams := TStringList.Create;
- Result := FTeams;
- end;
- procedure TGroup.OnClose(aSender: TWebSocketCustomConnection; aCloseCode: integer; aCloseReason: string; aClosedByPeer: boolean);
- begin
- //GrpMonitor.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 TGroup.OnConnectionSocket(Sender: TObject; Reason: THookSocketReason;
- const Value: String);
- begin
- end;
- procedure TGroup.OnOpen(aSender: TWebSocketCustomConnection);
- begin
- StopReconnect;
- Subscribe;
- //GrpMonitor.Start;
- end;
- procedure TGroup.OnRead(aSender: TWebSocketCustomConnection; aFinal, aRes1,
- aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream);
- var
- s,Recvdata: string;
- c: TTestWebSocketClientConnection;
- jo: ISuperObject;
- protocol:string;
- RecvMethod: TProtocolMethod;
- begin
- try
- //GrpMonitor.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;
- { TODO -olqq -c : 统一发送调用 2014/12/13 12:38:42 }
- if Recvdata = '2::' then
- Send('2::');
- Recvdata := copy(Recvdata,5,length(Recvdata));
- if Recvdata <> '' then
- begin
- jo := SO(Recvdata);
- protocol := jo['name'].AsString;
- case FProtocolsList.IndexOf(protocol) of
- 0:ProcessOnGroupSubscribeResponse(Recvdata);
- 1:ProcessOnGroupAddResponse(Recvdata);
- 2:ProcessOnGroupRemoveResponse(Recvdata);
- 3:ProcessOnGroupSayResponse(Recvdata);
- 4:ProcessOnGroupSayBroadCast(Recvdata);
- 5:ProcessOnGroupInfoRead(Recvdata);
- 6:ProcessOngroupmemberaddresponse(Recvdata);
- 7:ProcessOnGroupMemberRemoveResponse(Recvdata);
- 8:ProcessOnGroupAddBroadCast(Recvdata);
- 9:ProcessOnGroupRemoveBroadcast(Recvdata);
- 10:ProcessOnGroupMemberaddBroadcast(Recvdata);
- 11:ProcessOnGroupMemberRemoveBroadCast(Recvdata);
- 12:ProcessOnGroupMemberLeaveRespone(Recvdata);
- 13:ProcessOnGroupMemberleaveBroadCast(Recvdata);
- 14:ProcessOnGroupManagerAddResponse(Recvdata);
- 15:ProcessOnGroupManagerAddBroadCast(Recvdata);
- 16:ProcessOnGroupManagerRemoveResponse(Recvdata);
- 17:ProcessOnGroupInfoUpdate(Recvdata);
- 18:ProcessOnGroupInfoUpdateBroadCast(Recvdata);
- 19:ProcessOnGroupManagerRemoveBroadCast(Recvdata);
- 20:ProcessOnGroupSearch(Recvdata);
- 21:ProcessOngroupmemberapplyconfirm(Recvdata);
- 22:ProcessOnGroupMemberApplyResponse(Recvdata);
- 23:ProcessOnGroupFileBroadCast(Recvdata);
- 24:ProcessOnGroupFileUploadResponse(Recvdata);
- 25:ProcessOnGroupMemberUpdateResponse(Recvdata);
- 26:ProcessOnGroupMemberUpdateResponse(Recvdata);
- end;
- end;
- except
- on E: Exception do
- Log(E.Message+Recvdata, 'TGroup.OnRead('+Recvdata+')');
- end;
- end;
- procedure TGroup.OnWrite(aSender: TWebSocketCustomConnection; aFinal, aRes1,
- aRes2, aRes3: boolean; aCode: integer; aData: TMemoryStream);
- begin
- end;
- procedure TGroup.ProcessOnGroupAddBroadCast(Data: String);
- var
- jo: ISuperObject;
- ja: TSuperArray;
- nTeamID: String;
- IsTemp: Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- IsTemp := ja[0]['type'].AsInteger;
- if IsTemp = 0 then
- SendGetTeamInfo(nTeamID);
- end;
- procedure TGroup.ProcessOnGroupAddResponse(Data: String);
- var
- jo: ISuperObject;
- ja: TSuperArray;
- HWnd:THandle;
- nTeamID: String;
- TeamCreated: Boolean;
- TeamCaption,
- FailingCause: String;
- RealICQTeam: TRealICQTeam;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- TeamCreated := not ja[0]['ret'].AsBoolean;
- TeamCaption := '';
- FailingCause := ja[0]['msg'].AsString;
- SendGetTeamInfo(nTeamID);
- // CreateTeamForm.CreateTeamResult(nil,TeamCaption,TeamCreated,nTeamID,FailingCause);
- //
- // RealICQTeam := TRealICQTeam.Create;
- // RealICQTeam.TeamID := nTeamID;
- //
- // if assigned(FTeams) then
- // begin
- // try
- // FTeams.AddObject(nTeamID, RealICQTeam);
- // except
- // on e:Exception do
- // showmessage(e.message);
- // end;
- // end;
- end;
- procedure TGroup.ProcessOnGroupFileBroadCast(Data: String);
- var
- jo: ISuperObject;
- jaargs,jafiles: TSuperArray;
- iLoop: Integer;
- filename,hash: String;
- begin
- jo := SO(Data);
- jaargs := jo['args'].AsArray;
- jafiles := jaargs[0]['files'].AsArray;
- for ILoop := 0 to jafiles.Length - 1 do
- begin
- filename := jafiles[iLoop]['file'].AsString;
- hash := jafiles[iLoop]['hash'].AsString;
- DownloadTeamFace(Hash,FileName,'');
- end;
- end;
- procedure TGroup.ProcessOnGroupFileUploadResponse(Data: String);
- var
- jo: ISuperObject;
- jaargs,jafiles: TSuperArray;
- nTeamID: String;
- msg: String;
- iLoop: Integer;
- filename,hash: String;
- ret,itemindex: Integer;
- begin
- jo := SO(Data);
- jaargs := jo['args'].AsArray;
- nTeamID := jaargs[0]['id'].AsString;
- msg := jaargs[0]['msg'].AsString;
- jafiles := jaargs[0]['files'].AsArray;
- for ILoop := 0 to jafiles.Length - 1 do
- begin
- filename := jafiles[iLoop]['file'].AsString;
- hash := jafiles[iLoop]['hash'].AsString;
- ret := jafiles[iLoop]['ret'].AsInteger;
- if ret = 0 then
- begin
- { TODO -olqq -c : 上传成功 2014/12/19 19:01:52 }
- end
- else
- begin
- { TODO -olqq -c : 上传失败 2014/12/19 19:01:52 }
- end;
- end;
- end;
- function ManagersConvertToStr(AManagers: TSuperArray): string;
- var
- iLoop: Integer;
- begin
- iLoop := 0;
- Result := '';
- while iLoop < AManagers.Length - 1 do
- begin
- Result := Result + AManagers[iLoop].AsString + Chr(10);
- Inc(iLoop);
- end;
- Result := Result + AManagers[iLoop].AsString
- end;
- function TGroup.InitMemebers(ATeamID: string; AJoUser: ISuperObject): string;
- var
- AKey: String;
- AItem: TSuperAvlEntry;
- AMemberCard: TTeamMemberCard;
- begin
- Result := '';
- for AItem in AJoUser.AsObject do
- begin
- AKey := Format(MEMBERCARD_KEY, [ATeamID, AItem.Value['id'].AsString]);
- Result := Result + AItem.Value['id'].AsString + Chr(10);
- if FTeamMemberCards.IndexOf(AKey) > 0 then
- Continue;
- AMemberCard := TTeamMemberCard.create;
- AMemberCard.FID := AItem.Value['id'].AsString;
- AMemberCard.FServerID := AItem.Value['serverid'].AsString;
- AMemberCard.FUserID := AItem.Value['userid'].AsString;
- AMemberCard.FAlias := AItem.Value['alias'].AsString;
- AMemberCard.FTimesTamp := AItem.Value['timestamp'].AsInteger;
- FTeamMemberCards.AddObject(AKey, AMemberCard);
- end;
- Result := Copy(Result, 0, Length(Result) - 1);
- end;
- procedure TGroup.UpdateTeamInfoFromJson(AJo: ISuperObject);
- var
- ATeam : TRealICQTeam;
- ATeamID: String;
- begin
- try
- ATeamID := AJo.S['id'];
- if ATeamID = '' then
- Exit;
- ATeam := GetOrCreateTeam(ATeamID) as TRealICQTeam;
- ATeam.TeamCaption := AJo.S['name'];
- ATeam.TeamCreater := AJo.S['creator'];
- ATeam.IsTempTeam := AJo.B['type'];
- ATeam.TeamIntro := FormatStrFromServer(AJo.S['intro']);;
- ATeam.TeamCallBoard := FormatStrFromServer(AJo.S['notice']);
- ATeam.TeamValidate := TRealICQTeamValidateType(AJo.I['auth']);
- ATeam.TeamManagers := ManagersConvertToStr(AJo.A['managers']);
- ATeam.TeamMembers := InitMemebers(ATeamID, AJo.O['users']);
- except
- on E: Exception do
- Log(E.Message, 'TGroup.UpdateTeamInfo');
- end;
- end;
- procedure TGroup.ProcessOnGroupInfoRead(Data: String);
- var
- jo,jo1,jo2: ISuperObject;
- ja,ja2: TSuperArray;
- ATeamID: string;
- begin
- try
- jo := SO(Data);
- ja := jo['args'].AsArray;
- jo1 := SO(ja[0].AsString);
- ja2 := jo1['groups'].AsArray;
- jo2 := SO(ja2[0].AsString);
- ATeamID := jo2.S['id'];
- if ATeamID = '' then
- Exit;
-
- GetMapTeamUsersProvider.Insert(jo2.S['id'], jo2.AsJSon(), jo2.I['ver']);
- UpdateTeamInfoFromJson(jo2);
- MainForm.WebSocketSendReadTeamInfo(ATeamID);
- except
- on E: Exception do
- Log(E.Message, 'TGroup.ProcessOnGroupInfoRead');
- end;
- end;
- procedure TGroup.ProcessOnGroupInfoUpdate(Data: String);
- var
- jo,joGroup: ISuperObject;
- ja : TSuperArray;
- ATeamID: String;
- ATeam : TRealICQTeam;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- joGroup := SO(ja[0]['group'].AsString);
- ATeamID := joGroup.S['id'];
- if ATeamID = '' then
- Exit;
- ATeam := GetOrCreateTeam(ATeamID) as TRealICQTeam;
- ATeam.TeamCaption := joGroup.S['name'];
- ATeam.TeamIntro := FormatStrFromServer(joGroup.S['intro']);;
- ATeam.TeamCallBoard := FormatStrFromServer(joGroup.S['notice']);
- ATeam.TeamValidate := TRealICQTeamValidateType(joGroup.I['auth']);
- MainForm.WebSocketSendReadTeamInfo(ATeamID);
- end;
- procedure TGroup.ProcessOnGroupInfoUpdateBroadCast(Data: String);
- var
- jo: ISuperObject;
- ja,jaManagers: TSuperArray;
- nTeamID: String;
- RealICQTeam : TRealICQTeam;
- I,ItemIndex: Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- ItemIndex := FTeams.indexof(nTeamID);
- if ItemIndex >= 0 then
- begin
- SendGetTeamInfo(nTeamID);
- end;
- end;
- procedure TGroup.ProcessOnGroupManagerAddBroadCast(Data: String);
- var
- jo: ISuperObject;
- ja,jaManagers: TSuperArray;
- nTeamID, strManagers: String;
- ATeam : TRealICQTeam;
- I: Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- jaManagers := ja[0]['managers'].AsArray;
- ATeam := GetTeam(nTeamID) as TRealICQTeam;
- if ATeam = nil then
- begin
- SendGetTeamInfo(nTeamID);
- Exit;
- end;
- strManagers := ManagersConvertToStr(jaManagers);
- if Trim(ATeam.TeamManagers) <> '' then
- ATeam.TeamManagers := ATeam.TeamManagers + char(10) + strManagers
- else
- ATeam.TeamManagers := strManagers;
- MainForm.WebSocketSendReadTeamInfo(nTeamID);
- end;
- procedure TGroup.ProcessOnGroupManagerAddResponse(Data: String);
- var
- jo: ISuperObject;
- ja,jaManagers: TSuperArray;
- nTeamID, strManagers: String;
- ATeam : TRealICQTeam;
- I: Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- jaManagers := ja[0]['managers'].AsArray;
- ATeam := GetTeam(nTeamID) as TRealICQTeam;
- if ATeam = nil then
- begin
- SendGetTeamInfo(nTeamID);
- Exit;
- end;
- strManagers := ManagersConvertToStr(jaManagers);
- if Trim(ATeam.TeamManagers) <> '' then
- ATeam.TeamManagers := ATeam.TeamManagers + char(10) + strManagers
- else
- ATeam.TeamManagers := strManagers;
- MainForm.WebSocketSendReadTeamInfo(nTeamID);
- end;
- procedure TGroup.ProcessOnGroupManagerRemoveBroadCast(Data: String);
- var
- jo: ISuperObject;
- ja,jaManagers: TSuperArray;
- nTeamID: String;
- ATeam : TRealICQTeam;
- I: Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- jaManagers := ja[0]['managers'].AsArray;
- ATeam := GetTeam(nTeamID) as TRealICQTeam;
- SendGetTeamInfo(nTeamID);
- // if ATeam = nil then
- // begin
- // SendGetTeamInfo(nTeamID);
- // Exit;
- // end;
- // for I := 0 to jaManagers.Length - 1 do
- // begin
- // ATeam.TeamManagers := StringReplace(Chr(10) + ATeam.TeamManagers + Chr(10), Chr(10) + jaManagers[i].AsString + char(10),char(10),[rfReplaceAll]);
- // ATeam.TeamManagers := Copy(ATeam.TeamManagers, 2, Length(ATeam.TeamManagers) - 1);
- // end;
- // MainForm.WebSocketSendReadTeamInfo(nTeamID);
- end;
- procedure TGroup.ProcessOnGroupManagerRemoveResponse(Data: String);
- var
- jo: ISuperObject;
- ja,jaManagers: TSuperArray;
- nTeamID: String;
- ATeam : TRealICQTeam;
- I: Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- jaManagers := ja[0]['managers'].AsArray;
- ATeam := GetTeam(nTeamID) as TRealICQTeam;
- SendGetTeamInfo(nTeamID);
- // if ATeam = nil then
- // begin
- // SendGetTeamInfo(nTeamID);
- // Exit;
- // end;
- // for I := 0 to jaManagers.Length - 1 do
- // begin
- // ATeam.TeamManagers := StringReplace(Chr(10) +ATeam.TeamManagers + Chr(10), Chr(10) +jaManagers[i].AsString + char(10),char(10),[rfReplaceAll]);
- // ATeam.TeamManagers := Copy(ATeam.TeamManagers, 2, Length(ATeam.TeamManagers) - 1);
- // end;
- // MainForm.WebSocketSendReadTeamInfo(nTeamID);
- end;
- procedure TGroup.ProcessOnGroupMemberaddBroadcast(Data: String);
- var
- jo: ISuperObject;
- ja, jaMemebers: TSuperArray;
- ATeam : TRealICQTeam;
- nTeamID: String;
- I: Integer;
- begin
- try
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- jaMemebers := ja[0]['users'].AsArray;
-
- ATeam := GetTeam(nTeamID) as TRealICQTeam;
- if ATeam = nil then
- begin
- SendGetTeamInfo(nTeamID);
- Exit;
- end;
- ATeam.TeamMembers := ConcateMembers(ATeam.TeamMembers, jaMemebers);
- MainForm.WebSocketSendReadTeamInfo(nTeamID);
- except
- on E: Exception do
- Error(E.Message, 'TGroup.ProcessOnGroupMemberaddBroadcast(' + Data +')')
- end;
- end;
- function TGroup.ConcateMembers(AMemebersStr: string; ANewMembers: TSuperArray): string;
- var
- AMemberList: TStrings;
- iLoop, jLoop: Integer;
- isAdd: Boolean;
- begin
- Result := '';
- AMemberList := SplitString(AMemebersStr, Chr(10));
- try
- for iLoop := AMemberList.Count - 1 downto 0 do
- if Length(Trim(AMemberList[iLoop])) = 0 then
- AMemberList.Delete(iLoop);
- for jLoop := ANewMembers.Length - 1 downto 0 do
- begin
- isAdd := True;
- for iLoop := AMemberList.Count - 1 downto 0 do
- if SameText(ANewMembers.S[jLoop], AMemberList[iLoop]) then
- begin
- isAdd := False;
- Break;
- end;
- if isAdd then
- AMemberList.Add(ANewMembers.S[jLoop]);
- end;
- for iLoop := AMemberList.Count - 1 downto 0 do
- if iLoop = 0 then
- Result := Result + AMemberList[iLoop]
- else
- Result := Result + AMemberList[iLoop] + Chr(10);
- finally
- FreeAndNil(AMemberList);
- end;
- end;
- procedure TGroup.ProcessOngroupmemberaddresponse(Data: String);
- var
- jo: ISuperObject;
- ja, jaMemebers: TSuperArray;
- ATeam : TRealICQTeam;
- nTeamID: String;
- I: Integer;
- begin
- try
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- jaMemebers := ja[0]['users'].AsArray;
- ATeam := GetTeam(nTeamID) as TRealICQTeam;
- if ATeam = nil then
- begin
- SendGetTeamInfo(nTeamID);
- Exit;
- end;
- ATeam.TeamMembers := ConcateMembers(ATeam.TeamMembers, jaMemebers);
- // for I := 0 to jaMemebers.Length - 1 do
- // ATeam.TeamMembers := ConcateMembers(ATeam.TeamMembers, jaMemebers.S[I]);
- MainForm.WebSocketSendReadTeamInfo(nTeamID);
- except
- on E: Exception do
- Error(E.Message, 'TGroup.ProcessOngroupmemberaddresponse(' + Data +')')
- end;
- end;
- procedure TGroup.ProcessOngroupmemberapplyconfirm(Data: String);
- var
- jo: ISuperObject;
- ja: TSuperArray;
- nTeamID: String;
- name: String;
- msg: String;
- begin
- try
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['groupid'].AsString;
- name := ja[0]['userid'].AsString;
- msg := ja[0]['msg'].AsString;
- MainForm.WebSocketJionTeamRequest(nTeamID,name,msg);
- except
- on E: Exception do
- Error(E.Message, 'TGroup.ProcessOngroupmemberapplyconfirm(' + Data +')');
- end;
- end;
- procedure TGroup.ProcessOnGroupMemberApplyResponse(Data: String);
- var
- jo: ISuperObject;
- ja: TSuperArray;
- nTeamID : String;
- msg: String;
- begin
- try
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['groupid'].AsString;
- msg := ja[0]['msg'].AsString;
- if ja[0]['ret'].AsString = '5' then
- begin
- MessageBox(SearchTeamForm.Handle, PChar('申请加入的群组不允许任何人加入!!!'), '提示', MB_ICONINFORMATION);
- end;
- if ja[0]['ret'].AsString = '1' then
- MainForm.RealICQClientJoinTeamResponse(nil,nTeamID,'管理员',msg,False);
- // MessageBox(SearchTeamForm.Handle, PChar('申请加入的群组不允许任何人加入!!!'), '提示', MB_ICONINFORMATION);
- if ja[0]['ret'].AsString = '0' then
- begin
- SendGetTeamInfo(nTeamID);
- MainForm.RealICQClientJoinTeamResponse(nil,nTeamID,'管理员',msg,True);
- end;
- except
- on E: Exception do
- Error(E.Message, 'TGroup.ProcessOnGroupMemberApplyResponse(' + Data +')');
- end;
- end;
- procedure TGroup.ProcessOnGroupMemberleaveBroadCast(Data: String);
- var
- jo: ISuperObject;
- ja,jauser: TSuperArray;
- nTeamID: String;
- name: String;
- iLoop,jLoop: Integer;
- RealICQTeam: TRealICQTeam;
- index,itemIndex:Integer;
- ATeamMembers: TStringList;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- name := ja[0]['userid'].AsString;
- SendGetTeamInfo(nTeamID);
- // itemIndex := FTeams.IndexOf(nTeamID);
- // try
- // if itemindex >= 0 then
- // begin
- // RealICQTeam := FTeams.Objects[itemIndex] as TRealICQTeam;
- // if not AnsiSameText(name, MainForm.RealICQClient.LoginName) then
- // begin
- // RealICQTeam.TeamMembers := StringReplace(Chr(10) +RealICQTeam.TeamMembers + Chr(10), Chr(10) +name + char(10),char(10),[rfReplaceAll]);
- // RealICQTeam.TeamMembers := Copy(RealICQTeam.TeamMembers, 2, Length(RealICQTeam.TeamMembers) - 1);
- // MainForm.WebSocketSendReadTeamInfo(nteamID);
- // end
- // else
- // begin
- // MainForm.WebSocketQuitTeam(RealICQTeam.TeamID);
- // FTeams.Delete(itemIndex);
- // end;
- // end;
- // except
- // on E: Exception do
- // Error(E.Message, 'TGroup.ProcessOnGroupMemberleaveBroadCast(' + Data +')');
- // end;
- end;
- procedure TGroup.ProcessOnGroupMemberLeaveRespone(Data: String);
- var
- jo: ISuperObject;
- ja: TSuperArray;
- nTeamID: String;
- itemIndex: Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- itemIndex := FTeams.IndexOf(nTeamID);
- if itemIndex > -1 then
- begin
- MainForm.WebSocketQuitTeam(nTeamID);
- FTeams.Delete(itemIndex);
- end;
- end;
- procedure TGroup.ProcessOnGroupMemberRemoveBroadCast(Data: String);
- var
- jo: ISuperObject;
- ja,jauser: TSuperArray;
- ISSucceed: Boolean;
- nTeamID: String;
- msg: String;
- name: String;
- iLoop,jLoop: Integer;
- RealICQTeam: TRealICQTeam;
- index,itemIndex:Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- jauser := ja[0]['users'].AsArray;
- itemIndex := Fteams.IndexOf(nTeamID);
- if itemindex >= -1 then
- begin
- RealICQTeam := FTeams.Objects[itemIndex] as TRealICQTeam;
- for jLoop := 0 to jauser.Length - 1 do
- begin
- try
- name := jauser[jLoop].AsString;
- if AnsiSameText(name, MainForm.RealICQClient.LoginName) then
- begin
- //MainForm.WebSocketRemoveTeamResponse(RealICQTeam.FTeamID);
- MainForm.WebSocketQuitTeam(nTeamID);
- FTeams.Delete(itemIndex);
- Exit;
- end;
- except
- on E: Exception do
- Error(E.Message, 'TGroup.ProcessOnGroupMemberRemoveBroadCast(' + Data +')');
- end;
- end;
- SendGetTeamInfo(nTeamID);
- end;
- end;
- procedure TGroup.ProcessOnGroupMemberRemoveResponse(Data: String);
- var
- jo: ISuperObject;
- ja,jauser: TSuperArray;
- ISSucceed: Boolean;
- nTeamID: String;
- msg: String;
- name: String;
- iLoop,jLoop: Integer;
- RealICQTeam: TRealICQTeam;
- index,itemIndex:Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- ISSucceed := not ja[0]['ret'].AsBoolean;
- nTeamID := ja[0]['id'].AsString;
- msg := ja[0]['msg'].AsString;
- jauser := ja[0]['users'].AsArray;
- SendGetTeamInfo(nTeamID);
- // itemIndex := Fteams.IndexOf(nTeamID);
- // if itemindex >= 0 then
- // begin
- // RealICQTeam := FTeams.Objects[itemIndex] as TRealICQTeam;
- // for jLoop := 0 to jauser.Length - 1 do
- // begin
- // try
- // name := jauser[jLoop].AsString;
- // if not AnsiSameText(name, MainForm.RealICQClient.LoginName) then
- // begin
- // RealICQTeam.TeamMembers := StringReplace(Chr(10) +RealICQTeam.TeamMembers + Chr(10), Chr(10) +name + char(10),char(10),[rfReplaceAll]);
- // RealICQTeam.TeamMembers := Copy(RealICQTeam.TeamMembers, 2, Length(RealICQTeam.TeamMembers) - 1);
- // MainForm.WebSocketSendReadTeamInfo(nteamID);
- // end
- // else
- // begin
- // MainForm.WebSocketRemoveTeamResponse(RealICQTeam.TeamID);
- // FTeams.Delete(itemIndex);
- // end;
- // except
- // on E: Exception do
- // Error(E.Message, 'TGroup.ProcessOnGroupMemberRemoveResponse(' + Data +')');
- // end;
- // end;
- // end;
- end;
- function TGroup.GetAlias(ATeamID, ALoginName: string): string;
- var
- itemIndex: Integer;
- MemberCard: TTeamMemberCard;
- begin
- Result := '';
- MemberCard := GetMemberCard(ATeamID, ALoginName);
- if MemberCard <> nil then
- Result := MemberCard.Alias;
- end;
- function TGroup.GetMemberCard(ATeamID, ALoginName: string): TTeamMemberCard;
- var
- itemIndex: Integer;
- begin
- Result := nil;
- itemIndex := FTeamMemberCards.IndexOf(Format(MEMBERCARD_KEY, [ATeamID, ALoginName]));
- if ItemIndex >= 0 then
- Result := FTeamMemberCards.Objects[itemIndex] as TTeamMemberCard;
- end;
- function TGroup.GetOrCreateTeam(ATeamID: string): TObject;
- var
- iIndex: Integer;
- ATeam: TRealICQTeam;
- begin
- iIndex := FTeams.IndexOf(ATeamID);
- if iIndex = -1 then
- begin
- ATeam := TRealICQTeam.Create;
- ATeam.TeamID := ATeamID;
- iIndex := FTeams.AddObject(ATeamID, ATeam);
- end;
- ATeam := FTeams.objects[iIndex] as TRealICQTeam;
- Result := ATeam;
- end;
- function TGroup.GetTeam(ATeamID: string): TObject;
- var
- iIndex: Integer;
- ATeam: TRealICQTeam;
- begin
- ATeam := nil;
- iIndex := FTeams.IndexOf(ATeamID);
- if iIndex > -1 then
- ATeam := FTeams.objects[iIndex] as TRealICQTeam;
- Result := ATeam;
- end;
- procedure TGroup.ProcessOnGroupMemberUpdateResponse(Data: String);
- var
- jo: ISuperObject;
- ja,jaUser: TSuperArray;
- nTeamID: String;
- UserID,Alias: String;
- ret,ItemIndex,UserIndex: Integer;
- RealICQTeam : TRealICQTeam;
- MemberCard: TTeamMemberCard;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- jaUser := ja[0]['users'].AsArray;
- UserID := jaUser[0]['id'].AsString;
- Alias := jaUser[0]['alias'].AsString;
- MemberCard := GetMemberCard(nTeamID, UserID);
- if MemberCard <> nil then
- begin
- MemberCard.Alias := Alias;
- MainForm.WebSocketSendReadTeamInfo(nteamID);
- end;
- end;
- procedure TGroup.ProcessOnGroupRemoveBroadcast(Data: String);
- var
- jo: ISuperObject;
- ja: TSuperArray;
- nTeamID:String;
- itemIndex: Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- itemIndex := FTeams.IndexOf(nTeamID);
- if itemIndex >= 0 then
- begin
- MainForm.WebSocketRemoveTeamResponse(nTeamID);
- FTeams.Delete(itemIndex);
- end;
- end;
- procedure TGroup.ProcessOnGroupRemoveResponse(Data: String);
- var
- jo: ISuperObject;
- ja: TSuperArray;
- HWnd:THandle;
- itemIndex: Integer;
- nTeamID: String;
- TeamCreated: Boolean;
- TeamCaption,
- FailingCause: String;
- RealICQTeam: TRealICQTeam;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- nTeamID := ja[0]['id'].AsString;
- TeamCreated := not ja[0]['ret'].AsBoolean;
- FailingCause := ja[0]['msg'].AsString;
- TeamCaption := '';
- itemIndex := FTeams.IndexOf(nTeamID);
- if itemIndex >= 0 then
- begin
- RealICQTeam := FTeams.Objects[itemIndex] as TRealICQTeam;
- MainForm.WebSocketRemoveTeamResponse(nTeamID);
- FTeams.Delete(itemIndex);
- FreeAndNil(RealICQTeam);
- end;
- end;
- procedure TGroup.ProcessOnGroupSayBroadCast(Data: String);
- const
- cUnixStartDate: TDateTime = 25569.0;
- var
- jo: ISuperObject;
- ja,jastyle: TSuperArray;
- ID: String;
- Groupid: String;
- Sayer: String;
- Style: String;
- Msg: String;
- TimesTamp: Int64;
- Hwnd: THandle;
- aDateTime: TDateTime;
- FontName,FontSize,FontsStyle,FontColor: String;
- jaImgs: TSuperArray;
- FileName,Hash: String;
- ret,iLoop,itemindex: Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- ID := ja[0]['id'].AsString;
- Groupid := ja[0]['groupid'].AsString;
- Sayer := ja[0]['sender'].AsString;
- jastyle := ja[0]['style'].AsArray;
- FontName := jastyle[0].AsString;
- FontColor := jastyle[2].AsString;
- FontSize := jastyle[1].AsString;
- FontsStyle := jastyle[3].AsString;
- Style := Format('"%s", %s, [%s], [%s]',[Fontname, FontSize, FontsStyle, FontColor]);
- Msg := ja[0]['msg'].AsString;
- TimesTamp := ja[0]['timestamp'].AsInteger;
- aDateTime := UnixToDateTime(Round(TimesTamp / 1000)+8*60*60);
- Msg := StringReplace(Msg, '\r\n', #13#10, [rfReplaceAll]);
- Msg := StringReplace(Msg, '[\r][\n]', '\r\n', [rfReplaceAll]);
- jaImgs := ja[0]['imgs'].AsArray;
- for ILoop := 0 to jaImgs.Length - 1 do
- begin
- ret := jaImgs[iLoop]['ret'].AsInteger;
- if ret =1 then
- begin
- Hash := jaImgs[iLoop]['hash'].AsString;
- FileName := jaImgs[iLoop]['file'].AsString;
- DownloadTeamFace(Hash,FileName,'');
- end;
- end;
- MainForm.WebSocketRecivedbroadcastmesssage(ID,Groupid,Sayer,Style,Msg,aDateTime);
- end;
- procedure TGroup.ProcessOnGroupSayResponse(Data: String);
- var
- ret: Integer;
- jo: ISuperObject;
- jaArgs,jaImgs: TSuperArray;
- FileName,Hash,ID,GroupId: String;
- iLoop,itemindex: Integer;
- begin
- //showmessage(Data);
- jo := SO(Data);
- jaArgs := jo['args'].AsArray;
- ID := jaArgs[0]['id'].AsString;
- GroupId := jaArgs[0]['groupid'].AsString;
- jaImgs := jaArgs[0]['imgs'].AsArray;
- for ILoop := 0 to jaImgs.Length - 1 do
- begin
- ret := jaImgs[iLoop]['ret'].AsInteger;
- Hash := jaImgs[iLoop]['hash'].AsString;
- FileName := jaImgs[iLoop]['file'].AsString;
- if ret = 0 then
- begin
- UploadFile(hash,TRealICQClient.GetReceivedFaceDir+FileName,id,GroupId);
- end;
- end;
- end;
- procedure TGroup.ProcessOnGroupSearch(Data: String);
- var
- jo : ISuperObject;
- ja,jaGroups : TSuperArray;
- searchTeams: TStringList;
- SearchTeam: TSearchTeamResultRecord;
- iLoop: Integer;
- begin
- jo := SO(Data);
- ja := jo['args'].AsArray;
- jaGroups := ja[0]['groups'].AsArray;
- searchTeams := TStringList.Create;
- try
- for iLoop := 0 to jaGroups.Length - 1 do
- begin
- SearchTeam := TSearchTeamResultRecord.Create;
- SearchTeam.TeamID := jaGroups[iLoop]['id'].AsString;
- SearchTeam.TeamCaption := jaGroups[iLoop]['name'].AsString;
- SearchTeam.TeamCreater := jaGroups[iLoop]['creator'].AsString;
- searchTeams.AddObject(IntToStr(iLoop),SearchTeam);
- end;
- SearchTeamForm.ShowTeamSearchResult(searchTeams);
- finally
- searchTeams.Free;
- end;
- end;
- procedure TGroup.ProcessOnGroupSubscribeResponse(Data: String);
- var
- jo, joFromDB: ISuperObject;
- ja,ja2, jaVers: TSuperArray;
- i, versionFromServer, versionFromDB: Integer;
- RealICQTeam: TRealICQTeam;
- nTeamID, AJson: String;
- HWnd: THandle;
- AKeyValue: TKeyValue;
- begin
- FTeams.Clear;
- jo := SO(Data);
- ja := jo.A['args'];
- ja2 := ja[0].A['groups'];
- jaVers := ja[0].A['vers'];
- for I := 0 to ja2.Length - 1 do
- begin
- nTeamID := ja2.S[i];
- if (jaVers <> nil) and (i <= jaVers.Length - 1) then
- versionFromServer := jaVers.I[i]
- else
- begin
- SendGetTeamInfo(nTeamID);
- Continue;
- end;
- AKeyValue := GetMapTeamUsersProvider.FindKeyValue(nTeamID);
- versionFromDB := StrToIntDef(AKeyValue[2], -1);
- AJson := AKeyValue[1];
- if (versionFromDB < 0) or (versionFromDB <> versionFromServer) or (AJson = '') then
- begin
- SendGetTeamInfo(nTeamID);
- end
- else
- begin
- joFromDB := SO(AJson);
- UpdateTeamInfoFromJson(joFromDB);
- MainForm.WebSocketSendReadTeamInfo(nTeamID);
- end;
- end;
- // for I := 0 to ja2.Length - 1 do
- // begin
- // nTeamID := ja2.O[i].S['id'];
- // versionFromServer := ja2.O[i].I['ver'];
- // AKeyValue := GetMapTeamUsersProvider.FindKeyValue(nTeamID);
- // versionFromDB := StrToIntDef(AKeyValue[2], -1);
- // AJson := AKeyValue[1];
- // if (versionFromDB < 0) or (versionFromDB <> versionFromServer) or (AJson = '') then
- // begin
- // SendGetTeamInfo(nTeamID);
- // end
- // else
- // begin
- // joFromDB := SO(AJson);
- // UpdateTeamInfoFromJson(joFromDB);
- // MainForm.WebSocketSendReadTeamInfo(nTeamID);
- // end;
- // end;
- end;
- { TODO -olqq -c : 统一Send方法发送数据,统一异常处理 2014/12/13 23:03:17 }
- procedure TGroup.Send(Data: string);
- begin
- try
- if (FClient <> nil) and (not FClient.Closed) then
- FClient.SendText(AnsiToUTF8(Data));
- except
- on E: Exception do
- begin
- Error(E.Message, 'TGroup.Send('+Data+')');
- end;
- end;
- end;
- procedure TGroup.SendGetTeamInfo(ATeamID: String);
- var
- SendStr:String;
- jo: ISuperObject;
- begin
- SendStr := '5:::'+ '{"name":"group.info","args":{"id":"","groups":[{"id":"'+ATeamID+'","ver":0}]}}';
- { TODO -olqq -c : 统一发送调用 2014/12/13 12:38:42 }
- Send(SendStr);
- //FClient.SendText(AnsiToUTF8(SendStr));//, GetCurCP, UTF_8));
- end;
- procedure TGroup.SendMessage(Data: String);
- begin
- { TODO -olqq -c : 统一发送调用 2014/12/13 12:38:42 }
- Send(Data);
- //FClient.SendText({CharsetConversion(Dat a, GetCurCP, UTF_8)}AnsiToUTF8(Data));
- end;
- procedure TGroup.SetGetTeamInfo(const Value: TOnGetTeamInfo);
- begin
- FOnGetTeamInfo := Value;
- end;
- procedure TGroup.SetLoginName(const Value: string);
- begin
- FLoginName := Value;
- end;
- procedure TGroup.Start;
- var
- IdHttp:TIdHTTP;
- ResponeStr: String;
- ResourceName: String;
- tempstringlist : TStringList;
- heartbeatTimeOut: Integer;
- begin
- IdHttp:= TIdHTTP.Create(nil);
- try
- ResponeStr := Idhttp.get('http://'+FIP+':'+inttostr(FPort)+'/socket.io/1/');
- except
- on E: Exception do
- begin
- Freeandnil(IdHttp);
- Error(E.Message, 'TGroup.Start');
- Reconnect;
- Exit;
- end;
- end;
- Freeandnil(IdHttp);
-
- tempstringlist := TStringList.create;
- try
- tempstringlist.Delimiter := ':';
- tempstringlist.DelimitedText := ResponeStr;
- ResourceName := tempstringlist[0];
- heartbeatTimeOut := StrToInt(tempstringlist[1]);
- except
- on E: Exception do
- begin
- tempstringlist.Free;
- Error(E.Message, 'TGroup.Start');
- Reconnect;
- Exit;
- end;
- end;
- tempstringlist.Free;
- FClient := TTestWebSocketClientConnection.Create(FIP, inttostr(FPort), '/socket.io/1/websocket/'+ResourceName,'-','ws');
- FClient.OnRead := OnRead;
- FClient.OnWrite := OnWrite;
- FClient.OnClose := OnClose;
- FClient.OnOpen := OnOpen;
- //fClient.Socket.OnSyncStatus := OnConnectionSocket;
- // FClient.SSL := FUseSSL;
- FClient.Start;
- { TODO -olqq -c : 服务端已经有心跳发送 2014/12/12 16:07:11 }
- end;
- procedure TGroup.StopReconnect;
- begin
- MainForm.TimerForreconnectgroup.Enabled := False;
- end;
- procedure TGroup.TestEvent;
- begin
- if Assigned(FOnGetTeamInfo) then
- try
- FOnGetTeamInfo('11111122');
- except
- on e:Exception do
- showmessage(e.Message);
- end;
- end;
- {$ENDREGION}
- {$REGION '请求'}
- { TODO -olqq -c : 代替TMainForm.WebSocketInHttpSendFile 2014/12/16 12:53:56 }
- procedure TGroup.UploadFile(Hash, FileName, ID, GroupID: String);
- var
- AHttp: TIdHttp;
- MutPartForm:TIdMultiPartFormDataStream;
- Ret:TStringStream;
- response,UpUrl: String;
- jo,t,jofile: ISuperObject;
- SendStr: String;
- begin
- UpUrl := Format(UPLOAD_URL, [FImageIP, FImagePort]);
- 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);
- Application.ProcessMessages;
- 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 TGroup.AddTeamMembers(ATeamID: String; AUsers: TStringList);
- var
- jo :ISuperObject;
- iLoop : Integer;
- moreusers: String;
- begin
- jo := SO(ADDMEMBERS_PROTOCOL);
- jo.S['args.id'] := ATeamID;
- for iLoop := 0 to AUsers.Count - 1 do
- jo.A['args.users'].Add(TSuperObject.Create(AUsers[iLoop]));
- moreusers := '5:::' + jo.AsJSon(False,False);
- Send(moreusers);
- end;
- procedure TGroup.RemoveTeamMembers(ATeamID: string; AUsers: TStringList);
- var
- jo :ISuperObject;
- iLoop : Integer;
- moreusers: String;
- begin
- jo := SO(REMOVEMEMBERS_PROTOCOL);
- jo.S['args.id'] := ATeamID;
- for iLoop := 0 to AUsers.Count - 1 do
- begin
- jo.A['args.users'].Add(TSuperObject.Create(AUsers[iLoop]));
- end;
- moreusers := '5:::' + jo.AsJSon(False,False);
- Send(moreusers);
- end;
- procedure TGroup.UpdateTeamInfo(ATeamID, AIntro, ANotice, AName: string; AAuth: Integer);
- var
- TeamInfo: String;
- obj: ISuperObject;
- begin
- AIntro := StringReplace(AIntro, '\r\n', '[\r][\n]', [rfReplaceAll]);
- AIntro := StringReplace(AIntro, #13#10, '\r\n', [rfReplaceAll]);
- ANotice := StringReplace(ANotice, '\r\n', '[\r][\n]', [rfReplaceAll]);
- ANotice := StringReplace(ANotice, #13#10, '\r\n', [rfReplaceAll]);
- obj := SO();
- obj['name'] := TSuperObject.Create('group.update');
- obj['args.id'] := TSuperObject.Create(ATeamID);
- obj['args.group.intro'] := TSuperObject.Create(AIntro);
- obj['args.group.notice'] := TSuperObject.Create(ANotice);
- obj['args.group.name'] := TSuperObject.Create(AName);
- obj['args.group.auth'] := TSuperObject.Create(AAuth);
- TeamInfo := '5:::' + obj.AsJSon(False,False);
- Send(TeamInfo);
- end;
- procedure TGroup.SendTeamMessage(ATeamID, ASender, AMsg: String; AFont: TFont; AFaces: TStringList; Attachs: String);
- var
- jo : ISuperObject;
- joStyle: ISuperObject;
- tFile,jofile: ISuperObject;
- tAttach,joattach: ISuperObject;
- sendstr: String;
- MD5HashValue: MD5Digest;
- MD5HashString: String;
- iLoop: Integer;
- AFace: TFace;
- begin
- AMsg := StringReplace(AMsg, '\r\n', '[\r][\n]', [rfReplaceAll]);
- AMsg := StringReplace(AMsg, #13#10, '\r\n', [rfReplaceAll]);
- jo := SO();
- jo.S['name'] := 'group.say';
- jo.S['args.id'] := '';
- jo.S['args.groupid'] := ATeamID;
- jo.S['args.sender'] := ASender;
- joStyle := SA([]);
- joStyle.AsArray.S[0] := AFont.Name;
- joStyle.AsArray.S[1] := inttostr(AFont.Size);
- joStyle.AsArray.S[2] := ColorToString(AFont.Color);
- joStyle.AsArray.S[3] := FontStyleToString(AFont);
- jo['args.style'] := joStyle;
- jo.S['args.msg'] := AMsg;
- jo.S['args.timestamp'] :='';
- tFile := SA([]);
- 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);
- tFile.AsArray.Add(jofile);
- end;
- jo['args.imgs'] := tFile;
- tAttach := SA([]);
- jo['args.attachs'] := tAttach;
- sendstr := '5:::' + jo.AsJSon(False,False);
- Send(sendstr);
- end;
- procedure TGroup.Subscribe;
- var
- str:String;
- begin
- str := Format(SUBSCRIBE_PROTOCOL, [FLoginName]);
- Send(str);
- end;
- procedure TGroup.UnSubscribe;
- var
- str:String;
- begin
- str := Format(UNSUBSCRIBE_PROTOCOL, [FLoginName]);
- Send(str);
- end;
- procedure TGroup.Search(AKey, AName, ATeamID, ACreator: String);
- var
- jo: ISuperObject;
- SearchStr: String;
- begin
- jo := SO();
- jo['name'] := TSuperObject.Create('group.search');
- jo['args.keyword'] := TSuperObject.Create(AKey);
- jo['args.name'] := TSuperObject.Create(AName);
- jo['args.groupid'] := TSuperObject.Create(ATeamID);
- jo['args.creator'] := TSuperObject.Create(ACreator);
- SearchStr := '5:::' + jo.AsJSon(False,False);
- Send(SearchStr);
- end;
- procedure TGroup.AddManager(ATeamID, AName: String);
- var
- addManager: String;
- begin
- addManager := Format(ADDMANAGER_PROTOCOL, [ATeamID, AName]);
- Send(addManager);
- end;
- procedure TGroup.Reconnect;
- begin
- MainForm.TimerForreconnectgroup.Enabled := False;
- MainForm.TimerForreconnectgroup.Interval := RandomRange(10000,60000);
- Info(IntToStr(MainForm.TimerForreconnectgroup.Interval) + '毫秒之后,开始重连。', 'TGroup.Reconnect');
- MainForm.TimerForreconnectgroup.Enabled := True;
- end;
- procedure TGroup.RemoveManager(ATeamID, AName: String);
- var
- addManager: String;
- begin
- addManager := Format(REMOVEMANAGER_PROTOCOL, [ATeamID, AName]);
- Send(addManager);
- end;
- procedure TGroup.Leave(ATeamID: string);
- var
- MemberQuit: String;
- begin
- MemberQuit := Format(LEAVE_PROTOCOL, [ATeamID, FLoginName]);
- Send(MemberQuit);
- end;
- procedure TGroup.RemoveMember(ATeamID,AName: String);
- var
- RemoveMember: String;
- begin
- RemoveMember := Format(REMOVEMEMBER_PROTOCOL, [ATeamID, AName]);
- Send(RemoveMember);
- end;
- procedure TGroup.RemoveTeam(ATeamID: String);
- var
- DeleteGroup:String;
- begin
- DeleteGroup := Format(REMOVETEAM_PROTOCOL, [ATeamID]);
- Send(DeleteGroup);
- end;
- procedure TGroup.JoinTeamResponse(ATeamID, ALoginName, AMsg: String; ARet : Integer);
- var
- jo: ISuperObject;
- ResponseStr: String;
- begin
- jo := SO();
- jo.S['name'] := 'group.member.apply.confirm.reply';
- jo.S['args.id'] := '';
- jo.S['args.groupid'] := ATeamID;
- jo.S['args.userid'] := ALoginName;
- jo.I['args.ret'] := ARet;
- jo.S['args.msg'] := AMsg;
- ResponseStr := '5:::' + jo.AsJSon(False,False);
- Send(ResponseStr);
- end;
- procedure TGroup.JoinTeam(ATeamID, ATag: String);
- var
- jo : ISuperObject;
- SearchStr: String;
- begin
- if group.Teams.IndexOf(ATeamID) >= 0 then
- raise Exception.CreateFmt('%s 已在群组列表中', [ATeamID]);
- jo := SO();
- jo.S['name'] := 'group.member.apply';
- jo.S['args.id'] := '';
- jo.S['args.groupid'] := ATeamID;
- jo.S['args.userid'] := FLoginName;
- jo.S['args.msg'] := ATag;
- SearchStr := '5:::' + jo.AsJSon(False,False);
- Send(SearchStr);
- end;
- procedure TGroup.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;
- function TGroup.FormatStrFromServer(AStr: string): string;
- begin
- Result := StringReplace(AStr, '\r\n', #13#10, [rfReplaceAll]);
- Result := StringReplace(Result, '[\r][\n]', '\r\n', [rfReplaceAll]);
- end;
- function TGroup.FormatStrToServer(AStr: string): string;
- begin
- end;
- procedure TGroup.DownFaceFileComplete(Source_file, Dest_file: String;
- blStatus: boolean; ErrMessage: String);
- begin
- ShowGettedFace(Dest_file);
- end;
- procedure TGroup.SetAlias(ATeamID, ALoginName, Alias: String);
- var
- jo,
- jouser,
- t: ISuperObject;
- SendStr: String;
- begin
- jo := SO();
- jo.S['name'] := 'group.member.update';
- jo.S['args.id'] := ATeamID;
- t := SA([]);
- jouser := SO();
- jouser.S['id'] := ALoginName;
- jouser.S['alias'] := Alias;
- t.AsArray.Add(jouser);
- jo['args.users'] := t;
- SendStr := '5:::' + jo.AsJSon(False,False);
- Send(SendStr);
- end;
- procedure TGroup.SendFilesRequest(AGroupId, AUserId,
- FileName: String);
- var
- jo,jofile: ISuperObject;
- t : ISuperObject;
- SendFileStr: String;
- MD5HashValue: MD5Digest;
- MD5HashString: String;
- begin
- MD5HashValue := MD5File(FileName);
- MD5HashString := MD5.MD5Print(MD5HashValue);
- jo := SO();
- jo.S['name'] := 'file.upload';
- jo.S['args.groupid'] := AGroupId;
- jo.S['args.userid'] := AUserId;
- jo.S['args.id'] := '';
- t := SA([]);
- jofile := SO();
- jofile.S['file'] := ExtractFileName(filename);
- jofile.S['hash'] := UpperCase(MD5HashString);
- t.AsArray.Add(jofile);
- jo['args.files'] := t;
-
- SendFileStr := '5:::' + jo.AsJSon(False,False);
- Send(SendFileStr);
- end;
- procedure TGroup.CreateTeam(ATeamName, ATeamCallBoard, ATeamIntro: String;
- ATeamMembers: TStringList; AIsTempTeam: Boolean);
- var
- createGroup:String;
- jo: ISuperObject;
- ja: TSuperArray;
- iLoop: Integer;
- begin
- jo := SO('{"name":"group.add","args":{"name":"","type":"","creator":"","users":[]}}');
- jo.S['args.name'] := Trim(ATeamName);
- jo.I['args.type'] := 0;
- jo.S['args.creator'] := FLoginName;
- ja := jo.A['args.users'];
- for iLoop := 1 to ATeamMembers.Count - 1 do
- ja.S[iloop-1] := ATeamMembers[iLoop];
- createGroup := '5:::'+ jo.AsJSon(False, False);
- Send(createGroup);
- end;
- {$ENDREGION}
- end.
|