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.