RealICQClient/Client/Services/TextMessageService.pas

unit TextMessageService;

interface

uses
  BaseService, PerlRegEx, Classes, SysUtils, StrUtils, RealICQModel, Forms;

type
  TTextMessageService = class(TBaseService)
  private
    FMessages, FTeamMessages: TStringList;
    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;
    procedure OnUploaded(ASender: TObject);
    procedure UploadFaces(AMsg: TObject; AFaces: TStringList);
  public
    procedure HandleAsycTextMessage(AData: array of Byte);
    procedure SendMessage(AMsg: TRealICQMessage; AFaces: TStringList); overload;
    procedure SendMessage(AMsg: TRealICQTeamMessage; AFaces: TStringList); overload;
    function CreateMessage: TRealICQMessage;
    function CreateTeamMessage: TRealICQTeamMessage;
    function GetMessage(AMessageID: string): TRealICQMessage;
    function GetTeamMessage(AMessageID: string): TRealICQTeamMessage;
    function PreProccess(ATalkingForm: TForm; ASender: string; AMessageContent: string; AShowCustomFace: Boolean = True): string;
    function ContentFilter(AMsg: TRealICQMessage): string;
    procedure Init;
    procedure Uninstall;
    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, RealICQUtility;

var
  ATextMessageService: TTextMessageService;

const
  IMAGE_LOADED_TAG: string = '<img oncontextmenu="location.href=''FaceMenu_%s'';return false;" src="%s" align="absBottom" hspace="1" onload="AutoResizeImage(250,250,this)" onclick="openInIE(this)">';
  IMAGE_LOADING_TAG: string = '<img ID = "%s" oncontextmenu="location.href=''FaceMenu_%s'';return false;" src="%s" align="absBottom" hspace="1" onload="AutoResizeImage(250,250,this)" onclick="openInIE(this)">';
  VOICE_TAG: string = '<object id="%s" width="300" height="63" classid="CLSID:6BF52A52-394A-11d3-B153-00C04F79FAA6" codebase="http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=7.0" align="top" border="0" type="application/x-oleobject">' + '<param name="URL" value="%s">' + '<param name="AUTOSTART" value="0">' + '<param name="uiMode" value="mini">' + '</object>';
  MAP_IFRAME_TAG: string = '<iframe src="%s" frameborder="no" border="0" ></iframe>';
{ 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
  FMessages := TStringList.Create;
  FTeamMessages := TStringList.Create;
  inherited;
end;

function TTextMessageService.CreateMessage: TRealICQMessage;
begin
  Result := TRealICQMessage.Create(MainForm.RealICQClient.LoginName, '', '', '', False);

  with Result do
  begin
    MessageID := GetTickCount;
    while FMessages.IndexOf(IntToStr(MessageID)) >= 0 do
    begin
      Sleep(100);
      MessageID := GetTickCount;
    end;
    SendDateTime := Now;
    FMessages.InsertObject(0, IntToStr(MessageID), Result);
  end;
end;

function TTextMessageService.CreateTeamMessage: TRealICQTeamMessage;
begin
  Result := TRealICQTeamMessage.Create('', '', '', '', False);
  with Result do
  begin
    MessageID := GetTickCount;
    while FTeamMessages.IndexOf(IntToStr(MessageID)) >= 0 do
    begin
      Sleep(100);
      MessageID := GetTickCount;
    end;
    SendDateTime := Now;
    FTeamMessages.InsertObject(0, IntToStr(MessageID), Result);
  end;
end;

destructor TTextMessageService.Destroy;
begin
  TRealICQUtility.FreeStringList(FMessages);
  TRealICQUtility.FreeStringList(FTeamMessages);
  inherited;
end;

class function TTextMessageService.GetService: TTextMessageService;
begin
  if ATextMessageService = nil then
    ATextMessageService := TTextMessageService.Create;

  Result := ATextMessageService;
end;

function TTextMessageService.GetTeamMessage(AMessageID: string): TRealICQTeamMessage;
var
  i: Integer;
begin
  i := FMessages.IndexOf(AMessageID);
  if i > -1 then
    Result := FMessages.Objects[i] as TRealICQTeamMessage;         
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, '&amp;', '&');
      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;

procedure TTextMessageService.Init;
begin
  TRealICQUtility.ClearStringList(FMessages);
  TRealICQUtility.ClearStringList(FTeamMessages);
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, '<img ' + ContextMenuStr + ' src="' + Face.FileName + '" align="absBottom" hspace="1" >');
  end;

  Result := AMessageContent;
end;

procedure TTextMessageService.OnUploaded(ASender: TObject);
begin

end;

procedure TTextMessageService.UploadFaces(AMsg: TObject; AFaces: TStringList);
begin

end;

procedure TTextMessageService.SendMessage(AMsg: TRealICQTeamMessage; AFaces: TStringList);
begin
  if Assigned(AFaces) and (AFaces.Count > 0) then
    UploadFaces(AMsg, AFaces)
  else    
  
end;

procedure TTextMessageService.Uninstall;
begin

end;

procedure TTextMessageService.SendMessage(AMsg: TRealICQMessage; AFaces: TStringList);
begin

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;
begin
  Result := Format(MAP_IFRAME_TAG, [AnsiReplaceText(AImgUrl, '&amp;', '&')]);
end;

function TTextMessageService.GetMessage(AMessageID: string): TRealICQMessage;
var
  i: Integer;
begin
  i := FMessages.IndexOf(AMessageID);
  if i > -1 then
    Result := FMessages.Objects[i] as TRealICQMessage;
end;

end.