/
internal_backlinks.pas 
102 строки · 2.6 Кб
1
{ Модуль для создания списка обратных ссылок на страницу }
2
unit internal_backlinks;
3

4
{$mode ObjFPC}{$H+}
5

6
interface
7

8
uses
9

10
Classes, SysUtils, DB, BufDataset, Forms, Controls, Graphics, Dialogs,
11
 DBCtrls,   SQLite3Conn, SQLDB, process, StdCtrls, ExtCtrls, ComCtrls, Menus, DBGrids,
12
 db_helpers, types_for_app;
13

14
{ Выполняет запросы к сайту, чтобы получить список обратных ссылок }
15
function  getBacklinks(var konnect : TSQLite3Connection;
16
  var tranzact : TSQLTransaction;
17
  var sQ: TSQLQuery) : TStringToArrayOfStrings;
18

19
function makeBacklinkHtml(var map_of_backlinks : TStringToArrayOfStrings; page_id : String) : String;
20

21

22
implementation
23

24
function getBacklinks(var konnect: TSQLite3Connection;
25
  var tranzact: TSQLTransaction;
26
  var sQ: TSQLQuery): TStringToArrayOfStrings;
27
var
28
  R : TStringToArrayOfStrings;
29
  InitialArr : TMyArrayOfStrings;
30
  I   : Integer;
31
  Key :  String;
32
  Values : TMyArrayOfStrings;
33
  S : TStringList;
34
begin
35
     S := TStringList.Create;
36
     R:=TStringToArrayOfStrings.Create;
37
     Sq.SQL.Text:='SELECT id FROM content';
38
     Sq.Active:=True;
39
     sQ.First;
40
     while not sQ.EOF do
41
           begin
42
             SetLength(InitialArr, 0);
43
             R.AddOrSetData( sQ.FieldByName('id').AsString, InitialArr);
44
             sQ.Next;
45
           end;
46

47
    For I := 0 to R.Count - 1 do
48
    begin
49
        Key := R.Keys[I];
50
        Values := R.Data[I];
51
        Sq.Active:=False;
52
        sq.SQL.Text:='SELECT id FROM content WHERE content LIKE "%'+Key+'%" ';
53
        sq.Active:=True;
54
        sQ.First;
55
        S.Clear;
56
        while not sQ.EOF do
57
           begin
58
             SetLength(Values, Length(Values) + 1);
59
             Values[ Length(Values) - 1 ] := sQ.FieldByName('id').AsString;
60

61
              R.AddOrSetData(Key, Values);
62

63
             S.Add(  Values[ Length(Values) - 1 ] );
64
             sQ.Next;
65
             Application.ProcessMessages;
66
           end;
67

68
             // S.SaveToFile(sQ.FieldByName('id').AsString+'.log');
69

70
    end;
71
    sq.Active:=False;
72
    S.Free;
73
    Result := R;
74

75

76

77
end;
78

79
function makeBacklinkHtml(var map_of_backlinks : TStringToArrayOfStrings;
80
  page_id: String): String;
81
var
82

83
  S : String;
84
  Backlinks : TMyArrayOfStrings;
85
  I : Integer;
86
begin
87
   if map_of_backlinks.TryGetData(page_id, Backlinks) then
88
    begin
89
      s := '<ul>';
90
      for i := 0 to High(Backlinks) do begin
91
        // used [page_id] shortcode
92
         s := s + '<li>' + '[' + Backlinks[i] + ']' + '</li>';
93
         Application.ProcessMessages;
94
      end;
95
      s := s + '</ul>';
96
    end
97
    else
98
        s := 'no backlinks';
99
   Result := s;
100
end;
101

102
end.
103

104

Использование cookies

Мы используем файлы cookie в соответствии с Политикой конфиденциальности и Политикой использования cookies.

Нажимая кнопку «Принимаю», Вы даете АО «СберТех» согласие на обработку Ваших персональных данных в целях совершенствования нашего веб-сайта и Сервиса GitVerse, а также повышения удобства их использования.

Запретить использование cookies Вы можете самостоятельно в настройках Вашего браузера.