seo-include/SEOInclude.dpr

library SEOInclude;

uses
  Classes,
  Windows,
  Messages,
  plugin,
  pluginutil,
  Graphics,
  SysUtils,
  FWURLPosition,
  IniFiles,
  CallExec,
  System.AnsiStrings;

{$I NoRTTI.inc}
{$R SEOInclude.res}
{$R 'icons.res' 'Icons\icons.rc'}

type
  TPOSTThread = class(TThread)
  private
    isMsgGot: boolean;
  protected
    procedure Execute; override;
  end;

var
  MsgToCheck, MsgCheck, userPath, andrqPath, msg: AnsiString;
  delimpos, uin, flags, vApiVersion, currentUIN: Integer;
  When: TDateTime;
  ini: TIniFile;
  State: boolean = false;
  ressent: pointer;

  ba: Integer;
  hico: TIcon;
  URLPosition: TFWURLPosition;

  POST: TPOSTThread;

type
  TDynByteArray = array of Byte;

  TAdvancedInteger = record
    LowPart, HighPart: Integer;
  end;

const
  namepl = 'SEO Include 1.1';
  descpl = namepl + ' © Mikanoshi' + #13#10 + 'Îòîáðàæåíèå ßíäåêñ òÈÖ è Google PR äëÿ ñàéòîâ â ÷àòå';

function FirstDelimiter(s: RawByteString): Integer;
var
  spacepos, crpos, lfpos, tabpos: Integer;
begin
  spacepos := pos(' ', s);
  crpos := pos(#13, s);
  lfpos := pos(#10, s);
  tabpos := pos(#9, s);
  result := 0;

  if (spacepos > 0) then
    result := spacepos
  else if (crpos > 0) then
    result := crpos
  else if (lfpos > 0) then
    result := lfpos
  else if (tabpos > 0) then
    result := tabpos;
end;

function UTF8CharLength(const c: Byte): Integer;
begin
  if ((c and $80) = $00) then
    result := 1
  else if ((c and $E0) = $C0) then
    result := 2
  else if ((c and $F0) = $E0) then
    result := 3
  else if ((c and $F8) = $F0) then
    result := 4
  else
    result := -1;
end;

function UTF8IsTrailChar(const c: Byte): boolean;
begin
  result := ((c and $C0) = $80);
end;

function IsUTF8Memory(AMem: PBYTE; ASize: Int64): boolean;
var i: Int64;
  c: Integer;
begin
  result := TRUE;

  i := 0;
  while (i < ASize) do
  begin
    c := UTF8CharLength(AMem^);
    if ((c >= 1) and (c <= 4) and ((i + c - 1) < ASize)) then
    begin
      inc(i, c);
      inc(AMem);
      while (c > 1) do
      begin
        if (not UTF8IsTrailChar(AMem^)) then
        begin
          result := false;
          break;
        end
        else
        begin
          dec(c);
          inc(AMem);
        end;
      end;
    end
    else
    begin
      result := false;
    end;

    if (not result) then
      break;
  end;
end;

function ParseStats(messg: RawByteString): RawByteString;
var
  msgtmp, msgseo, url, tic, tic_text, pr: RawByteString;
begin
  msgtmp := messg;
  msgseo := messg;
  delimpos := 0;
  URLPosition := TFWURLPosition.Create;
  if (pos('www.', msgtmp) > 0) or (pos('http://', msgtmp) > 0) then
    try
      repeat
        if (pos('www.', msgtmp) > 0) and (pos('http://', msgtmp) > 0) then
        begin
          if (pos('www.', msgtmp) < pos('http://', msgtmp)) then
            msgtmp := copy(msgtmp, pos('www.', msgtmp), length(msgtmp))
          else
            msgtmp := copy(msgtmp, pos('http://', msgtmp), length(msgtmp));
        end
        else if pos('www.', msgtmp) > 0 then
          msgtmp := copy(msgtmp, pos('www.', msgtmp), length(msgtmp))
        else if (pos('http://', msgtmp) > 0) then
          msgtmp := copy(msgtmp, pos('http://', msgtmp), length(msgtmp));

        delimpos := FirstDelimiter(msgtmp);
        if delimpos = 0 then
          delimpos := length(msgtmp)
        else
          dec(delimpos);

        if pos('www.', msgtmp) = 1 then
        begin
          url := copy(msgtmp, pos('www.', msgtmp), delimpos);
          msgtmp := copy(msgtmp, pos('www.', msgtmp) + length(url), length(msgtmp));
        end
        else
        begin
          url := copy(msgtmp, pos('http://', msgtmp), delimpos);
          msgtmp := copy(msgtmp, pos('http://', msgtmp) + length(url), length(msgtmp));
        end;

        if (url = 'http://') or (url = 'www.') then
          continue
        else
        begin
          URLPosition := TFWURLPosition.Create;
          URLPosition.GetURLPosition(AnsiReplaceStr(url, 'http://', ''), [ucYandex, ucGoogle]);
          if URLPosition.YandexTIC = -1 then
            tic := '?'
          else
            tic := '*' + inttostr(URLPosition.YandexTIC) + '*';
          if URLPosition.GooglePR = -1 then
            pr := '?'
          else
            pr := '*' + inttostr(URLPosition.GooglePR) + '*';

          tic_text := ' [òÈÖ: ';
          if IsUTF8Memory(PByte(PAnsiChar(msgseo)), length(msgseo)) then
            tic_text := UTF8Encode(' [òÈÖ: ');

          msgseo := AnsiReplaceStr(msgseo, url, url + tic_text + tic + ' | PR: ' + pr + ']');
        end;
      until ((pos('www.', msgtmp) = 0) and (pos('http://', msgtmp) = 0)) or (url = '');
    finally
      URLPosition.Free;
    end;

  result := msgseo;
end;

procedure TPOSTThread.Execute;
begin
  MsgCheck := ParseStats(MsgToCheck);
  if (isMsgGot) then
    ressent := str2comm(char(PM_DATA) + _istring(MsgCheck))
  else
    ressent := str2comm(char(PM_DATA) + _istring(MsgToCheck) + _istring(MsgCheck));
  POST.Terminate;
end;

procedure OnButtonClick(iButton: Integer);
begin
  case iButton of
    0:
      begin
        ini := TIniFile.Create(RQ_GetUserPath + 'SEOInclude.ini');
        if State = TRUE then
        begin
          State := false;
          hico.Handle := LoadIcon(HInstance, 'SEO_2');
          ini.WriteString('Main', 'State', 'Off');
        end
        else
        begin
          State := TRUE;
          hico.Handle := LoadIcon(HInstance, 'SEO_1');
          ini.WriteString('Main', 'State', 'On');
        end;
        RQ_ChangeChatButton(ba, hico.Handle, namepl);
        ini.Free;
      end;
    1, 2:
      messagebox(0, PWideChar(descpl), 'About', 0);
  end;
end;

function pluginFun(data: pointer): pointer; stdcall;
begin
  result := NIL;
  if (data = NIL) or (_int_at(data) = 0) then
    Exit;
  case _byte_at(data, 4) of
    PM_EVENT:
      case _byte_at(data, 5) of
        PE_INITIALIZE:
          begin
            RQ__ParseInitString(data, callback, vApiVersion, andrqPath, userPath, currentUIN);

            hico := TIcon.Create;
            hico.Handle := LoadIcon(HInstance, 'SEO_2');
            if fileexists(RQ_GetUserPath + 'SEOInclude.ini') then
            begin
              ini := TIniFile.Create(RQ_GetUserPath + 'SEOInclude.ini');
              if ini.ReadString('Main', 'State', 'Off') = 'On' then
              begin
                hico.Handle := LoadIcon(HInstance, 'SEO_1');
                State := TRUE;
              end
              else
              begin
                hico.Handle := LoadIcon(HInstance, 'SEO_2');
                State := false;
              end;
              ini.Free;
            end;

            ba := RQ_CreateChatButton(@OnButtonClick, hico.Handle, namepl);
            result := str2comm(char(PM_DATA) + _istring(namepl) + _int(APIversion));
          end;

        PE_FINALIZE:
          begin
            if ba <> 0 then
              RQ_DeleteChatButton(ba);
            if hico <> nil then
              hico.Free;
          end;

        PE_MSG_SENT:
          if State = TRUE then
          begin
            RQ__ParseMsgSentString(data, uin, flags, msg);
            MsgToCheck := msg;
            POST := TPOSTThread.Create(TRUE);
            POST.isMsgGot := false;
            POST.Start;
            case WaitForSingleObject(POST.Handle, INFINITE) of
              WAIT_OBJECT_0:
                result := ressent;
            end;
            POST.Free;
          end;

        PE_MSG_GOT:
          if State = TRUE then
          begin
            RQ__ParseMsgGotString(data, uin, flags, When, msg);
            MsgToCheck := msg;
            POST := TPOSTThread.Create(TRUE);
            POST.isMsgGot := TRUE;
            POST.Start;
            case WaitForSingleObject(POST.Handle, INFINITE) of
              WAIT_OBJECT_0:
                result := ressent;
            end;
            POST.Free;
          end;

        PE_PREFERENCES:
          messagebox(0, PWideChar(descpl), 'About', 0);

      end; // case
  end; // case
end; // pluginFun

exports pluginFun;

end.