unit TextMessageService; interface uses BaseService, PerlRegEx, Classes, SysUtils, StrUtils, RealICQModel, Forms; type TTextMessageService = class(TBaseService) private function GetImageReplacementStr(AImgUrl: string; ATalkingForm: TForm): string; function GetMapReplacementStr(AImgUrl: string; ATalkingForm: TForm): string; function GetVoiceReplacementStr(AVoiceUrl: string): string; function GetGradeReplacementStr(AGradeUrl: string; AShowForm: Boolean = False): string; public procedure HandleAsycTextMessage(AData: Array of Byte); function PreProccess(ATalkingForm: TForm; ASender: String; AMessageContent: string; AShowCustomFace: Boolean = True): string; function ContentFilter(AMsg: TRealICQMessage): string; constructor Create; destructor Destroy; override; class function GetService: TTextMessageService; static; end; implementation uses Windows, RealICQDBHistory, MainFrm, TalkingFrm, IdURI, ShareUtils, DownloadFaceWithHttp, RealICQClient, MessagesHander, HttpDownloader, MD5, BaseChromeView, UsersService; var ATextMessageService: TTextMessageService; const IMAGE_LOADED_TAG: string = ''; IMAGE_LOADING_TAG: string = ''; VOICE_TAG: string = '' + '' + '' + '' + ''; MAP_IFRAME_TAG: string = ''; { TTextMessageService } function TTextMessageService.ContentFilter(AMsg: TRealICQMessage): string; var reg: TPerlRegEx; begin reg := TPerlRegEx.Create; try reg.Subject := AMsg.MessageStr; reg.RegEx := '\[(\w+)\-src=\"(http://[\w\W]+)\"]'; while reg.MatchAgain do begin if CompareText(reg.Groups[1], 'grade') = 0 then begin reg.Replacement := GetGradeReplacementStr( reg.Groups[2], not SameText(TUsersService.GetUsersService.GetMe.LoginName, AMsg.Sender)); reg.Subject := reg.Replace(); end; end; Result := reg.Subject; finally reg.Free; end; end; constructor TTextMessageService.Create; begin inherited; end; destructor TTextMessageService.Destroy; begin inherited; end; class function TTextMessageService.GetService: TTextMessageService; begin if ATextMessageService = nil then ATextMessageService := TTextMessageService.Create; Result := ATextMessageService; end; function TTextMessageService.GetGradeReplacementStr(AGradeUrl: string; AShowForm: Boolean = False): string; var AForm: TBaseChromeViewForm; begin Result := '请您为我们这次服务给个评分或提个建议,谢谢!'; if AShowForm then begin AForm := TBaseChromeViewForm.Create(nil); try AForm.Caption := '评分系统'; AForm.ChangeUIColor(MainForm.FormColor); AForm.Width := 720; AForm.Height := 394; AForm.Top := (Screen.Height - 394) div 2; AForm.Left := (Screen.Width - 720) div 2; AForm.URL := AnsiReplaceText(AGradeUrl, '&', '&'); AForm.Show; finally end; end; end; function TTextMessageService.GetVoiceReplacementStr(AVoiceUrl: string): string; var AMD5String, ALocalPath, AFileName, AFaceID: string; AURL: TIdURI; ATask: THttpDownloader; WaitingFace: TWaitingFace; begin // Result := Format(MAP_IFRAME_TAG, [ExtractFilePath(Application.ExeName) + 'html\mp3.html']); AURL := TIdURI.Create(); AURL.URI := AVoiceUrl; AMD5String := ChangeFileExt(ExtractFileName(AURL.Document),''); if not (CompareText(ExtractFileExt(AURL.Document), '.mp3') = 0) then begin Result := '对不起,目前只支持MP3音频格式'; AURL.Free; Exit; end; ALocalPath := TRealICQClient.GetReceivedFaceDir + ExtractFileName(AURL.Document); AFileName := ReplaceStr(ALocalPath, '\', '/'); // Dialog.ShowMessage(Format(VOICE_TAG, ['voice_'+AMD5String, AFileName])); Result := Format(VOICE_TAG, ['voice_'+AMD5String, AFileName]); if not FileExists(ALocalPath) then begin ATask := THttpDownloader.Create(AURL.URI, ALocalPath, AThreadPool.AcquireYarn); AThreadPool.StartYarn(ATask.Yarn, ATask); end; AURL.Free; end; procedure TTextMessageService.HandleAsycTextMessage(AData: array of Byte); var FontStrLength, SenderLoginNameLength, ReceiverLoginNameLength: Byte; nIndex, IsEncry, MessageStrLength: SmallInt; MessageID: Cardinal; SendDateTime: TDateTime; SenderLoginName, ReceiverLoginName, FontStr, MessageStr: String; RealICQMessage: TRealICQMessage; RealICQUser: TRealICQUser; TalkingForm: TTalkingForm; begin nIndex := 0; //取 (3)接收人用户名长度 1byte CopyMemory(@ReceiverLoginNameLength, @AData[nIndex], 1); Inc(nIndex, 1); //取 (4)接收人用户名 动态长度,由(3)指定,接收消息的用户的用户名,如果是服务器中转此处会变成消息的发送人。 SetLength(ReceiverLoginName, ReceiverLoginNameLength); CopyMemory(PChar(ReceiverLoginName), @AData[nIndex], ReceiverLoginNameLength); Inc(nIndex, ReceiverLoginNameLength); //取 (5)发送人用户名长度 1byte CopyMemory(@SenderLoginNameLength, @AData[nIndex], 1); Inc(nIndex, 1); //取 (6)发送人用户名 动态长度,由(5)指定。 SetLength(SenderLoginName, SenderLoginNameLength); CopyMemory(PChar(SenderLoginName), @AData[nIndex], SenderLoginNameLength); Inc(nIndex, SenderLoginNameLength); //取 (7)消息的编号 4byte,无符号32位整型数据 CopyMemory(@MessageID, @AData[nIndex], 4); Inc(nIndex, 4); //取 (8)发送消息的时间 8byte,64位浮点类型(double即TDateTime类型) CopyMemory(@SendDateTime, @AData[nIndex], 8); Inc(nIndex, 8); //取 (9)字体信息长度 1byte, CopyMemory(@FontStrLength, @AData[nIndex], 1); Inc(nIndex, 1); //取 (10)字体信息 动态长度,由(9)指定。 SetLength(FontStr, FontStrLength); CopyMemory(PChar(FontStr), @AData[nIndex], FontStrLength); Inc(nIndex, FontStrLength); //取 (11)消息的长度 2byte,无符号16位整型。 CopyMemory(@MessageStrLength, @AData[nIndex], 2); Inc(nIndex, 2); //取 (12)消息内容 动态长度,由(11)指定。 SetLength(MessageStr, MessageStrLength); CopyMemory(PChar(MessageStr), @AData[nIndex], MessageStrLength); Inc(nIndex, MessageStrLength); //取(11)是否是私密消息 CopyMemory(@IsEncry, @AData[nIndex], 1); RealICQMessage := TRealICQMessage.Create(SenderLoginName, ReceiverLoginName, FontStr, MessageStr,IsEncry=1); RealICQMessage.MessageID := GetTickCount; //设为接收到此消息的时间,以便及时删除无用的消息 RealICQMessage.SendDateTime := SendDateTime; MainForm.DBHistory.SaveMessage('-1', RealICQMessage.Sender, RealICQMessage.Receiver, RealICQMessage.SendDateTime, RealICQMessage.FontStr, RealICQMessage.MessageStr,RealICQMessage.IsEncryMessage); TalkingForm := GetTalkingForm(ReceiverLoginName, MainForm.RealICQClient); if (TalkingForm <> nil) and (TalkingForm.CanWriteMessage) then begin TalkingForm.ShowMessage(RealICQMessage, false); end; end; function TTextMessageService.PreProccess(ATalkingForm: TForm; ASender: String; AMessageContent: string; AShowCustomFace: Boolean = True): string; var Face: TFace; iLoop, iStart, iIndex: Integer; MD5String: String; WaitingFace: TWaitingFace; FaceID, AFileName, ContextMenuStr: String; reg: TPerlRegEx; procedure ReplacesTag; begin while reg.MatchAgain do begin MD5String := reg.Groups[1]; iIndex := MainForm.FaceList.IndexOf(MD5String); if not AShowCustomFace then begin AFileName := ReplaceStr(FindRecvedFace(MD5String), '\', '/'); FaceID := MD5String + IntToStr(GetTickCount) + IntToStr(WaitingFaces.Count) + IntToStr(iStart); reg.Replacement := Format(IMAGE_LOADING_TAG, [FaceID, MD5String, AFileName]); reg.Subject := ReplaceStr(reg.Subject, reg.Groups[0], reg.Replacement); end else if iIndex >= 0 then begin Face := MainForm.FaceList.Objects[iIndex] as TFace; reg.Replacement := Format(IMAGE_LOADED_TAG, [MD5String, Face.FileName]); reg.Subject := ReplaceStr(reg.Subject, reg.Groups[0], reg.Replacement); end else if FileExists(FindRecvedFace(MD5String)) then begin AFileName := ReplaceStr(FindRecvedFace(MD5String), '\', '/'); reg.Replacement := Format(IMAGE_LOADED_TAG, [MD5String, AFileName]); reg.Subject := ReplaceStr(reg.Subject, reg.Groups[0], reg.Replacement); end else begin if ATalkingForm <> nil then with (ATalkingForm as TTalkingForm) do begin AFileName := ExtractFilePath(Application.ExeName) + 'Images\progress.gif'; AFileName := ReplaceStr(AFileName, '\', '/'); FaceID := MD5String + IntToStr(GetTickCount) + IntToStr(WaitingFaces.Count) + IntToStr(iStart); reg.Replacement := Format(IMAGE_LOADING_TAG, [FaceID, MD5String, AFileName]); reg.Subject := ReplaceStr(reg.Subject, reg.Groups[0], reg.Replacement); if WaitingFaces.IndexOf(MD5String) <> -1 then Continue; if Category = tcNormal then FRealICQClient.PleaseSendFaceToMe(Receiver, MD5String) else FRealICQClient.DownloadTeamFace(ASender, MD5String); if AShowCustomFace then begin WaitingFace := TWaitingFace.Create; WaitingFace.FFaceMD5Code := MD5String; WaitingFace.FWebBrowser := WebBrowser; WaitingFace.FFaceID := FaceID; WaitingFaces.AddObject(MD5String, WaitingFace); end; end else begin AFileName := ExtractFilePath(Application.ExeName) + 'Images\erre.gif'; AFileName := ReplaceStr(AFileName, '\', '/'); FaceID := MD5String + IntToStr(GetTickCount); reg.Replacement := Format(IMAGE_LOADING_TAG, [FaceID, MD5String, AFileName]); reg.Subject := ReplaceStr(reg.Subject, reg.Groups[0], reg.Replacement); end; end; end; end; begin reg := TPerlRegEx.Create; try reg.Subject := AMessageContent; reg.RegEx := '\[(\w+)\-src=\"(http://[\w\W]+?)\"\]'; while reg.MatchAgain do begin if CompareText(reg.Groups[1], 'IMAGE') = 0 then begin reg.Replacement := GetImageReplacementStr(reg.Groups[2], ATalkingForm); reg.Subject := reg.Replace(); end else if CompareText(reg.Groups[1], 'MAP') = 0 then begin reg.Replacement := GetMapReplacementStr(reg.Groups[2], ATalkingForm); reg.Subject := reg.Replace(); end else if CompareText(reg.Groups[1], 'voice') = 0 then begin reg.Replacement := GetVoiceReplacementStr(reg.Groups[2]); reg.Subject := reg.Replace(); end; end; AMessageContent := reg.Subject; finally reg.Free; end; reg := TPerlRegEx.Create; try reg.Subject := AMessageContent; reg.RegEx := '\[IMG:([\w\W]+?)\]'; ReplacesTag; reg.RegEx := '\[image\-src=\"([\w\W]+?)\"\]'; ReplacesTag; AMessageContent := reg.Subject; finally reg.Free; end; //取系统表情 for iLoop := 0 to MainForm.SystemFaceCount - 1 do begin Face := MainForm.FaceList.Objects[iLoop] as TFace; ContextMenuStr := 'oncontextmenu="location.href=''StandardFaceMenu_' + Face.ShortCut + ''';return false;"'; AMessageContent := AnsiReplaceStr(AMessageContent, Face.ShortCut, ''); end; Result := AMessageContent; end; function TTextMessageService.GetImageReplacementStr(AImgUrl: string; ATalkingForm: TForm): string; var AMD5String, ALocalPath, AFileName, AFaceID: string; AURL: TIdURI; ATask: TDownloadFaceTask; WaitingFace: TWaitingFace; begin AURL := TIdURI.Create(); AURL.URI := AImgUrl; AMD5String := ChangeFileExt(ExtractFileName(AURL.Document),''); ALocalPath := TRealICQClient.GetReceivedFaceDir + AMD5String + ExtractFileExt(AURL.Params); if FileExists(ALocalPath) then begin AFileName := ReplaceStr(ALocalPath, '\', '/'); Result := Format(IMAGE_LOADED_TAG, [AMD5String, AFileName]); end else begin if ATalkingForm <> nil then begin AFaceID := AMD5String + IntToStr(GetTickCount) + IntToStr(WaitingFaces.Count); AFileName := ExtractFilePath(Application.ExeName) + 'Images\progress.gif'; Result := Format(IMAGE_LOADING_TAG, [AFaceID, AMD5String, AFileName]); WaitingFace := TWaitingFace.Create; WaitingFace.FFaceMD5Code := AMD5String; WaitingFace.FWebBrowser := (ATalkingForm as TTalkingForm).WebBrowser; WaitingFace.FFaceID := AFaceID; WaitingFaces.AddObject(AMD5String, WaitingFace); ATask := TDownloadFaceTask.Create(AURL.URI, ALocalPath, AThreadPool.AcquireYarn); AThreadPool.StartYarn(ATask.Yarn, ATask); end else begin AFaceID := AMD5String + IntToStr(GetTickCount); AFileName := ExtractFilePath(Application.ExeName) + 'Images\error.gif'; Result := Format(IMAGE_LOADING_TAG, [AFaceID, AMD5String, AFileName]); end; end; AURL.Free; end; function TTextMessageService.GetMapReplacementStr(AImgUrl: string; ATalkingForm: TForm): string; var AMD5String, ALocalPath, AFileName, AFaceID: string; ATask: TDownloadFaceTask; WaitingFace: TWaitingFace; begin Result := Format(MAP_IFRAME_TAG, [AnsiReplaceText(AImgUrl, '&', '&')]); // AMD5String := MD5En(AImgUrl); // ALocalPath := TRealICQClient.GetReceivedFaceDir + AMD5String + '.png'; // // if FileExists(ALocalPath) then // begin // AFileName := ReplaceStr(ALocalPath, '\', '/'); // Result := Format(MAP_IFRAME_TAG, [AMD5String, AFileName]); // end // else // begin // AFaceID := AMD5String + IntToStr(GetTickCount) + IntToStr(WaitingFaces.Count); // AFileName := ExtractFilePath(Application.ExeName) + 'Images\progress.gif'; // Result := Format(IMAGE_LOADING_TAG, [AFaceID, AMD5String, AFileName]); // // WaitingFace := TWaitingFace.Create; // WaitingFace.FFaceMD5Code := AMD5String; // WaitingFace.FWebBrowser := (ATalkingForm as TTalkingForm).WebBrowser; // WaitingFace.FFaceID := AFaceID; // WaitingFaces.AddObject(AMD5String, WaitingFace); // // ATask := TDownloadFaceTask.Create(AImgUrl, ALocalPath, AThreadPool.AcquireYarn); // AThreadPool.StartYarn(ATask.Yarn, ATask); // end; end; end.