├── .gitattributes
├── .github
├── dependabot.yml
└── workflows
│ ├── make.pas
│ └── make.yml
├── .gitignore
├── .gitmodules
├── LICENSE
├── README.md
├── README.ru.md
└── src
├── Emoji
├── emojiutils.pas
└── tests
│ ├── testconsole.ico
│ ├── testconsole.lpi
│ ├── testconsole.lpr
│ ├── testemojies.pas
│ ├── testgui.ico
│ ├── testgui.lpi
│ └── testgui.lpr
├── NaiveBayesClassifier
├── spamfilter.pas
├── tests
│ ├── testconsole.lpi
│ ├── testconsole.lpr
│ ├── testfilter.pas
│ ├── testgui.ico
│ ├── testgui.lpi
│ ├── testgui.lpr
│ └── words.json
└── utils
│ ├── mainform.lfm
│ ├── mainform.pas
│ ├── nbc_gui.ico
│ ├── nbc_gui.lpi
│ ├── nbc_gui.lpr
│ └── words.json
├── actionadminhelper.pas
├── adminhelper_conf.pas
├── adminhelper_orm.pas
├── adminhelperd.lpi
├── adminhelperd.lpr
├── brokers.pas
├── db_schema.sql
├── languages
├── adminhelperd.en.po
├── adminhelperd.pot
└── adminhelperd.ru.po
├── spamfilter_implementer.pas
├── spamfilter_worker.pas
└── telegram_cmn.pas
/.gitattributes:
--------------------------------------------------------------------------------
1 | # Auto detect text files and perform LF normalization
2 | * text=auto
3 |
--------------------------------------------------------------------------------
/.github/dependabot.yml:
--------------------------------------------------------------------------------
1 | ---
2 | version: 2
3 | updates:
4 | - package-ecosystem: "github-actions"
5 | directory: "/"
6 | schedule:
7 | interval: "monthly"
8 |
--------------------------------------------------------------------------------
/.github/workflows/make.pas:
--------------------------------------------------------------------------------
1 | program Make;
2 | {$mode objfpc}{$H+}
3 |
4 | uses
5 | Classes,
6 | SysUtils,
7 | StrUtils,
8 | FileUtil,
9 | Zipper,
10 | fphttpclient,
11 | RegExpr,
12 | openssl,
13 | opensslsockets,
14 | Process;
15 |
16 | const
17 | Target: string = 'src';
18 | Dependencies: array of string = ();
19 |
20 | type
21 | Output = record
22 | Code: boolean;
23 | Output: ansistring;
24 | end;
25 |
26 | function CheckModules: Output;
27 | begin
28 | if FileExists('.gitmodules') then
29 | if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
30 | '--force', '--remote'], Result.Output) then
31 | Writeln(stderr, #27'[33m', Result.Output, #27'[0m');
32 | end;
33 |
34 | function AddPackage(Path: string): Output;
35 | begin
36 | with TRegExpr.Create do
37 | begin
38 | Expression :=
39 | {$IFDEF MSWINDOWS}
40 | '(cocoa|x11|_template)'
41 | {$ELSE}
42 | '(cocoa|gdi|_template)'
43 | {$ENDIF}
44 | ;
45 | if not Exec(Path) and RunCommand('lazbuild', ['--add-package-link', Path],
46 | Result.Output) then
47 | Writeln(stderr, #27'[33m', 'added ', Path, #27'[0m');
48 | Free;
49 | end;
50 | end;
51 |
52 | function BuildProject(Path: string): Output;
53 | var
54 | Line: string;
55 | begin
56 | Write(stderr, #27'[33m', 'build from ', Path, #27'[0m');
57 | try
58 | Result.Code := RunCommand('lazbuild', ['--build-all', '--recursive',
59 | '--no-write-project', Path], Result.Output);
60 | if Result.Code then
61 | for Line in SplitString(Result.Output, LineEnding) do
62 | begin
63 | if ContainsStr(Line, 'Linking') then
64 | begin
65 | Result.Output := SplitString(Line, ' ')[2];
66 | Writeln(stderr, #27'[32m', ' to ', Result.Output, #27'[0m');
67 | break;
68 | end;
69 | end
70 | else
71 | begin
72 | ExitCode += 1;
73 | for Line in SplitString(Result.Output, LineEnding) do
74 | with TRegExpr.Create do
75 | begin
76 | Expression := '(Fatal|Error):';
77 | if Exec(Line) then
78 | begin
79 | WriteLn(stderr);
80 | Writeln(stderr, #27'[31m', Line, #27'[0m');
81 | end;
82 | Free;
83 | end;
84 | end;
85 | except
86 | on E: Exception do
87 | WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message);
88 | end;
89 | end;
90 |
91 | function RunTest(Path: string): Output;
92 | var
93 | Temp: string;
94 | begin
95 | Result := BuildProject(Path);
96 | Temp:= Result.Output;
97 | if Result.Code then
98 | try
99 | if not RunCommand(Temp, ['--all', '--format=plain', '--progress'], Result.Output) then
100 | ExitCode += 1;
101 | WriteLn(stderr, Result.Output);
102 | except
103 | on E: Exception do
104 | WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message);
105 | end;
106 | end;
107 |
108 | function DownloadFile(Url: string): string;
109 | var
110 | TempFile: TStream;
111 | begin
112 | Result := GetTempFileName;
113 | with TFPHttpClient.Create(nil) do
114 | begin
115 | try
116 | AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
117 | AllowRedirect := True;
118 | TempFile := TFileStream.Create(Result, fmCreate or fmOpenWrite);
119 | Get(Url, TempFile);
120 | TempFile.Free;
121 | WriteLn(stderr, 'Download from ', Url, ' to ', Result);
122 | finally
123 | Free;
124 | end;
125 | end;
126 | end;
127 |
128 | function AddOPM(Each: string): string;
129 | begin
130 | Result :=
131 | {$IFDEF MSWINDOWS}
132 | GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
133 | {$ELSE}
134 | GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
135 | {$ENDIF}
136 | + Each;
137 | if not DirectoryExists(Result) then
138 | begin
139 | CreateDir(Result);
140 | with TUnZipper.Create do
141 | begin
142 | try
143 | FileName := DownloadFile('https://packages.lazarus-ide.org/' + Each + '.zip');
144 | OutputPath := Result;
145 | Examine;
146 | UnZipAllFiles;
147 | WriteLn(stderr, 'Unzip from ', FileName, ' to ', Result);
148 | DeleteFile(FileName);
149 | finally
150 | Free;
151 | end;
152 | end;
153 | end;
154 | end;
155 |
156 | function Main: Output;
157 | var
158 | Each, Item: string;
159 | List: TStringList;
160 | begin
161 | CheckModules;
162 | InitSSLInterface;
163 | for Each in Dependencies do
164 | begin
165 | List := FindAllFiles(AddOPM(Each), '*.lpk', True);
166 | try
167 | for Item in List do
168 | AddPackage(Item);
169 | finally
170 | List.Free;
171 | end;
172 | end;
173 | List := FindAllFiles('.', '*.lpk', True);
174 | try
175 | for Each in List do
176 | AddPackage(Each);
177 | finally
178 | List.Free;
179 | end;
180 | List := FindAllFiles(Target, '*.lpi', True);
181 | try
182 | for Each in List do
183 | if ContainsStr(ReadFileToString(ReplaceStr(Each, '.lpi', '.lpr')),
184 | 'consoletestrunner') then
185 | RunTest(Each)
186 | else
187 | BuildProject(Each);
188 | finally
189 | List.Free;
190 | end;
191 | WriteLn(stderr);
192 | if ExitCode <> 0 then
193 | WriteLn(stderr, #27'[31m', 'Errors: ', ExitCode, #27'[0m')
194 | else
195 | WriteLn(stderr, #27'[32m', 'Errors: ', ExitCode, #27'[0m');
196 | end;
197 |
198 | begin
199 | Main;
200 | end.
201 |
--------------------------------------------------------------------------------
/.github/workflows/make.yml:
--------------------------------------------------------------------------------
1 | ---
2 | name: Make
3 |
4 | on:
5 | schedule:
6 | - cron: '0 0 1 * *'
7 | push:
8 | branches:
9 | - "**"
10 | pull_request:
11 | branches:
12 | - master
13 | - main
14 |
15 | concurrency:
16 | group: ${{ github.workflow }}-${{ github.ref }}
17 | cancel-in-progress: true
18 |
19 | jobs:
20 | build:
21 | runs-on: ${{ matrix.os }}
22 | timeout-minutes: 120
23 | strategy:
24 | matrix:
25 | os:
26 | - ubuntu-latest
27 | steps:
28 | - name: Checkout
29 | uses: actions/checkout@v4
30 | with:
31 | submodules: true
32 |
33 | - name: Build
34 | shell: bash
35 | run: |
36 | sudo bash -c 'apt-get update; apt-get install -y lazarus' >/dev/null
37 | instantfpc -Fu/usr/lib/lazarus/*/components/lazutils .github/workflows/make.pas
38 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | logs/
2 | iamprd
3 | iamprd.new
4 | libsagui.*
5 | console
6 | ppas.bat
7 | /src/NaiveBayesClassifier/tests/testconsole
8 |
9 | *.log
10 | *.ini
11 | ~*
12 | *.zip
13 | *.dat
14 | *.csv
15 | # Lazarus compiler-generated binaries (safe to delete)
16 | *.exe
17 | *.dll
18 | *.so
19 | *.dylib
20 | *.res
21 | *.compiled
22 | *.dbg
23 | *.ppu
24 | *.o
25 | *.or
26 | *.a
27 | *.7z
28 | *.mo
29 | *.lst
30 |
31 | # Lazarus autogenerated files (duplicated info)
32 | *.rst
33 | *.rsj
34 | *.lrt
35 |
36 | # Lazarus local files (user-specific info)
37 | *.lps
38 |
39 | # Lazarus backups and unit output folders.
40 | # These can be changed by user in Lazarus/project options.
41 | backup/
42 | *.bak
43 | lib/
44 | use/*/
45 |
46 | # Application bundle for Mac OS
47 | *.app/
48 | *.conf
49 | *.new
50 |
51 | tests/users.sqlite3
52 |
--------------------------------------------------------------------------------
/.gitmodules:
--------------------------------------------------------------------------------
1 | [submodule "use/fp-telegram"]
2 | path = use/fp-telegram
3 | url = https://github.com/Al-Muhandis/fp-telegram/
4 | [submodule "use/brook-telegram"]
5 | path = use/brook-telegram
6 | url = https://github.com/Al-Muhandis/brook-telegram.git
7 | [submodule "use/brookframework"]
8 | path = use/brookframework
9 | url = https://github.com/risoflora/brookframework.git
10 | [submodule "use/brookfreepascal"]
11 | path = use/brookfreepascal
12 | url = https://github.com/risoflora/brookfreepascal.git
13 | [submodule "use/taskworker"]
14 | path = use/taskworker
15 | url = https://github.com/Al-Muhandis/taskworker.git
16 | [submodule "use/dopf"]
17 | path = use/dopf
18 | url = https://github.com/pascal-libs/dopf.git
19 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | MIT License
2 |
3 | Copyright (c) 2024 Renat Suleymanov
4 |
5 | Permission is hereby granted, free of charge, to any person obtaining a copy
6 | of this software and associated documentation files (the "Software"), to deal
7 | in the Software without restriction, including without limitation the rights
8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9 | copies of the Software, and to permit persons to whom the Software is
10 | furnished to do so, subject to the following conditions:
11 |
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 |
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21 | SOFTWARE.
22 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 |
2 | # Description of the bot's work
3 | The bot helps quickly and silently ban spammers.
4 |
5 | Group members notify administrators of spam messages themselves using the `/spam` command.
6 | The command should be sent in response to a spam message.
7 |
8 | All administrators receive a copy of the inspected message with the ability to check whether the member has correctly pointed to the spam message.
9 | If it is indeed a spam message, the member's rating is increased.
10 | The bot can send a notification that the admins need to decide if it is a spammer, or notify the admins that the spammer is banned with the option to rollback, or even silently ban,
11 | if the likelihood of a ban is high enough based on some factors. The bot can also preventively ban spammers.
12 | If the inspected message is incorrectly identified as a spam, the member's rating is downgraded.
13 |
14 | In order for the bot to receive a list of administrators in a group or in case of deleting or adding a new one, it is necessary to send the `/update` command from any of the current administrators.
15 | Due to the fact that these commands are instantly deleted by the bot itself in the group, reports and updates occur unnoticed by users
16 |
17 | # How to Set Up the bot in Your Group
18 | How to connect the bot @Moderator_Helper_Robot (or your own instance) to your group:
19 |
20 | 1. Add the bot to your group.
21 | 2. Grant it admin privileges (with ban and add member permissions).
22 | 3. Run the command /update in the group (or /update@Moderator_Helper_Robot if there are other bots with similar commands in the group).
23 | 4. The bot will start working. All admins must open a chat with the bot so it can send them notifications.
24 |
25 | # Spam classifier
26 | A spam classifier has been added to the bot (you can turn it off in the service config),
27 | which can be trained and used to automatically notify administrators (and in the case of high spam probability can be automatically to ban) about suspicious messages.
28 | The algorithm of the Naive Bayesian Classifier is used.
29 | In addition, messages in which the number of emojis exceeds the specified number can also be automatically marked as spam by this filter
30 |
31 | # Architecture
32 | The software implements the telegram bot as a web server in webhook mode
33 |
34 | # Dependencies
35 | - fp-telegram (Telegram bots API wrapper) https://github.com/Al-Muhandis/fp-telegram
36 | - brook-telegram (Plugin for BrookFoFreePascal) https://github.com/Al-Muhandis/brook-telegram/
37 | - BrookForFreePascal & BrookFramework (HTTP server) https://github.com/risoflora/brookfreepascal & https://github.com/risoflora/brookframework
38 | - dOPF (ORM) https://github.com/pascal-libs/dopf
39 | Notes: BrookFreePascal can be used without BrookFramework in broker mode
--------------------------------------------------------------------------------
/README.ru.md:
--------------------------------------------------------------------------------
1 |
2 | # Описание работы телеграм бота
3 | Бот быстро и тихо позволяет банить спамеров.
4 |
5 | Бот помогает модерировать сообщения и быстро банить спамеров в группах.
6 | Участники группы сами уведомляют администраторов о спам сообщении с помощью команды `/spam`.
7 | Команду следует отправить в ответ на спам сообщение.
8 |
9 | Всем администраторам приходит копия сообщения с возможностью указания правильно ли участник указал на спам-сообщение.
10 | Если это действительно спам-сообщение, то рейтинг участника повышается.
11 | Бот может отправить уведомление о том, что админам нужно принять решение спамер ли это или уведомить админов, что спамер забанен с возможность отката или даже молча забанить,
12 | если вероятность бана достаточно высока на основе некоторых факторов. Также бот может превентивно банить спамеров.
13 | В случае неверного определения спам сообщения рейтинг участника понижается.
14 |
15 | Для того, чтобы бот получил список администраторов в группе или в случае удаления или добавления нового, следует любому из действующих администраторов отправить команду `/update`
16 | Благодаря тому, что эти команды мгновенно удаляются самим ботом в группе - репорты и обновления происходит незаметно для пользователей
17 |
18 | # Как подключить бота @Moderator_Helper_Robot к группе
19 | (или ваш собственный экземпляр бота)
20 |
21 | 1. Добавьте бота в вашу группу.
22 | 2. Дайте права администратора (с возможностью бана и добавления участников).
23 | 3. Выполните команду /update (или /update@Moderator_Helper_Robot, если в группе есть другие боты с похожими командами).
24 | 4. Готово! Бот начнёт работу. Администраторам нужно открыть чат с ботом, чтобы получать уведомления.
25 |
26 | # Архитектура
27 | Бот реализует свою работу на веб-сервер в режиме вебхука
28 |
29 | # Автоматический классификатор спама
30 | В бот добавлен классификатор спама (в настройках можно выключить),
31 | который может обучаться и использоваться для автоматических уведомлений администраторов (и при высокой вероятности автоматического бана спамеров) о подозрительных сообщениях.
32 | Используется алгоритм Наивного Байесовского классификатора.
33 | Помимо этого, сообщения, в которых количество эмодзи превышает заданное количество, могут также автоматически помечаться как спам этим фильтром
34 |
35 | # Зависимости
36 | - fp-telegram (Telegram bots API wrapper) https://github.com/Al-Muhandis/fp-telegram
37 | - brook-telegram (Телеграм плагин для BrookFoFreePascal) https://github.com/Al-Muhandis/brook-telegram/
38 | - BrookForFreePascal & BrookFramework (HTTP сервер) https://github.com/risoflora/brookfreepascal & https://github.com/risoflora/brookframework
39 | - dOPF (ORM) https://github.com/pascal-libs/dopf
40 | Заметки: BrookFreePascal может использоваться и без BrookFramework в режиме брокера
41 |
--------------------------------------------------------------------------------
/src/Emoji/emojiutils.pas:
--------------------------------------------------------------------------------
1 | unit emojiutils;
2 |
3 | {$mode ObjFPC}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes
9 | ;
10 |
11 | function IsEmoji(const aUTF8Char: String): Boolean;
12 | function CountEmojis(const aUTF8Str: string): Integer;
13 |
14 | implementation
15 |
16 | uses
17 | SysUtils
18 | ;
19 |
20 | function UTF8ToBytes(const s: String): TBytes;
21 | begin
22 | Assert(StringElementSize(s)=1);
23 | Initialize(Result);
24 | SetLength(Result, Length(s)+1);
25 | if Length(Result)>0 then
26 | Move(s[1], Result[0], Length(s));
27 | Result[high(Result)] := 0;
28 | end;
29 |
30 | function IsEmoji(const Bytes: TBytes; Index: Integer): Boolean;
31 | var
32 | CodePoint: Integer;
33 | begin
34 | Result := False;
35 |
36 | // Check the length of sequence
37 | if (Bytes[Index] and $F0) = $F0 then // 4-byte sequence
38 | begin
39 | if Index + 3 < Length(Bytes) then
40 | begin
41 | CodePoint := ((Bytes[Index] and $07) shl 18) or
42 | ((Bytes[Index + 1] and $3F) shl 12) or
43 | ((Bytes[Index + 2] and $3F) shl 6) or
44 | (Bytes[Index + 3] and $3F);
45 | // Check ranges of emojies
46 | Result := (CodePoint >= $1F600) and (CodePoint <= $1F64F) or // Emoticons
47 | (CodePoint >= $1F300) and (CodePoint <= $1F5FF) or // Misc Symbols and Pictographs
48 | (CodePoint >= $1F680) and (CodePoint <= $1F6FF) or // Transport and Map Symbols
49 | (CodePoint >= $1F700) and (CodePoint <= $1F77F) or // Alchemical Symbols
50 | (CodePoint >= $2600) and (CodePoint <= $26FF); // Miscellaneous Symbols
51 | end;
52 | end
53 | else if (Bytes[Index] and $E0) = $E0 then // 3-byte sequence
54 | begin
55 | if Index + 2 < Length(Bytes) then
56 | begin
57 | CodePoint := ((Bytes[Index] and $0F) shl 12) or
58 | ((Bytes[Index + 1] and $3F) shl 6) or
59 | (Bytes[Index + 2] and $3F);
60 | // Check ranges of emojies
61 | Result := (CodePoint >= $1F600) and (CodePoint <= $1F64F) or // Emoticons
62 | (CodePoint >= $1F300) and (CodePoint <= $1F5FF) or // Misc Symbols and Pictographs
63 | (CodePoint >= $1F680) and (CodePoint <= $1F6FF) or // Transport and Map Symbols
64 | (CodePoint >= $1F700) and (CodePoint <= $1F77F) or // Alchemical Symbols
65 | (CodePoint >= $2600) and (CodePoint <= $26FF); // Miscellaneous Symbols
66 | end;
67 | end
68 | else if (Bytes[Index] and $C0) = $C0 then // 2-byte sequence
69 | begin
70 | if Index + 1 < Length(Bytes) then
71 | begin
72 | CodePoint := ((Bytes[Index] and $1F) shl 6) or
73 | (Bytes[Index + 1] and $3F);
74 | // Check ranges of emojies, if it needs
75 | // But most emojis starting with a 2 byte sequence are not used.
76 | end;
77 | end;
78 | end;
79 |
80 | function IsEmoji(const aUTF8Char: String): Boolean;
81 | begin
82 | Result:=IsEmoji(UTF8ToBytes(aUTF8Char), 0);
83 | end;
84 |
85 | function CountEmojis(const aUTF8Str: string): Integer;
86 | var
87 | Bytes: TBytes;
88 | I: Integer;
89 | begin
90 | Result := 0;
91 | // Convert the string to a byte array (UTF-8)
92 | Bytes := UTF8ToBytes(aUTF8Str);
93 |
94 | // Iterate through the byte array
95 | I := 0;
96 | while I < Length(Bytes) do
97 | begin
98 | if IsEmoji(Bytes, I) then
99 | begin
100 | Inc(Result);
101 | // Move the index forward based on the length of the emoji
102 | if (Bytes[I] and $F0) = $F0 then
103 | Inc(I, 4) // 4-byte emoji
104 | else if (Bytes[I] and $E0) = $E0 then
105 | Inc(I, 3) // 3-byte emoji
106 | else if (Bytes[I] and $C0) = $C0 then
107 | Inc(I, 2) // 2-byte emoji
108 | else
109 | Inc(I); // Regular character (1 byte)
110 | end
111 | else
112 | Inc(I); // Regular character (1 byte)
113 | end;
114 | end;
115 |
116 | end.
117 |
118 |
--------------------------------------------------------------------------------
/src/Emoji/tests/testconsole.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/Al-Muhandis/AdminHelper/12b1507c52f960dc87073efff1841ff772e994a4/src/Emoji/tests/testconsole.ico
--------------------------------------------------------------------------------
/src/Emoji/tests/testconsole.lpi:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 | -
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 | -
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
80 |
81 |
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 | -
92 |
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 |
114 |
115 |
116 |
117 |
118 |
119 |
120 |
121 |
122 |
123 |
124 | -
125 |
126 |
127 | -
128 |
129 |
130 | -
131 |
132 |
133 |
134 |
135 |
136 |
--------------------------------------------------------------------------------
/src/Emoji/tests/testconsole.lpr:
--------------------------------------------------------------------------------
1 | program testconsole;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | Classes, testemojies, consoletestrunner
7 | ;
8 |
9 | type
10 |
11 | { TMyTestRunner }
12 |
13 | TMyTestRunner = class(TTestRunner)
14 | protected
15 | // override the protected methods of TTestRunner to customize its behavior
16 | end;
17 |
18 | var
19 | Application: TMyTestRunner;
20 |
21 | begin
22 | Application := TMyTestRunner.Create(nil);
23 | Application.Initialize;
24 | Application.Title := 'FPCUnit Console test runner';
25 | Application.Run;
26 | Application.Free;
27 | end.
28 |
--------------------------------------------------------------------------------
/src/Emoji/tests/testemojies.pas:
--------------------------------------------------------------------------------
1 | unit testemojies;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils, fpcunit, testregistry
9 | ;
10 |
11 | type
12 |
13 | { TTestEmojies }
14 |
15 | TTestEmojies= class(TTestCase)
16 | published
17 | procedure IsEmoji;
18 | procedure CountEmojies;
19 | end;
20 |
21 | implementation
22 |
23 | uses
24 | emojiutils
25 | ;
26 |
27 | const
28 | _emjTest1='🗿';
29 | _sTest2='a';
30 | _sTest3='Щ';
31 | _sTest4='island';
32 |
33 | procedure TTestEmojies.IsEmoji;
34 | begin
35 | if not emojiutils.IsEmoji(_emjTest1) then
36 | Fail(_emjTest1+' is emoji!');
37 | if emojiutils.IsEmoji(_sTest2) then
38 | Fail('"%s" is not emoji!', [_sTest2]);
39 | if emojiutils.IsEmoji(_sTest3) then
40 | Fail('"%s" is not emoji!', [_sTest3]);
41 | if emojiutils.IsEmoji(_sTest4) then
42 | Fail('"%s" is not emoji!', [_sTest4]);
43 | end;
44 |
45 | procedure TTestEmojies.CountEmojies;
46 | begin
47 | if CountEmojis('Здравствуйте, нужен человек')>0 then
48 | Fail('There are not emojies in the string!');
49 | if CountEmojis('🗿')<>1 then
50 | Fail('There is one emoji in the string!');
51 | if CountEmojis('🔤🔤🔤🔤🔤 🔤🔤🔤🔤❄️ 💚💚💚💚💚💚💚 '+LineEnding+
52 | '️▪️▪️▪️▪️▪️ ▪️▪️▪️▪️▪️▪️ ❄️👾👾👾👾👾👾👾👾👾')<10 then
53 | Fail('There are more than 10 emojies in the string!');
54 | end;
55 |
56 |
57 |
58 | initialization
59 |
60 | RegisterTest(TTestEmojies);
61 | end.
62 |
63 |
--------------------------------------------------------------------------------
/src/Emoji/tests/testgui.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/Al-Muhandis/AdminHelper/12b1507c52f960dc87073efff1841ff772e994a4/src/Emoji/tests/testgui.ico
--------------------------------------------------------------------------------
/src/Emoji/tests/testgui.lpi:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 | -
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 | -
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
80 |
81 |
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 |
97 | -
98 |
99 |
100 | -
101 |
102 |
103 | -
104 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 |
114 |
115 |
116 |
117 |
118 |
119 |
120 |
121 |
122 |
123 |
124 |
125 |
126 |
127 |
128 |
129 |
130 |
131 |
132 |
133 |
134 |
135 |
136 |
137 |
138 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 | -
147 |
148 |
149 | -
150 |
151 |
152 | -
153 |
154 |
155 |
156 |
157 |
158 |
--------------------------------------------------------------------------------
/src/Emoji/tests/testgui.lpr:
--------------------------------------------------------------------------------
1 | program testgui;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | Interfaces, Forms, GuiTestRunner, testemojies
7 | ;
8 |
9 | {$R *.res}
10 |
11 | begin
12 | Application.Initialize;
13 | Application.CreateForm(TGuiTestRunner, TestRunner);
14 | Application.Run;
15 | end.
16 |
17 |
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/spamfilter.pas:
--------------------------------------------------------------------------------
1 | unit spamfilter;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils, fgl, jsonparser
9 | ;
10 |
11 | type
12 |
13 | { TCountRec }
14 |
15 | TCountRec = record
16 | Spam: Integer;
17 | Ham: Integer;
18 | end;
19 |
20 | TWordPairs = specialize TFPGMap;
21 |
22 | { TSpamFilter }
23 |
24 | TSpamFilter = class
25 | private
26 | FInitialHamMessage: String;
27 | FInitialSpamMessage: String;
28 | FWords: TWordPairs;
29 | FSpamCount: Integer;
30 | FHamCount: Integer;
31 | FTotalSpamWords: Integer;
32 | FTotalHamWords: Integer;
33 | FStorageDir: String;
34 | procedure ExtractWords(aMessage: String; aWords: TStrings);
35 | protected
36 | property Words: TWordPairs read FWords;
37 | property SpamCount: Integer read FSpamCount;
38 | property HamCount: Integer read FHamCount;
39 | property TotalSpamWords: Integer read FTotalSpamWords;
40 | property TotalHamWords: Integer read FTotalHamWords;
41 | public
42 | constructor Create;
43 | destructor Destroy; override;
44 | procedure Train(aMessage: string; IsSpam: Boolean);
45 | function Classify(const aMessage: string; out aHamProbability, aSpamProbability: Double): Boolean;
46 | function Classify(const aMessage: string): Boolean;
47 | function Load: Boolean;
48 | function LoadJSON(aIsRebase: Boolean = False): Boolean;
49 | procedure Rebase;
50 | procedure Save;
51 | procedure SaveJSON;
52 | property StorageDir: String read FStorageDir write FStorageDir;
53 | property InitialSpamMessage: String read FInitialSpamMessage write FInitialSpamMessage;
54 | property InitialHamMessage: String read FInitialHamMessage write FInitialHamMessage;
55 | end;
56 |
57 | implementation
58 |
59 | uses
60 | fpjson, LConvEncoding, StrUtils
61 | ;
62 |
63 | var
64 | _50Probability: Double;
65 |
66 | const
67 | _Separators=[' ', '.', ',', '!', '?', ';', ':', '(', ')', '-'];
68 | _dSpmDcs='SpamDocs';
69 | _dHmDcs='HamDocs';
70 | _dWrds='words';
71 | _dWrd='word';
72 | _dSpm='spam';
73 | _dHm='ham';
74 |
75 | procedure TSpamFilter.ExtractWords(aMessage: String; aWords: TStrings);
76 | begin
77 | aMessage:=aMessage.Replace('"', ' ');
78 | aMessage:=aMessage.Replace('''', ' ');
79 | ExtractStrings(_Separators, [], PChar(aMessage), aWords);
80 | end;
81 |
82 | constructor TSpamFilter.Create;
83 | begin
84 | FWords := TWordPairs.Create;
85 | FWords.Sorted:=True;
86 | FSpamCount := 0;
87 | FHamCount := 0;
88 | end;
89 |
90 | destructor TSpamFilter.Destroy;
91 | begin
92 | FWords.Free;
93 | inherited Destroy;
94 | end;
95 |
96 | procedure TSpamFilter.Train(aMessage: string; IsSpam: Boolean);
97 | var
98 | aWords: TStringList;
99 | aWord, w: string;
100 | i: Integer;
101 | aWordRec: TCountRec;
102 | begin
103 | aWords := TStringList.Create;
104 | try
105 | ExtractWords(aMessage, aWords);
106 | if IsSpam then
107 | Inc(FSpamCount)
108 | else
109 | Inc(FHamCount);
110 | for w in aWords do
111 | begin
112 | aWord := AnsiLowerCase(w);
113 |
114 | if FWords.Find(aWord, i) then
115 | begin
116 | aWordRec:=FWords.Data[i];
117 | if IsSpam then
118 | aWordRec.Spam := aWordRec.Spam + 1
119 | else
120 | aWordRec.Ham := aWordRec.Ham + 1;
121 | FWords.Data[i]:=aWordRec;
122 | end
123 | else begin
124 | if IsSpam then
125 | begin
126 | aWordRec.Spam := 1;
127 | aWordRec.Ham := 0;
128 | end
129 | else begin
130 | aWordRec.Spam := 0;
131 | aWordRec.Ham := 1;
132 | end;
133 | FWords.Add(aWord, aWordRec);
134 | end;
135 | if IsSpam then
136 | Inc(FTotalSpamWords)
137 | else
138 | Inc(FTotalHamWords)
139 | end;
140 | finally
141 | aWords.Free;
142 | end;
143 | end;
144 |
145 | function TSpamFilter.Classify(const aMessage: string; out aHamProbability, aSpamProbability: Double): Boolean;
146 | var
147 | aWords: TStringList;
148 | aWord, w: string;
149 | i: Integer;
150 | begin
151 | if (FSpamCount=0) or (FHamCount=0) then
152 | begin
153 | aHamProbability:=_50Probability;
154 | aSpamProbability:=_50Probability;
155 | Exit(False);
156 | end;
157 | aWords := TStringList.Create;
158 | try
159 | ExtractWords(aMessage, aWords);
160 |
161 | aSpamProbability := Ln(FSpamCount / (FSpamCount + FHamCount));
162 | aHamProbability := Ln(FHamCount / (FSpamCount + FHamCount));
163 |
164 | for w in aWords do
165 | begin
166 | aWord := AnsiLowerCase(w);
167 | if FWords.Find(aWord, i) then
168 | begin
169 | aSpamProbability += Ln((FWords.Data[i].Spam+1) / (FWords.Count+FTotalSpamWords));
170 | aHamProbability += Ln((FWords.Data[i].Ham+1) / (FWords.Count+FTotalHamWords));
171 | end
172 | else begin
173 | aSpamProbability += Ln(1 / (FWords.Count+FTotalSpamWords));
174 | aHamProbability += Ln(1 / (FWords.Count+FTotalHamWords));
175 | end;
176 | end;
177 |
178 | Result := aSpamProbability > aHamProbability;
179 |
180 | finally
181 | aWords.Free;
182 | end;
183 | end;
184 |
185 | function TSpamFilter.Classify(const aMessage: string): Boolean;
186 | var
187 | aHamProbability, aSpamProbability: Double;
188 | begin
189 | Result:=Classify(aMessage, aHamProbability, aSpamProbability);
190 | end;
191 |
192 | function TSpamFilter.Load: Boolean;
193 | begin
194 | Result:=LoadJSON;
195 | end;
196 |
197 | function TSpamFilter.LoadJSON(aIsRebase: Boolean): Boolean;
198 | var
199 | aFile: TStringList;
200 | aJSON: TJSONObject;
201 | w: TJSONEnum;
202 | aCountRec: TCountRec;
203 | aWord: String;
204 |
205 | procedure ExtractSubwords(const aSubWords: String);
206 | var
207 | aWords: TStrings;
208 | i: Integer;
209 | s: String;
210 | begin
211 | aWords:=TStringList.Create;
212 | try
213 | ExtractWords(aSubWords, aWords);
214 | for s in aWords do
215 | if FWords.Find(s, i) then
216 | begin
217 | aCountRec.Spam+=FWords.Data[i].Spam;
218 | aCountRec.Ham+=FWords.Data[i].Ham;
219 | end
220 | else
221 | FWords.Add(s, aCountRec);
222 | finally
223 | aWords.Free;
224 | end;
225 | end;
226 |
227 | begin
228 | FWords.Clear;
229 | if not FileExists(FStorageDir+'words.json') then
230 | begin
231 | Train(FInitialSpamMessage, True);
232 | Train(FInitialHamMessage, False);
233 | Exit(False);
234 | end;
235 | aFile:=TStringList.Create;
236 | try
237 | aFile.LoadFromFile(FStorageDir+'words.json');
238 | aJSON:=GetJSON(aFile.Text) as TJSONObject;
239 | try
240 | FSpamCount:=aJSON.Integers[_dSpmDcs];
241 | FHamCount:=aJSON.Integers[_dHmDcs];
242 | for w in aJSON.Arrays[_dWrds] do
243 | with w.Value as TJSONObject do
244 | begin
245 | aCountRec.Spam:=Integers[_dSpm];
246 | aCountRec.Ham:=Integers[_dHm];
247 | aWord:=UTF8Encode(UTF8Decode(Strings[_dWrd]));
248 | if aIsRebase then
249 | ExtractSubwords(aWord)
250 | else
251 | FWords.Add(aWord, aCountRec);
252 | end;
253 | finally
254 | aJSON.Free;
255 | end;
256 | finally
257 | aFile.Free;
258 | end;
259 | end;
260 |
261 | procedure TSpamFilter.Rebase;
262 | begin
263 | LoadJSON(True);
264 | Save;
265 | end;
266 |
267 | procedure TSpamFilter.Save;
268 | begin
269 | SaveJSON;
270 | end;
271 |
272 | procedure TSpamFilter.SaveJSON;
273 | var
274 | aJSON, aWord: TJSONObject;
275 | aFile: TStringList;
276 | i: Integer;
277 | aJSONWords: TJSONArray;
278 | begin
279 | aJSON:=TJSONObject.Create;
280 | try
281 | aJSON.Integers[_dSpmDcs]:=FSpamCount;
282 | aJSON.Integers[_dHmDcs]:=FHamCount;
283 | aJSON.Arrays[_dWrds]:=TJSONArray.Create;
284 | aJSONWords:=aJSON.Arrays[_dWrds];
285 | for i:=0 to FWords.Count-1 do
286 | begin
287 | aWord:=TJSONObject.Create;
288 | aWord.Strings[_dWrd]:=FWords.Keys[i];
289 | aWord.Integers[_dSpm]:=FWords.Data[i].Spam;
290 | aWord.Integers[_dHm]:=FWords.Data[i].Ham;
291 | aJSONWords.Add(aWord);
292 | end;
293 | aFile:=TStringList.Create;
294 | try
295 | aFile.Text:=aJSON.FormatJSON();
296 | aFile.SaveToFile(FStorageDir+'words.json');
297 | finally
298 | aFile.Free;
299 | end;
300 | finally
301 | aJSON.Free;
302 | end;
303 | end;
304 |
305 | initialization
306 | _50Probability:=Ln(0.5); // Logarithm of 50 percent probability
307 |
308 | end.
309 |
310 |
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/tests/testconsole.lpi:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 | -
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 | -
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
80 |
81 | -
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 |
114 |
115 |
116 |
117 |
118 |
119 | -
120 |
121 |
122 | -
123 |
124 |
125 |
126 |
127 |
128 |
129 |
130 |
131 |
132 |
133 |
134 |
135 |
136 |
137 |
138 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
150 |
151 | -
152 |
153 |
154 | -
155 |
156 |
157 | -
158 |
159 |
160 |
161 |
162 |
163 |
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/tests/testconsole.lpr:
--------------------------------------------------------------------------------
1 | program testconsole;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | Classes, consoletestrunner, testfilter;
7 |
8 | type
9 |
10 | { TMyTestRunner }
11 |
12 | TMyTestRunner = class(TTestRunner)
13 | protected
14 | // override the protected methods of TTestRunner to customize its behavior
15 | end;
16 |
17 | var
18 | Application: TMyTestRunner;
19 |
20 | begin
21 | Application := TMyTestRunner.Create(nil);
22 | Application.Initialize;
23 | Application.Title := 'FPCUnit Console test runner';
24 | Application.Run;
25 | Application.Free;
26 | end.
27 |
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/tests/testfilter.pas:
--------------------------------------------------------------------------------
1 | unit testfilter;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils, fpcunit, testregistry, spamfilter
9 | ;
10 |
11 | type
12 |
13 | { TTestFilter }
14 |
15 | TTestFilter= class(TTestCase)
16 | private
17 | FSpamFilter: TSpamFilter;
18 | protected
19 | procedure SetUp; override;
20 | procedure TearDown; override;
21 | published
22 | procedure TrainNClassify;
23 | procedure Save;
24 | procedure Load;
25 | procedure Upgrade;
26 | end;
27 |
28 | implementation
29 |
30 | procedure TTestFilter.TrainNClassify;
31 | begin
32 | FSpamFilter.Train('Congratulations! You have won a free loan!', True);
33 | FSpamFilter.Train('How do I learn to program in Lazarus?', False);
34 |
35 | if not FSpamFilter.Classify('Win a new phone now!') then
36 | Fail('Wrong classify. Must be a spam');
37 |
38 | if FSpamFilter.Classify('I wrote Hello world on Lazarus') then
39 | Fail('Wrong classify. Must be not a spam');
40 | end;
41 |
42 | procedure TTestFilter.Save;
43 | begin
44 | TrainNClassify;
45 | FSpamFilter.Save;
46 | end;
47 |
48 | procedure TTestFilter.Load;
49 | begin
50 | Save;
51 | FSpamFilter.Load;
52 | if not FSpamFilter.Classify('You have a free phone') then
53 | Fail('Wrong classify. Must be a spam');
54 |
55 | if FSpamFilter.Classify('I learn') then
56 | Fail('Wrong classify. Must be not a spam');
57 | end;
58 |
59 | procedure TTestFilter.Upgrade;
60 | begin
61 | Save;
62 | FSpamFilter.Rebase;
63 | end;
64 |
65 | procedure TTestFilter.SetUp;
66 | begin
67 | FSpamFilter:=TSpamFilter.Create;
68 | end;
69 |
70 | procedure TTestFilter.TearDown;
71 | begin
72 | FSpamFilter.Free;
73 | end;
74 |
75 | initialization
76 |
77 | RegisterTest(TTestFilter);
78 | end.
79 |
80 |
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/tests/testgui.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/Al-Muhandis/AdminHelper/12b1507c52f960dc87073efff1841ff772e994a4/src/NaiveBayesClassifier/tests/testgui.ico
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/tests/testgui.lpi:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 | -
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 | -
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
80 |
81 |
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 |
107 | -
108 |
109 |
110 | -
111 |
112 |
113 | -
114 |
115 |
116 |
117 |
118 |
119 |
120 |
121 |
122 |
123 |
124 |
125 |
126 |
127 |
128 |
129 |
130 |
131 |
132 |
133 |
134 |
135 |
136 |
137 |
138 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
150 |
151 |
152 |
153 |
154 |
155 |
156 |
157 |
158 |
159 |
160 |
161 | -
162 |
163 |
164 | -
165 |
166 |
167 | -
168 |
169 |
170 |
171 |
172 |
173 |
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/tests/testgui.lpr:
--------------------------------------------------------------------------------
1 | program testgui;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | Interfaces, Forms, GuiTestRunner, testfilter
7 | ;
8 |
9 | {$R *.res}
10 |
11 | begin
12 | Application.Initialize;
13 | Application.CreateForm(TGuiTestRunner, TestRunner);
14 | Application.Run;
15 | end.
16 |
17 |
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/utils/mainform.lfm:
--------------------------------------------------------------------------------
1 | object Form1: TForm1
2 | Left = 379
3 | Height = 570
4 | Top = 187
5 | Width = 882
6 | Caption = 'Form1'
7 | ClientHeight = 570
8 | ClientWidth = 882
9 | DesignTimePPI = 120
10 | OnCreate = FormCreate
11 | OnDestroy = FormDestroy
12 | LCLVersion = '3.8.0.0'
13 | object GrpBxBase: TGroupBox
14 | Left = 0
15 | Height = 570
16 | Top = 0
17 | Width = 440
18 | Align = alLeft
19 | Caption = 'Word base'
20 | ClientHeight = 545
21 | ClientWidth = 436
22 | TabOrder = 0
23 | object StrngGrdWordBase: TStringGrid
24 | Left = 0
25 | Height = 489
26 | Top = 56
27 | Width = 436
28 | Align = alBottom
29 | Anchors = [akTop, akLeft, akRight, akBottom]
30 | AutoEdit = False
31 | ColCount = 3
32 | Columns = <
33 | item
34 | Title.Caption = 'Word'
35 | end
36 | item
37 | Title.Caption = 'Ham'
38 | Width = 60
39 | end
40 | item
41 | Title.Caption = 'Spam'
42 | Width = 60
43 | end>
44 | DefaultColWidth = 300
45 | FixedCols = 0
46 | RowCount = 2
47 | TabOrder = 0
48 | TitleStyle = tsNative
49 | Cells = (
50 | 2
51 | 1
52 | 0
53 | 'Word'
54 | 2
55 | 0
56 | 'Ham'
57 | )
58 | end
59 | object DrctryEdtWords: TDirectoryEdit
60 | Left = 8
61 | Height = 28
62 | Top = 8
63 | Width = 320
64 | OnAcceptDirectory = DrctryEdtWordsAcceptDirectory
65 | ShowHidden = False
66 | ButtonWidth = 29
67 | NumGlyphs = 1
68 | Anchors = [akTop, akLeft, akRight]
69 | MaxLength = 0
70 | TabOrder = 1
71 | end
72 | object BtnSave: TButton
73 | Left = 337
74 | Height = 28
75 | Top = 8
76 | Width = 94
77 | Caption = 'Save'
78 | TabOrder = 2
79 | OnClick = BtnSaveClick
80 | end
81 | end
82 | object GrpBxMessage: TGroupBox
83 | Left = 448
84 | Height = 560
85 | Top = 0
86 | Width = 424
87 | Caption = 'Message'
88 | ClientHeight = 535
89 | ClientWidth = 420
90 | TabOrder = 1
91 | object MmMessage: TMemo
92 | Left = 8
93 | Height = 409
94 | Top = 40
95 | Width = 404
96 | TabOrder = 0
97 | OnChange = MmMessageChange
98 | end
99 | object BtnClassify: TButton
100 | Left = 8
101 | Height = 31
102 | Top = 456
103 | Width = 158
104 | Caption = 'Classify'
105 | TabOrder = 1
106 | OnClick = BtnClassifyClick
107 | end
108 | object SttsBrMessage: TStatusBar
109 | Left = 0
110 | Height = 29
111 | Top = 506
112 | Width = 420
113 | Panels = <>
114 | end
115 | object BtnSpam: TButton
116 | Left = 8
117 | Height = 31
118 | Top = 0
119 | Width = 160
120 | Caption = '<= to base as spam!'
121 | TabOrder = 3
122 | OnClick = BtnSpamClick
123 | end
124 | object BtnHam: TButton
125 | Left = 192
126 | Height = 31
127 | Top = 0
128 | Width = 160
129 | Caption = '<= to base as ham!'
130 | TabOrder = 4
131 | OnClick = BtnHamClick
132 | end
133 | end
134 | end
135 |
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/utils/mainform.pas:
--------------------------------------------------------------------------------
1 | unit mainform;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Grids, EditBtn, StdCtrls, ComCtrls, spamfilter
9 | ;
10 |
11 | type
12 |
13 | { TForm1 }
14 |
15 | TVisualSpamFilter = class(TSpamFilter)
16 | public
17 | property Words;
18 | property SpamCount;
19 | property HamCount;
20 | property TotalSpamWords;
21 | property TotalHamWords;
22 | end;
23 |
24 | TForm1 = class(TForm)
25 | BtnClassify: TButton;
26 | BtnSpam: TButton;
27 | BtnHam: TButton;
28 | BtnSave: TButton;
29 | DrctryEdtWords: TDirectoryEdit;
30 | GrpBxMessage: TGroupBox;
31 | GrpBxBase: TGroupBox;
32 | MmMessage: TMemo;
33 | SttsBrMessage: TStatusBar;
34 | StrngGrdWordBase: TStringGrid;
35 | procedure BtnClassifyClick(Sender: TObject);
36 | procedure BtnHamClick(Sender: TObject);
37 | procedure BtnSpamClick(Sender: TObject);
38 | procedure BtnSaveClick(Sender: TObject);
39 | procedure DrctryEdtWordsAcceptDirectory(Sender: TObject; var Value: String);
40 | procedure FormCreate(Sender: TObject);
41 | procedure FormDestroy(Sender: TObject);
42 | procedure MmMessageChange(Sender: TObject);
43 | private
44 | FSpamFilter: TVisualSpamFilter;
45 | procedure OpenBase(const aDir: String);
46 | public
47 |
48 | end;
49 |
50 | var
51 | Form1: TForm1;
52 |
53 | implementation
54 |
55 | {$R *.lfm}
56 |
57 | { TForm1 }
58 |
59 | procedure TForm1.DrctryEdtWordsAcceptDirectory(Sender: TObject; var Value: String);
60 | begin
61 | OpenBase(Value);
62 | end;
63 |
64 | procedure TForm1.BtnClassifyClick(Sender: TObject);
65 | var
66 | aSpamProbability, aHamProbability: Double;
67 | begin
68 | FSpamFilter.Classify(MmMessage.Lines.Text, aHamProbability, aSpamProbability);
69 | SttsBrMessage.SimpleText:=Format('Spam prob.: %n, Ham prob. %n. Factor: %n', [aSpamProbability, aHamProbability,
70 | aSpamProbability-aHamProbability]);
71 | end;
72 |
73 | procedure TForm1.BtnHamClick(Sender: TObject);
74 | begin
75 | FSpamFilter.Train(MmMessage.Lines.Text, False);
76 | FSpamFilter.Save;
77 | OpenBase(DrctryEdtWords.Directory);
78 | end;
79 |
80 | procedure TForm1.BtnSpamClick(Sender: TObject);
81 | begin
82 | FSpamFilter.Train(MmMessage.Lines.Text, True);
83 | FSpamFilter.Save;
84 | OpenBase(DrctryEdtWords.Directory);
85 | end;
86 |
87 | procedure TForm1.BtnSaveClick(Sender: TObject);
88 | begin
89 | FSpamFilter.StorageDir:=IncludeTrailingPathDelimiter(DrctryEdtWords.Directory);
90 | FSpamFilter.Save;
91 | end;
92 |
93 | procedure TForm1.FormCreate(Sender: TObject);
94 | begin
95 | FSpamFilter:=TVisualSpamFilter.Create;
96 | OpenBase(EmptyStr);
97 | end;
98 |
99 | procedure TForm1.FormDestroy(Sender: TObject);
100 | begin
101 | FSpamFilter.Free;
102 | end;
103 |
104 | procedure TForm1.MmMessageChange(Sender: TObject);
105 | begin
106 | SttsBrMessage.Panels.Clear;
107 | end;
108 |
109 | procedure TForm1.OpenBase(const aDir: String);
110 | var
111 | i: Integer;
112 | begin
113 | StrngGrdWordBase.Clear;
114 | FSpamFilter.StorageDir:=IncludeTrailingPathDelimiter(aDir);
115 | FSpamFilter.LoadJSON(True);
116 | StrngGrdWordBase.RowCount:=FSpamFilter.Words.Count+1;
117 | for i:=0 to FSpamFilter.Words.Count-1 do
118 | begin
119 | StrngGrdWordBase.Cells[0, i+1]:=FSpamFilter.Words.Keys[i];
120 | StrngGrdWordBase.Cells[1, i+1]:=FSpamFilter.Words.Data[i].Ham.ToString;
121 | StrngGrdWordBase.Cells[2, i+1]:=FSpamFilter.Words.Data[i].Spam.ToString;
122 | end;
123 | end;
124 |
125 | end.
126 |
127 |
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/utils/nbc_gui.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/Al-Muhandis/AdminHelper/12b1507c52f960dc87073efff1841ff772e994a4/src/NaiveBayesClassifier/utils/nbc_gui.ico
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/utils/nbc_gui.lpi:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 | -
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 | -
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
80 |
81 |
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 | -
107 |
108 |
109 |
110 |
111 |
112 |
113 |
114 |
115 |
116 |
117 |
118 |
119 |
120 |
121 |
122 |
123 |
124 |
125 |
126 |
127 |
128 |
129 |
130 |
131 |
132 |
133 |
134 |
135 |
136 |
137 |
138 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
150 |
151 |
152 | -
153 |
154 |
155 | -
156 |
157 |
158 | -
159 |
160 |
161 |
162 |
163 |
164 |
--------------------------------------------------------------------------------
/src/NaiveBayesClassifier/utils/nbc_gui.lpr:
--------------------------------------------------------------------------------
1 | program nbc_gui;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | {$IFDEF UNIX}
7 | cthreads,
8 | {$ENDIF}
9 | {$IFDEF HASAMIGA}
10 | athreads,
11 | {$ENDIF}
12 | Interfaces, // this includes the LCL widgetset
13 | Forms, mainform, spamfilter
14 | { you can add units after this };
15 |
16 | {$R *.res}
17 |
18 | begin
19 | RequireDerivedFormResource:=True;
20 | Application.Scaled:=True;
21 | Application.Initialize;
22 | Application.CreateForm(TForm1, Form1);
23 | Application.Run;
24 | end.
25 |
26 |
--------------------------------------------------------------------------------
/src/actionadminhelper.pas:
--------------------------------------------------------------------------------
1 | unit actionadminhelper;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | tgtypes, tgsendertypes, brooktelegramaction, adminhelper_orm, fpjson, brk_tg_config, telegram_cmn
9 | ;
10 |
11 | type
12 |
13 | TDefenderStatus = (dsUnknown, dsStandard, dsPatrol, dsGuard);
14 |
15 | { TAdminHelper }
16 |
17 | TAdminHelper = class(TWebhookAction)
18 | private
19 | FBotConfig: TBotConf;
20 | FBotORM: TBotORM;
21 | FCurrent: TCurrentEvent;
22 | procedure AdminSpamVerdict(const aIsSpamStr, aCallbackID: String; aInspectedChat, aExecutor: Int64;
23 | aInspectedMessage: Integer);
24 | procedure BtClbckMessage({%H-}ASender: TObject; {%H-}ACallback: TCallbackQueryObj);
25 | procedure BtClbckSpam({%H-}ASender: TObject; {%H-}ACallback: TCallbackQueryObj);
26 | procedure BtCmndSaveFilters({%H-}aSender: TObject; const {%H-}ACommand: String; {%H-}aMessage: TTelegramMessageObj);
27 | procedure BtCmndSettings({%H-}aSender: TObject; const {%H-}ACommand: String; aMessage: TTelegramMessageObj);
28 | procedure BtCmndSpam({%H-}aSender: TObject; const {%H-}ACommand: String; aMessage: TTelegramMessageObj);
29 | procedure BtCmndUpdate({%H-}aSender: TObject; const {%H-}ACommand: String; aMessage: TTelegramMessageObj);
30 | procedure BtRcvChatMemberUpdated({%H-}ASender: TTelegramSender; aChatMemberUpdated: TTelegramChatMemberUpdated);
31 | procedure BtRcvMessage({%H-}ASender: TObject; AMessage: TTelegramMessageObj);
32 | procedure ChangeKeyboardAfterCheckedOut(aIsSpam: Boolean; aInspectedUser: Int64; const aInspectedUserName: String;
33 | aIsUserPrivacy: Boolean = False);
34 | procedure ComfirmationErroneousBan(aInspectedChat: Int64; aInspectedMessage: Integer);
35 | function GetBotORM: TBotORM;
36 | function GetCurrent: TCurrentEvent;
37 | procedure SendComplaint;
38 | procedure RollbackErroneousBan(aInspectedChat, aInspectedUser, aExecutor: Int64; aInspectedMessage: Integer;
39 | const aInspectedUserName: String);
40 | procedure TryRollbackErroneousBan(aInspectedChat: Int64; aInspectedMessage: Integer; const aCallbackID: String;
41 | aCallbackMessageID: Integer);
42 | procedure UpdateModeratorsForChat(aChat, aFrom: Int64);
43 | protected
44 | property BotConfig: TBotConf read FBotConfig write FBotConfig;
45 | property Current: TCurrentEvent read GetCurrent;
46 | property ORM: TBotORM read GetBotORM;
47 | public
48 | constructor Create; override;
49 | destructor Destroy; override;
50 | procedure Post; override;
51 | end;
52 |
53 | implementation
54 |
55 | uses
56 | eventlog, sysutils, StrUtils, adminhelper_conf, tgutils, spamfilter_implementer
57 | ;
58 |
59 | resourcestring
60 | _sInspctdMsgWsChckdOt='The message has already been verified';
61 | _sBnRlbck= 'The user''s ban was rolled back: unbanning and rating returning ';
62 | _sBnAlrdyRlbck= 'This ban action has already been rolled back';
63 | _sStartText= 'Start Text for TAdminHelper';
64 | _sHelpText= 'Help Text for TAdminHelper';
65 | _sYrRtng= 'Your rating is %d';
66 | _sYrRghts= 'Status: %s';
67 | _sCnfrmtnRlbckBn= 'Do you think the ban was wrong? '+
68 | 'If the ban is rolled back, the complainant''s rating will be downgraded and '+
69 | 'the inspected user who sent this message will be unbanned.';
70 | _sCmplnntIsFldByBt= 'The complaint is filed by the bot itself';
71 | _sDbgSpmInf= 'Ln spam probability: %n, Ln ham probability: %n. Spam Factor: %n';
72 | _sSpmBsEmj= 'It is identified as a spam based on emojies in the message';
73 |
74 | const
75 | _LvlStndrd='Standard';
76 | _LvlPatrol='Patrol';
77 | _LvlGrd= 'Guard';
78 |
79 | _emjSheriff='🛡';
80 | _emjPatrol='🚓';
81 |
82 | function BuildMsgUrl(aChat: TTelegramChatObj; aMsgID: Integer): String;
83 | const
84 | _ChatIDPrefix='-100';
85 | var
86 | aTpl, aChatName: String;
87 | begin
88 | aChatName:=aChat.Username;
89 | if aChatName.IsEmpty then
90 | begin
91 | aChatName:=aChat.ID.ToString;
92 | if StartsStr(_ChatIDPrefix, aChatName) then
93 | aChatName:=RightStr(aChatName, Length(aChatName)-Length(_ChatIDPrefix))
94 | else
95 | Exit('https://t.me/'); { #todo : Maybe other handling? }
96 | aTpl:='https://t.me/c/%s/%d';
97 | end
98 | else
99 | aTpl:='https://t.me/%s/%d';
100 | Result:=Format(aTpl, [aChatName, aMsgID]);
101 | end;
102 |
103 | { TAdminHelper }
104 |
105 | procedure TAdminHelper.BtClbckSpam(ASender: TObject; ACallback: TCallbackQueryObj);
106 | var
107 | aInspectedChat, aCurrentUserID: Int64;
108 | aPar: String;
109 | aInspectedMessage: Longint;
110 |
111 | function NPar(N: Byte): String;
112 | begin
113 | Result:=ExtractDelimited(N, ACallback.Data, [' ']);
114 | end;
115 |
116 | procedure AdminVerdict;
117 | begin
118 | Current.InspectedMessage:=ACallback.Message.Text;
119 | AdminSpamVerdict(aPar, ACallback.ID, aInspectedChat, aCurrentUserID, aInspectedMessage);
120 | end;
121 |
122 | begin
123 | aPar:=NPar(2);
124 | if aPar='hide' then
125 | begin
126 | Bot.deleteMessage(ACallback.Message.MessageId);
127 | Exit;
128 | end;
129 | if not TryStrToInt64(aPar, aInspectedChat) then
130 | Exit;
131 | if not TryStrToInt(NPar(3), aInspectedMessage) then
132 | Exit;
133 | aCurrentUserID:=ACallback.From.ID;
134 | if not ORM.IsModerator(aInspectedChat, aCurrentUserID) then
135 | Exit;
136 | aPar:=NPar(4);
137 | case aPar of
138 | _dtRC: ComfirmationErroneousBan(aInspectedChat, aInspectedMessage);
139 | _dtR: TryRollbackErroneousBan(aInspectedChat, aInspectedMessage, ACallback.ID, ACallback.Message.MessageId);
140 | else
141 | AdminVerdict;
142 | end;
143 | Bot.UpdateProcessed:=True;
144 | end;
145 |
146 | procedure TAdminHelper.BtCmndSaveFilters(aSender: TObject; const ACommand: String; aMessage: TTelegramMessageObj);
147 | begin
148 | if Bot.CurrentChatId=Conf.ServiceAdmin then
149 | _SpamFilterWorker.Save;
150 | end;
151 |
152 | procedure TAdminHelper.BtCmndSettings(aSender: TObject; const ACommand: String; aMessage: TTelegramMessageObj);
153 | var
154 | aRate: Integer;
155 | aStatus, aMsg: String;
156 | begin
157 | aRate:=ORM.UserByID(aMessage.From.ID).Rate;
158 | if aRatemsMember then
206 | Exit;
207 | Current.InspectedUser:=aChatMemberUpdated.NewChatMember.User;
208 | aUserID:=Current.InspectedUser.ID;
209 | aIsNew:=not ORM.GetUserByID(aUserID);
210 | if ORM.User.Spammer=_msSpam then
211 | begin
212 | Current.InspectedChat:=aChatMemberUpdated.Chat;
213 | Bot.banChatMember(Current.InspectedChat.ID, aUserID);
214 | Current.Complainant:=nil;
215 | Current.InspectedMessageID:=0;
216 | Current.SendMessagesToAdmins(True, True);
217 | Exit;
218 | end;
219 | ORM.User.Name:=CaptionFromUser(Current.InspectedUser);
220 | ORM.SaveUserAppearance(aIsNew);
221 | end;
222 |
223 | procedure TAdminHelper.BtRcvMessage(ASender: TObject; AMessage: TTelegramMessageObj);
224 | begin
225 | Current.AssignInspectedFromMsg(AMessage);
226 | Current.Complainant:=nil;
227 | if not Current.IsGroup then
228 | Exit;
229 | if ORM.UserByID(AMessage.From.ID).Spammer=_msSpam then
230 | begin
231 | Current.SendMessagesToAdmins(True, False);
232 | Bot.deleteMessage(Current.InspectedChat.ID, Current.InspectedMessageID);
233 | Bot.banChatMember(Current.InspectedChat.ID, AMessage.From.ID);
234 | Exit;
235 | end;
236 | if ORM.User.IsNewbie then
237 | if not Current.InspectedMessage.IsEmpty then
238 | _SpamFilterWorker.Classify(Current)
239 | else
240 | Current.ProcessComplaint(False, _msUnknown);
241 | end;
242 |
243 | function TAdminHelper.GetBotORM: TBotORM;
244 | begin
245 | if FBotORM=nil then
246 | begin
247 | FBotORM:=TBotORM.Create(Conf.AdminHelperDB);
248 | FBotORM.LogFileName:='action_sql_db.log';
249 | end;
250 | Result:=FBotORM;
251 | end;
252 |
253 | function TAdminHelper.GetCurrent: TCurrentEvent;
254 | begin
255 | if FCurrent=nil then
256 | FCurrent:=TCurrentEvent.Create(Bot, ORM);
257 | Result:=FCurrent;
258 | end;
259 |
260 | procedure TAdminHelper.SendComplaint;
261 | var
262 | aSpamStatus, aRate: Integer;
263 | aIsNewbie, aCanBeSilentBan: Boolean;
264 | aDefenderStatus: TDefenderStatus;
265 | begin
266 | aSpamStatus:=_msUnknown;
267 | aIsNewbie:=ORM.UserByID(Current.InspectedUser.ID).IsNewbie;
268 | aRate:=ORM.UserByID(Current.Complainant.ID).Rate;
269 | aDefenderStatus:=dsStandard;
270 | if aRate>Conf.GuardRate then
271 | aDefenderStatus:=dsGuard
272 | else
273 | if aRate>Conf.PatrolRate then
274 | aDefenderStatus:=dsPatrol;
275 | if aDefenderStatus>=dsPatrol then
276 | if aIsNewbie or (aDefenderStatus>=dsGuard) then
277 | begin
278 | aSpamStatus:=_msSpam;
279 | if not Current.InspectedMessage.IsEmpty then
280 | _SpamFilterWorker.Train(Current, True);
281 | end;
282 | aCanBeSilentBan:=aIsNewbie and (aDefenderStatus>=dsGuard);
283 | Current.ProcessComplaint(aCanBeSilentBan, aSpamStatus);
284 | end;
285 |
286 | procedure TAdminHelper.RollbackErroneousBan(aInspectedChat, aInspectedUser, aExecutor: Int64;
287 | aInspectedMessage: Integer; const aInspectedUserName: String);
288 | begin
289 | { Roll back the ratings due the eroneous user banning }
290 | ORM.UpdateRatings(aInspectedChat, aInspectedMessage, True, True, aExecutor);
291 | Bot.unbanChatMember(aInspectedChat, aInspectedUser, True);
292 | Bot.sendMessage(Bot.CurrentUser.ID, _sBnRlbck);
293 | ORM.ModifyMessage(False, aExecutor);
294 | { Resave inspected user as a non spammer }
295 | ORM.SaveUserSpamStatus(aInspectedUser, aInspectedUserName, False);
296 | end;
297 |
298 | procedure TAdminHelper.TryRollbackErroneousBan(aInspectedChat: Int64; aInspectedMessage: Integer;
299 | const aCallbackID: String; aCallbackMessageID: Integer);
300 | begin
301 | if not ORM.GetMessage(aInspectedChat, aInspectedMessage) then
302 | Exit; { #todo : Why no message? }
303 | if ORM.Message.IsSpam=_msNotSpam then
304 | begin
305 | Bot.answerCallbackQuery(aCallbackID, _sBnAlrdyRlbck, False, EmptyStr, 1000);
306 | Exit;
307 | end;
308 | Bot.deleteMessage(aCallbackMessageID);
309 | RollbackErroneousBan(aInspectedChat, ORM.Message.User, ORM.Message.Executor, aInspectedMessage, ORM.Message.UserName);
310 | end;
311 |
312 | procedure TAdminHelper.AdminSpamVerdict(const aIsSpamStr, aCallbackID: String; aInspectedChat, aExecutor: Int64;
313 | aInspectedMessage: Integer);
314 | var
315 | aIsSpam: Boolean;
316 | begin
317 | if not TryStrToBool(aIsSpamStr, aIsSpam) then
318 | Exit;
319 | if ORM.GetMessage(aInspectedChat, aInspectedMessage) then
320 | begin
321 | if ORM.ModifyMessageIfNotChecked(aIsSpam, aExecutor) then
322 | begin
323 | Current.BanOrNotToBan(aInspectedChat, ORM.Message.User, ORM.Message.UserName, aInspectedMessage, aIsSpam);
324 | if not Current.InspectedMessage.IsEmpty then
325 | _SpamFilterWorker.Train(Current, aIsSpam);
326 | ChangeKeyboardAfterCheckedOut(aIsSpam, ORM.Message.User, ORM.Message.UserName);
327 | end
328 | else begin
329 | ChangeKeyboardAfterCheckedOut(ORM.Message.IsSpam=_msSpam, ORM.Message.User, ORM.Message.UserName);
330 | Bot.answerCallbackQuery(aCallbackID, _sInspctdMsgWsChckdOt);
331 | end
332 | end
333 | else begin
334 | Bot.Logger.Error(Format('There is no the message #%d in the chat #%d', [aInspectedMessage, aInspectedChat]));
335 | if not Current.InspectedMessage.IsEmpty then
336 | _SpamFilterWorker.Train(Current, aIsSpam);
337 | end;
338 | end;
339 |
340 | procedure TAdminHelper.BtClbckMessage(ASender: TObject; ACallback: TCallbackQueryObj);
341 | var
342 | aMsg: String;
343 |
344 | function MessageProbablyItsSpam: String;
345 | var
346 | aSpamProbability, aHamProbability: Extended;
347 | begin
348 | if ExtractDelimited(5, ACallback.Data, [' '])='emj' then
349 | Result:=_sSpmBsEmj
350 | else begin
351 | if not TryStrToFloat(ExtractDelimited(3, ACallback.Data, [' ']), aSpamProbability) or
352 | not TryStrToFloat(ExtractDelimited(4, ACallback.Data, [' ']), aHamProbability) then
353 | Exit('Error, please write to the developer');
354 | Current.SpamProbability:=aSpamProbability;
355 | Current.HamProbability:=aHamProbability;
356 | Result:=Format(_sDbgSpmInf, [Current.SpamProbability, Current.HamProbability, Current.SpamFactor]);
357 | end;
358 | end;
359 |
360 | begin
361 | case ExtractDelimited(2, ACallback.Data, [' ']) of
362 | _dtUsrPrvcy: aMsg:='User privacy for one of the buttons restricted';
363 | _dtCmplnntIsBt: aMsg:=_sCmplnntIsFldByBt;
364 | _dtPrbblySpm: aMsg:=MessageProbablyItsSpam;
365 | else
366 | aMsg:='The message not defined';
367 | end;
368 | Bot.answerCallbackQuery(ACallback.ID, aMsg, True, EmptyStr, 10000);
369 | Bot.UpdateProcessed:=True;
370 | end;
371 |
372 | procedure TAdminHelper.ChangeKeyboardAfterCheckedOut(aIsSpam: Boolean; aInspectedUser: Int64;
373 | const aInspectedUserName: String; aIsUserPrivacy: Boolean);
374 | var
375 | aReplyMarkup: TReplyMarkup;
376 | s: String;
377 | begin
378 | aReplyMarkup:=TReplyMarkup.Create;
379 | try
380 | if aIsSpam then
381 | s:=Format(_sBtnPair, [_sBndUsr, aInspectedUserName])
382 | else
383 | s:=Format(_sInspctdUsr, [_sBndUsr, aInspectedUserName]);
384 |
385 | if aIsUserPrivacy then
386 | aReplyMarkup.CreateInlineKeyBoard.Add.AddButton(s, RouteMsgUsrPrvcy)
387 | else
388 | aReplyMarkup.CreateInlineKeyBoard.Add.AddButtonUrl(s, Format(_dTgUsrUrl, [aInspectedUser]));
389 | Bot.editMessageReplyMarkup(Bot.CurrentMessage.ChatId, Bot.CurrentMessage.MessageId, EmptyStr, aReplyMarkup);
390 | finally
391 | aReplyMarkup.Free;
392 | end;
393 | if not aIsUserPrivacy then
394 | begin
395 | aIsUserPrivacy:=(Bot.LastErrorCode=400) and ContainsStr(Bot.LastErrorDescription, _tgErrBtnUsrPrvcyRstrctd);
396 | if aIsUserPrivacy then
397 | ChangeKeyboardAfterCheckedOut(aIsSpam, aInspectedUser, aInspectedUserName, True);
398 | end;
399 | end;
400 |
401 | procedure TAdminHelper.ComfirmationErroneousBan(aInspectedChat: Int64; aInspectedMessage: Integer);
402 | var
403 | aReplyMarkup: TReplyMarkup;
404 | begin
405 | aReplyMarkup:=TReplyMarkup.Create;
406 | try
407 | aReplyMarkup.CreateInlineKeyBoard.Add.AddButtons([
408 | 'Yes, rollback ban action', RouteCmdSpamLastChecking(aInspectedChat, aInspectedMessage, False),
409 | 'Close: ban was correct', 'spam hide'
410 | ]);
411 | Bot.sendMessage(_sCnfrmtnRlbckBn, pmMarkdown, False, aReplyMarkup);
412 | finally
413 | AReplyMarkup.Free;
414 | end;
415 | end;
416 |
417 | procedure TAdminHelper.UpdateModeratorsForChat(aChat, aFrom: Int64);
418 | var
419 | aModerators: TJSONArray;
420 | aModeratorIDs: TInt64List;
421 | aChatMember: TTelegramChatMember;
422 | m: TJSONEnum;
423 | aUserID: Int64;
424 | begin
425 | if not Bot.getChatMember(aChat, aFrom, aChatMember) or
426 | not (aChatMember.StatusType in [msCreator, msAdministrator]) then
427 | Exit;
428 | ORM.ClearModeratorsForChat(aChat);
429 | Bot.getChatAdministrators(aChat, aModerators);
430 | try
431 | aModeratorIDs:=TInt64List.Create;
432 | try
433 | aModeratorIDs.Capacity:=aModerators.Count;
434 | for m in aModerators do
435 | with (m.Value as TJSONObject).Objects['user'] do
436 | if not Booleans['is_bot'] then
437 | begin
438 | aUserID:=Int64s['id'];
439 | aModeratorIDs.Add(aUserID);
440 | ORM.SaveUserSpamStatus(aUserID, Strings['first_name'], False);
441 | end;
442 | try
443 | ORM.AddChatMembers(aChat, True, aModeratorIDs);
444 | except
445 | on E: Exception do
446 | Bot.Logger.Error('UpdateModeratorsForChat. '+e.ClassName+': '+e.Message);
447 | end;
448 | finally
449 | aModeratorIDs.Free;
450 | end;
451 | finally
452 | aModerators.Free;
453 | end;
454 | end;
455 |
456 | constructor TAdminHelper.Create;
457 | begin
458 | BotConfig:=Conf.AdminHelperBot;
459 | inherited Create;
460 | Bot.Logger:=TEventLog.Create(nil);
461 | Bot.Logger.LogType:=ltFile;
462 | Bot.Logger.AppendContent:=True;
463 | Bot.BotUsername:=BotConfig.Telegram.UserName;
464 | Bot.Logger.FileName:=AppDir+Bot.BotUsername+'.log';
465 |
466 | Bot.LogDebug:=BotConfig.Debug;
467 |
468 | Bot.OnReceiveChatMemberUpdated:=@BtRcvChatMemberUpdated;
469 | Bot.OnReceiveMessage:=@BtRcvMessage;
470 | Bot.CommandHandlers['/'+_dSpm]:=@BtCmndSpam;
471 | Bot.CallbackHandlers['m']:=@BtClbckMessage;
472 | Bot.CallbackHandlers[_dSpm]:=@BtClbckSpam;
473 | Bot.CommandHandlers['/update']:=@BtCmndUpdate;
474 | Bot.CommandHandlers['/settings']:=@BtCmndSettings;
475 | Bot.CommandHandlers['/savefilter']:=@BtCmndSaveFilters;
476 |
477 | Bot.StartText:=_sStartText;
478 | Bot.HelpText:=_sHelpText;
479 |
480 | end;
481 |
482 | destructor TAdminHelper.Destroy;
483 | begin
484 | FCurrent.Free;
485 | FBotORM.Free;
486 | Bot.Logger.Free;
487 | inherited Destroy;
488 | end;
489 |
490 | procedure TAdminHelper.Post;
491 | begin
492 | try
493 | Bot.Token:=Variables.Values['token'];
494 | if SameStr(Bot.Token, BotConfig.Telegram.Token) then
495 | inherited Post
496 | else
497 | HttpResponse.Code:=404;
498 | except
499 | on E: Exception do
500 | Bot.Logger.Error('['+Self.ClassName+'] '+e.ClassName+': '+e.Message);
501 | end;
502 | end;
503 |
504 | initialization
505 | TAdminHelper.Register('/adminhelper/:token/');
506 |
507 | end.
508 |
--------------------------------------------------------------------------------
/src/adminhelper_conf.pas:
--------------------------------------------------------------------------------
1 | unit adminhelper_conf;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | SysUtils, brk_tg_config
9 | ;
10 |
11 | type
12 |
13 | EWSWConfig = class(Exception);
14 |
15 | { TSpamFilterConfig }
16 |
17 | TSpamFilterConfig = class
18 | private
19 | FDefinitelyHam: Double;
20 | FDefinitelySpam: Double;
21 | FEmojiLimit: Integer;
22 | FEnabled: Boolean;
23 | public
24 | constructor Create;
25 | published
26 | property Enabled: Boolean read FEnabled write FEnabled;
27 | property DefinitelySpam: Double read FDefinitelySpam write FDefinitelySpam;
28 | property DefinitelyHam: Double read FDefinitelyHam write FDefinitelyHam;
29 | property EmojiLimit: Integer read FEmojiLimit write FEmojiLimit;
30 | end;
31 |
32 | { TConf }
33 |
34 | TConf = class
35 | private
36 | FAdminHelperBot: TBotConf;
37 | FAdminHelperDB: TDBConf;
38 | FDebug: TDebugInfo;
39 | FGuardRate: Integer;
40 | FNewbieDays: Integer;
41 | FPatrolRate: Integer;
42 | FPort: Integer;
43 | FServiceAdmin: Int64;
44 | FSpamFilter: TSpamFilterConfig;
45 | public
46 | constructor Create;
47 | destructor Destroy; override;
48 | published
49 | property Debug: TDebugInfo read FDebug write FDebug;
50 | property AdminHelperBot: TBotConf read FAdminHelperBot write FAdminHelperBot;
51 | property AdminHelperDB: TDBConf read FAdminHelperDB write FAdminHelperDB;
52 | property SpamFilter: TSpamFilterConfig read FSpamFilter write FSpamFilter;
53 | property Port: Integer read FPort write FPort;
54 | property PatrolRate: Integer read FPatrolRate write FPatrolRate;
55 | property GuardRate: Integer read FGuardRate write FGuardRate;
56 | property NewbieDays: Integer read FNewbieDays write FNewbieDays;
57 | property ServiceAdmin: Int64 read FServiceAdmin write FServiceAdmin;
58 |
59 | end;
60 |
61 | var
62 | Conf: TConf;
63 | ConfDir: String;
64 |
65 | implementation
66 |
67 | { TSpamFilterConfig }
68 |
69 | constructor TSpamFilterConfig.Create;
70 | begin
71 | FEnabled:=True;
72 | FDefinitelySpam:=30;
73 | FDefinitelyHam:=-15;
74 | FEmojiLimit:=15;
75 | end;
76 |
77 | { TConf }
78 |
79 | constructor TConf.Create;
80 | begin
81 | FDebug:=TDebugInfo.Create;
82 | FAdminHelperBot:=TBotConf.Create;
83 | FAdminHelperDB:=TDBConf.Create;
84 | FSpamFilter:=TSpamFilterConfig.Create;
85 | FPatrolRate:=11;
86 | FGuardRate:=FPatrolRate*3;
87 | FNewbieDays:=7;
88 | end;
89 |
90 | destructor TConf.Destroy;
91 | begin
92 | FSpamFilter.Free;
93 | FAdminHelperDB.Free;
94 | FAdminHelperBot.Free;
95 | FDebug.Free;
96 | inherited Destroy;
97 | end;
98 |
99 | initialization
100 | Conf:=TConf.Create;
101 | LoadFromJSON(Conf, 'adminhelper.json');
102 | SaveToJSON(Conf, 'adminhelper.bak.json');
103 | ConfDir:=IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0)));
104 |
105 | finalization
106 | FreeAndNil(Conf);
107 |
108 | end.
109 |
110 |
--------------------------------------------------------------------------------
/src/adminhelper_orm.pas:
--------------------------------------------------------------------------------
1 | unit adminhelper_orm;
2 |
3 | {$mode ObjFPC}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | dSQLdbBroker, SysUtils, classes, fgl, brk_tg_config, adminhelper_conf
9 | ;
10 |
11 | type
12 | THelperObjctRoot = class(TObject)
13 | public
14 | procedure Clear; virtual; abstract;
15 | end;
16 |
17 | { TBotUser }
18 |
19 | TBotUser = class(THelperObjctRoot)
20 | private
21 | FAppearance: Int64;
22 | FName: String;
23 | FRate: Integer;
24 | FId: Int64;
25 | FSpammer: Integer;
26 | function GetAppearanceAsDateTime: TDateTime;
27 | procedure SetAppearanceAsDateTime(AValue: TDateTime);
28 | public
29 | procedure Clear; override;
30 | function IsNewbie: Boolean;
31 | property AppearanceAsDateTime: TDateTime read GetAppearanceAsDateTime write SetAppearanceAsDateTime;
32 | published
33 | property ID: Int64 read FId write FId;
34 | property Name: String read FName write FName;
35 | property Rate: Integer read FRate write FRate;
36 | property Spammer: Integer read FSpammer write FSpammer;
37 | property Appearance: Int64 read FAppearance write FAppearance;
38 | end;
39 |
40 | { TChatMember }
41 |
42 | TChatMember = class(THelperObjctRoot)
43 | private
44 | FChat: Int64;
45 | FModerator: Boolean;
46 | FUser: Int64;
47 | public
48 | procedure Clear; override;
49 | published
50 | property Chat: Int64 read FChat write FChat;
51 | property User: Int64 read FUser write FUser;
52 | property Moderator: Boolean read FModerator write FModerator;
53 | end;
54 |
55 | { TTelegramMessage }
56 |
57 | TTelegramMessage = class(THelperObjctRoot)
58 | private
59 | FChat: Int64;
60 | FExecutor: Int64;
61 | FUser: Int64;
62 | FIsSpam: Integer;
63 | FMessage: Integer;
64 | FUserName: String;
65 | public
66 | procedure Clear; override;
67 | published
68 | property Chat: Int64 read FChat write FChat;
69 | property Message: Integer read FMessage write FMessage;
70 | property User: Int64 read FUser write FUser;
71 | property IsSpam: Integer read FIsSpam write FIsSpam;
72 | property Executor: Int64 read FExecutor write FExecutor;
73 | property UserName: String read FUserName write FUserName;
74 | end;
75 |
76 | { TComplaint }
77 |
78 | TComplaint = class(THelperObjctRoot)
79 | private
80 | FChat: Int64;
81 | FComplainant: Int64;
82 | FID: Integer;
83 | FMessage: Integer;
84 | public
85 | procedure Clear; override;
86 | published
87 | property ID: Integer read FID write FID;
88 | property Chat: Int64 read FChat write FChat;
89 | property Message: Integer read FMessage write FMessage;
90 | property Complainant: Int64 read FComplainant write FComplainant;
91 | end;
92 |
93 | TopfBotUsers = specialize TdGSQLdbEntityOpf;
94 | TopfMessages = specialize TdGSQLdbEntityOpf;
95 | TopfComplaints = specialize TdGSQLdbEntityOpf;
96 | TopfChatMembers = specialize TdGSQLdbEntityOpf;
97 |
98 | TInt64List = specialize TFPGList;
99 |
100 | { TBotORM }
101 |
102 | TBotORM = class
103 | private
104 | FCon: TdSQLdbConnector;
105 | FDBConfig: TDBConf;
106 | FLogFileName: String;
107 | FopChatMembers: TopfChatMembers;
108 | FopComplaints: TopfComplaints;
109 | FopMessages: TopfMessages;
110 | FopUsers: TopfBotUsers;
111 | procedure AddChatMember(aChat, aUser: Int64; aModerator: Boolean); // Without Apply table
112 | function Con: TdSQLdbConnector;
113 | class procedure CreateDB({%H-}aConnection: TdSQLdbConnector);
114 | function GetMessage: TTelegramMessage;
115 | function GetopChatMembers: TopfChatMembers;
116 | function GetopComplaints: TopfComplaints;
117 | function GetopMessages: TopfMessages;
118 | function GetopUsers: TopfBotUsers;
119 | function GetUser: TBotUser;
120 | protected
121 | property opMessages: TopfMessages read GetopMessages;
122 | property opComplaints: TopfComplaints read GetopComplaints;
123 | property opChatMembers: TopfChatMembers read GetopChatMembers;
124 | property opUsers: TopfBotUsers read GetopUsers;
125 | public
126 | procedure AddChatMembers(aChat: Int64; aModerator: Boolean; aUsers: TInt64List);
127 | procedure AddComplaint(aComplainant, aInspectedChat: Int64; aInspectedMessage: Integer);
128 | procedure ClearModeratorsForChat(aChat: Int64);
129 | constructor Create(aDBConf: TDBConf);
130 | destructor Destroy; override;
131 | function GetMessage(aInspectedChat: Int64; aInspectedMessage: Integer): Boolean;
132 | procedure GetModeratorsByChat(aChat: Int64; aModerators: TopfChatMembers.TEntities);
133 | procedure GetNSaveMessage(const aInspectedUserName: String; aInspectedUser, aInspectedChat, aExecutor: Int64;
134 | aInspectedMessage: Integer; out aIsFirstComplaint: Boolean; aSpamStatus: Integer = 0);
135 | procedure AddMessage(const aInspectedUserName: String; aInspectedUser, aInspectedChat, aExecutor: Int64;
136 | aInspectedMessage: Integer; aSpamStatus: Integer);
137 | procedure ModifyMessage(aIsSpam: Boolean; aExecutor: Int64);
138 | function GetUserByID(aUserID: Int64): Boolean;
139 | function IsModerator(aChat, aUser: Int64): Boolean;
140 | function ModifyMessageIfNotChecked(aIsSpam: Boolean; aExecutor: Int64 = 0): Boolean;
141 | procedure UpdateRatings(aChatID: Int64; aMsgID: LongInt; aIsSpam: Boolean; aIsRollback: Boolean = False;
142 | aExecutor: Int64 = 0);
143 | procedure SaveUserAppearance(aIsNew: Boolean);
144 | procedure SaveUserSpamStatus(aUserID: Int64; const aUserName: String; aIsSpammer: Boolean = True);
145 | procedure SaveUser(aIsNew: Boolean);
146 | function UserByID(aUserID: Int64): TBotUser;
147 | property DBConfig: TDBConf read FDBConfig write FDBConfig;
148 | property LogFileName: String read FLogFileName write FLogFileName;
149 | property Message: TTelegramMessage read GetMessage;
150 | property User: TBotUser read GetUser;
151 | end;
152 |
153 | const
154 | _msUnknown = 0;
155 | _msSpam = 1;
156 | _msNotSpam = -1;
157 |
158 | _Penalty = 6;
159 |
160 | implementation
161 |
162 | uses
163 | dOpf, DateUtils, SQLDB
164 | ;
165 |
166 | function CheckDisconnectErr(const aErrMessage: string): Boolean;
167 | const
168 | _sqlE_ClntWsDcnctd='The client was disconnected by the server because of inactivity';
169 | _sqlE_LstCnctn='Lost connection to MySQL server during query';
170 | begin
171 | Result:=aErrMessage.Contains(_sqlE_ClntWsDcnctd) or aErrMessage.Contains(_sqlE_LstCnctn);
172 | end;
173 |
174 | { TBotUser }
175 |
176 | procedure TBotUser.SetAppearanceAsDateTime(AValue: TDateTime);
177 | begin
178 | FAppearance:=DateTimeToUnix(AValue, False);
179 | end;
180 |
181 | function TBotUser.GetAppearanceAsDateTime: TDateTime;
182 | begin
183 | Result:=UnixToDateTime(FAppearance, False);
184 | end;
185 |
186 | procedure TBotUser.Clear;
187 | begin
188 | FName:=EmptyStr;
189 | FRate:=0;
190 | FAppearance:=0;
191 | FSpammer:=_msUnknown;
192 | end;
193 |
194 | function TBotUser.IsNewbie: Boolean;
195 | begin
196 | Result:=((Now-AppearanceAsDateTime)<=Conf.NewbieDays) and (Rate<1) and (Spammer<>_msNotSpam);
197 | end;
198 |
199 | { TChatMember }
200 |
201 | procedure TChatMember.Clear;
202 | begin
203 | FChat:=0;
204 | FUser:=0;
205 | FModerator:=False;
206 | end;
207 |
208 | { TTelegramMessage }
209 |
210 | procedure TTelegramMessage.Clear;
211 | begin
212 | FUser:=0;
213 | FIsSpam:=0;
214 | FExecutor:=0;
215 | FUserName:=EmptyStr;
216 | end;
217 |
218 | { TComplaint }
219 |
220 | procedure TComplaint.Clear;
221 | begin
222 | FChat:=0;
223 | FComplainant:=0;
224 | FMessage:=0;
225 | end;
226 |
227 | { TBotORM }
228 |
229 | function TBotORM.GetopUsers: TopfBotUsers;
230 | begin
231 | if not Assigned(FopUsers) then
232 | begin
233 | FopUsers:=TopfBotUsers.Create(Con, 'users');
234 | FopUsers.Table.PrimaryKeys.Text:='id';
235 | FopUsers.FieldQuote:='`';
236 | end;
237 | Result:=FopUsers;
238 | end;
239 |
240 | function TBotORM.GetopMessages: TopfMessages;
241 | begin
242 | if not Assigned(FopMessages) then
243 | begin
244 | FopMessages:=TopfMessages.Create(Con, 'messages');
245 | FopMessages.Table.PrimaryKeys.DelimitedText:='chat,message';
246 | FopMessages.FieldQuote:='`';
247 | end;
248 | Result:=FopMessages;
249 | end;
250 |
251 | function TBotORM.GetopComplaints: TopfComplaints;
252 | begin
253 | if not Assigned(FopComplaints) then
254 | begin
255 | FopComplaints:=TopfComplaints.Create(Con, 'complaints');
256 | FopComplaints.Table.PrimaryKeys.DelimitedText:='id';
257 | FopComplaints.FieldQuote:='`';
258 | end;
259 | Result:=FopComplaints;
260 | end;
261 |
262 | function TBotORM.GetMessage: TTelegramMessage;
263 | begin
264 | Result:=opMessages.Entity;
265 | end;
266 |
267 | function TBotORM.GetopChatMembers: TopfChatMembers;
268 | begin
269 | if not Assigned(FopChatMembers) then
270 | begin
271 | FopChatMembers:=TopfChatMembers.Create(Con, 'chatmembers');
272 | FopChatMembers.Table.PrimaryKeys.DelimitedText:='chat,user';
273 | FopChatMembers.FieldQuote:='`';
274 | end;
275 | Result:=FopChatMembers;
276 | end;
277 |
278 | function TBotORM.Con: TdSQLdbConnector;
279 | var
280 | aDir: String;
281 |
282 | procedure DBConnect;
283 | begin
284 | FCon.Database:= FDBConfig.Database;
285 | FCon.User:= FDBConfig.User;
286 | FCon.Host:= FDBConfig.Host;
287 | FCon.Password:= FDBConfig.Password;
288 | FCon.Driver := FDBConfig.Driver;
289 | end;
290 |
291 | begin
292 | if not Assigned(FCon) then
293 | begin
294 | FCon := TdSQLdbConnector.Create(nil);
295 | aDir:=IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0)));
296 | FCon.Logger.Active := FDBConfig.Logger.Active;
297 | DBConnect;
298 | if FDBConfig.Logger.FileName.IsEmpty then
299 | FCon.Logger.FileName := aDir+FLogFileName
300 | else
301 | FCon.Logger.FileName := aDir+FDBConfig.Logger.FileName;
302 | end;
303 | Result := FCon;
304 | end;
305 |
306 | class procedure TBotORM.CreateDB(aConnection: TdSQLdbConnector);
307 | begin
308 | { #todo : Create tables }
309 | end;
310 |
311 | function TBotORM.GetUser: TBotUser;
312 | begin
313 | Result:=opUsers.Entity;
314 | end;
315 |
316 | procedure TBotORM.AddChatMember(aChat, aUser: Int64; aModerator: Boolean);
317 | begin
318 | opChatMembers.Entity.Chat:=aChat;
319 | opChatMembers.Entity.User:=aUser;
320 | opChatMembers.Entity.Moderator:=aModerator;
321 | opChatMembers.Add(False);
322 | end;
323 |
324 | procedure TBotORM.AddChatMembers(aChat: Int64; aModerator: Boolean; aUsers: TInt64List);
325 | var
326 | aUserID: Int64;
327 | begin
328 | for aUserID in aUsers do
329 | AddChatMember(aChat, aUserID, aModerator);
330 | opChatMembers.Apply;
331 | end;
332 |
333 | procedure TBotORM.AddComplaint(aComplainant, aInspectedChat: Int64; aInspectedMessage: Integer);
334 | begin
335 | with opComplaints do
336 | begin
337 | Entity.Chat:= aInspectedChat;
338 | Entity.Message:= aInspectedMessage;
339 | Entity.Complainant:=aComplainant;
340 | if Find('chat=:chat AND message=:message AND complainant=:complainant') then
341 | Exit;
342 | Add(True);
343 | Apply;
344 | Con.Logger.LogFmt(ltCustom, '#DebugInfo: сomplaint (chat #%d, message #%d, complainant #%d) has been added',
345 | [aInspectedChat, aInspectedMessage, aComplainant]);
346 | end;
347 | end;
348 |
349 | procedure TBotORM.ClearModeratorsForChat(aChat: Int64);
350 | var
351 | aChatMembers: TopfChatMembers.TEntities;
352 | aChatMember: TChatMember;
353 | begin
354 | aChatMembers:=TopfChatMembers.TEntities.Create();
355 | try
356 | GetModeratorsByChat(aChat, aChatMembers);
357 | for aChatMember in aChatMembers do
358 | opChatMembers.Remove(aChatMember);
359 | opChatMembers.Apply;
360 | finally
361 | aChatMembers.Free;
362 | end;
363 | end;
364 |
365 | { You must to notify administrators if there is no yet the inspected message
366 | or if a spam command is sending by patrol member }
367 | procedure TBotORM.GetNSaveMessage(const aInspectedUserName: String; aInspectedUser, aInspectedChat, aExecutor: Int64;
368 | aInspectedMessage: Integer; out aIsFirstComplaint: Boolean; aSpamStatus: Integer);
369 |
370 | procedure RetryAdd;
371 | begin
372 | Con.Logger.Log(ltCustom,
373 | 'GetNSaveMessage. Warning: the error occurred during connection. Try reconnecting again');
374 | Con.Connected:=False;
375 | Con.Connected:=True;
376 | opMessages.Add(False);
377 | end;
378 |
379 | begin
380 | aIsFirstComplaint:=not GetMessage(aInspectedChat, aInspectedMessage); // Notify if there is a first complaint
381 | { No need to save message if there is not a first complaint and SpamStatus is unknown }
382 | if not aIsFirstComplaint and (aSpamStatus=Message.IsSpam) then
383 | Exit;
384 | Message.User:=aInspectedUser;
385 | Message.IsSpam:=aSpamStatus;
386 | Message.Executor:=aExecutor;
387 | Message.UserName:=aInspectedUserName;
388 | if aIsFirstComplaint then
389 | try
390 | opMessages.Add(False)
391 | except
392 | on E: ESQLDatabaseError do
393 | if not CheckDisconnectErr(E.Message) then
394 | raise
395 | else
396 | RetryAdd;
397 | end
398 | else
399 | opMessages.Modify(False);
400 | opMessages.Apply;
401 | end;
402 |
403 | procedure TBotORM.AddMessage(const aInspectedUserName: String; aInspectedUser, aInspectedChat, aExecutor: Int64;
404 | aInspectedMessage: Integer; aSpamStatus: Integer);
405 | begin
406 | Message.Chat:= aInspectedChat;
407 | Message.Message:=aInspectedMessage;
408 | Message.User:=aInspectedUser;
409 | Message.IsSpam:=aSpamStatus;
410 | Message.Executor:=aExecutor;
411 | Message.UserName:=aInspectedUserName;
412 | opMessages.Add(False);
413 | opMessages.Apply;
414 | end;
415 |
416 | procedure TBotORM.ModifyMessage(aIsSpam: Boolean; aExecutor: Int64);
417 | begin
418 | if aIsSpam then
419 | Message.IsSpam:=_msSpam
420 | else
421 | Message.IsSpam:=_msNotSpam;
422 | Message.Executor:=aExecutor;
423 | opMessages.Modify(False);
424 | opMessages.Apply;
425 | end;
426 |
427 | constructor TBotORM.Create(aDBConf: TDBConf);
428 | begin
429 | FDBConfig:=aDBConf;
430 | FLogFileName:='db_sql.log';
431 | end;
432 |
433 | destructor TBotORM.Destroy;
434 | begin
435 | FopChatMembers.Free;
436 | FopComplaints.Free;
437 | FopMessages.Free;
438 | FopUsers.Free;
439 | FCon.Free;
440 | inherited Destroy;
441 | end;
442 |
443 | procedure TBotORM.UpdateRatings(aChatID: Int64; aMsgID: LongInt; aIsSpam: Boolean; aIsRollback: Boolean;
444 | aExecutor: Int64);
445 | var
446 | aComplaints: TopfComplaints.TEntities;
447 | aComplaint: TComplaint;
448 | aRate: Integer;
449 | aIsNew: Boolean;
450 | begin
451 | opComplaints.Entity.Chat:= aChatId;
452 | opComplaints.Entity.Message:=aMsgID;
453 | aComplaints:=TopfComplaints.TEntities.Create();
454 | try
455 | if opComplaints.Find(aComplaints, 'chat=:chat AND message=:message') then
456 | for aComplaint in aComplaints do
457 | begin
458 | aIsNew:=not GetUserByID(aComplaint.Complainant);
459 | aRate:=opUsers.Entity.Rate;
460 | if aIsSpam then
461 | begin
462 | if not aIsRollback then
463 | Inc(aRate)
464 | else begin
465 | Dec(aRate);
466 | { Zeroing guard rating }
467 | if aExecutor=aComplaint.Complainant then
468 | aRate:=0;
469 | end;
470 | end
471 | else begin
472 | if not aIsRollback then
473 | Dec(aRate, _Penalty)
474 | else
475 | Inc(aRate, _Penalty);
476 | end;
477 | opUsers.Entity.Rate:=aRate;
478 | SaveUser(aIsNew);
479 | end;
480 | finally
481 | aComplaints.Free;
482 | end;
483 | end;
484 | { We assign an Appearance only if it is 0 (not defined yet) }
485 | procedure TBotORM.SaveUserAppearance(aIsNew: Boolean);
486 | begin
487 | if opUsers.Entity.Appearance=0 then
488 | SaveUser(aIsNew);
489 | end;
490 |
491 | procedure TBotORM.SaveUserSpamStatus(aUserID: Int64; const aUserName: String; aIsSpammer: Boolean);
492 | var
493 | aIsNew: Boolean;
494 | begin
495 | aIsNew:=not GetUserByID(aUserID);
496 | User.Name:=aUserName;
497 | if aIsSpammer then
498 | opUsers.Entity.Spammer:=_msSpam
499 | else
500 | opUsers.Entity.Spammer:=_msNotSpam;
501 | SaveUser(aIsNew);
502 | end;
503 |
504 | procedure TBotORM.SaveUser(aIsNew: Boolean);
505 | begin
506 | if User.Appearance=0 then
507 | User.AppearanceAsDateTime:=Now;
508 | if aIsNew then
509 | opUsers.Add(False)
510 | else
511 | opUsers.Modify(False);
512 | opUsers.Apply;
513 | end;
514 |
515 | function TBotORM.GetUserByID(aUserID: Int64): Boolean;
516 | begin
517 | opUsers.Entity.ID:=aUserID;
518 | Result:=opUsers.Get();
519 | if not Result then
520 | opUsers.Entity.Clear;
521 | end;
522 |
523 | function TBotORM.IsModerator(aChat, aUser: Int64): Boolean;
524 | begin
525 | Result:=False;
526 | opChatMembers.Entity.Chat:=aChat;
527 | opChatMembers.Entity.User:=aUser;
528 | if opChatMembers.Get() then
529 | Result:=opChatMembers.Entity.Moderator;
530 | end;
531 |
532 | function TBotORM.ModifyMessageIfNotChecked(aIsSpam: Boolean; aExecutor: Int64): Boolean;
533 | begin
534 | Result:=Message.IsSpam=_msUnknown;
535 | if Result then
536 | ModifyMessage(aIsSpam, aExecutor);
537 | end;
538 |
539 | function TBotORM.GetMessage(aInspectedChat: Int64; aInspectedMessage: Integer): Boolean;
540 |
541 | function RetryGet: Boolean;
542 | begin
543 | Con.Logger.Log(ltCustom,
544 | 'GetMessage. Warning: the error occurred during connection. Try reconnecting again');
545 | Con.Connected:=False;
546 | Con.Connected:=True;
547 | Result:=opMessages.Get();
548 | end;
549 |
550 | begin
551 | Message.Chat:= aInspectedChat;
552 | Message.Message:=aInspectedMessage;
553 | try
554 | Result:= opMessages.Get();
555 | except
556 | on E: ESQLDatabaseError do
557 | if not CheckDisconnectErr(E.Message) then
558 | raise
559 | else
560 | Result:=RetryGet;
561 | end;
562 | if not Result then
563 | Message.Clear;
564 | end;
565 |
566 | procedure TBotORM.GetModeratorsByChat(aChat: Int64; aModerators: TopfChatMembers.TEntities);
567 | begin
568 | opChatMembers.Entity.Chat:=aChat;
569 | opChatMembers.Find(aModerators, 'chat=:chat');
570 | end;
571 |
572 | function TBotORM.UserByID(aUserID: Int64): TBotUser;
573 | begin
574 | GetUserByID(aUserID);
575 | Result:=opUsers.Entity;
576 | end;
577 |
578 | end.
579 |
580 |
--------------------------------------------------------------------------------
/src/adminhelperd.lpi:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 |
74 |
75 |
76 |
77 |
78 |
79 |
80 |
81 |
82 |
83 |
84 |
85 |
86 |
87 |
88 |
89 |
90 |
91 |
92 |
93 |
94 |
95 |
96 |
97 |
98 |
99 |
100 |
101 |
102 |
103 |
104 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 |
114 |
115 |
116 |
117 |
118 |
119 |
120 |
121 |
122 |
123 |
124 |
125 |
126 |
127 |
128 |
129 |
130 |
131 |
132 |
133 |
134 |
135 |
136 |
137 |
138 |
139 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
150 |
151 |
152 |
153 |
154 |
155 |
156 |
157 |
158 |
159 |
160 |
161 |
162 |
163 |
164 |
165 |
166 |
167 |
168 |
169 |
170 |
171 |
172 |
173 |
174 |
175 |
176 |
177 |
178 |
179 |
180 |
181 |
182 |
183 |
184 |
185 |
186 |
187 |
188 |
189 |
190 |
191 |
192 |
193 |
194 |
195 |
196 |
197 |
198 |
199 |
200 |
201 |
202 |
203 |
204 |
205 |
206 |
207 |
208 |
209 |
210 |
211 |
212 |
213 |
214 |
215 |
216 |
217 |
218 |
219 |
220 |
221 |
222 |
223 |
224 |
225 |
226 |
227 |
228 |
229 |
230 |
231 |
232 |
233 |
234 |
235 |
236 |
237 |
238 |
239 |
240 |
241 |
242 |
243 |
244 |
245 |
246 |
247 |
248 |
249 |
250 |
251 |
252 |
253 |
254 |
255 |
256 |
257 |
258 |
259 |
260 |
261 |
262 |
263 |
264 |
265 |
266 |
267 |
268 |
269 |
270 |
271 |
272 |
273 |
274 |
275 |
276 |
277 |
278 |
279 |
280 |
281 |
282 |
283 |
284 |
285 |
286 |
287 |
288 |
289 |
290 |
291 |
292 |
293 |
294 |
295 |
296 |
297 |
298 |
299 |
300 |
301 |
302 |
303 |
304 |
305 |
306 |
307 |
308 |
309 |
310 |
311 |
312 |
313 |
314 |
315 |
316 |
317 |
318 |
319 |
320 |
321 |
322 |
323 |
324 |
325 |
326 |
327 |
328 |
329 |
330 |
331 |
332 |
333 |
334 |
335 |
336 |
337 |
338 |
339 |
340 |
341 |
342 |
343 |
344 |
345 |
346 |
347 |
348 |
349 |
350 |
351 |
352 |
353 |
354 |
355 |
356 |
357 |
358 |
359 |
360 |
361 |
362 |
363 |
364 |
365 |
366 |
367 |
368 |
369 |
370 |
371 |
372 |
373 |
374 |
375 |
376 |
377 |
378 |
379 |
380 |
381 |
382 |
383 |
384 |
385 |
386 |
387 |
388 |
389 |
390 |
391 |
392 |
393 |
394 |
395 |
396 |
397 |
398 |
399 |
400 |
401 |
402 |
403 |
404 |
405 |
406 |
407 |
408 |
409 |
410 |
411 |
412 |
413 |
414 |
415 |
416 |
417 |
418 |
419 |
420 |
421 |
422 |
423 |
424 |
425 |
426 |
427 |
428 |
429 |
430 |
431 |
432 |
433 |
434 |
435 |
436 |
437 |
438 |
439 |
440 |
441 |
442 |
443 |
444 |
445 |
446 |
447 |
448 |
449 |
450 |
451 |
452 |
453 |
454 |
455 |
456 |
457 |
458 |
459 |
460 |
461 |
462 |
463 |
464 |
465 |
466 |
467 |
468 |
469 |
470 |
471 |
472 |
473 |
474 |
475 |
476 |
477 |
478 |
479 |
480 |
481 |
482 |
483 |
484 |
485 |
486 |
487 |
488 |
489 |
490 |
491 |
492 |
493 |
494 |
495 |
496 |
497 |
498 |
499 |
500 |
501 |
502 |
503 |
504 |
505 |
506 |
507 |
508 |
509 |
510 |
511 |
512 |
513 |
514 |
515 |
516 |
517 |
518 |
519 |
520 |
521 |
522 |
523 |
524 |
525 |
526 |
527 |
528 |
529 |
530 |
531 |
532 |
533 |
534 |
535 |
536 |
537 |
538 |
539 |
540 |
541 |
542 |
543 |
544 |
545 |
546 |
547 |
548 |
549 |
550 |
551 |
552 |
553 |
554 |
555 |
556 |
557 |
558 |
559 |
560 |
561 |
562 |
563 |
564 |
565 |
566 |
567 |
568 |
569 |
570 |
571 |
572 |
573 |
574 |
575 |
576 |
577 |
578 |
579 |
580 |
581 |
582 |
583 |
584 |
585 |
586 |
587 |
588 |
589 |
590 |
591 |
592 |
593 |
594 |
595 |
596 |
597 |
598 |
599 |
600 |
601 |
602 |
603 |
604 |
605 |
606 |
607 |
608 |
609 |
610 |
611 |
612 |
613 |
614 |
615 |
616 |
617 |
618 |
--------------------------------------------------------------------------------
/src/adminhelperd.lpr:
--------------------------------------------------------------------------------
1 | program adminhelperd;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | {$DEFINE THREADED}
6 |
7 | uses
8 | {$IF DEFINED(UNIX) AND DEFINED(THREADED)}
9 | CThreads,
10 | {$ENDIF}
11 | Interfaces, BrookApplication, BrookTardigradeBroker, actionadminhelper, adminhelper_conf, brokers,
12 | spamfilter_implementer, telegram_cmn
13 | ;
14 |
15 | {$R *.res}
16 |
17 | begin
18 | {$IFDEF THREADED}
19 | Application.Server.Threaded := True;
20 | {$ENDIF}
21 | Application.Server.ConnectionLimit:=1000;
22 | Application.Server.OnStart:=@(TSpamFilterRunner.ServerStart);
23 | Application.Server.OnStop:=@(TSpamFilterRunner.ServerStop);
24 | Application.Initialize;
25 | Application.Run;
26 | end.
27 |
--------------------------------------------------------------------------------
/src/brokers.pas:
--------------------------------------------------------------------------------
1 | unit brokers;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | BrookTardigradeBroker, BrookUtils, BrookFCLEventLogBroker, sysutils, mysql80conn
9 | ;
10 |
11 | implementation
12 |
13 | uses
14 | BrookHttpConsts, adminhelper_conf
15 | ;
16 |
17 | initialization
18 | BrookSettings.Port := Conf.Port;
19 | BrookSettings.Charset := BROOK_HTTP_CHARSET_UTF_8;
20 | BrookSettings.LogActive:=True;
21 |
22 | end.
23 |
--------------------------------------------------------------------------------
/src/db_schema.sql:
--------------------------------------------------------------------------------
1 | CREATE TABLE IF NOT EXISTS `chatmembers` (
2 | `chat` bigint NOT NULL,
3 | `user` bigint NOT NULL,
4 | `moderator` tinyint(1) NOT NULL,
5 | PRIMARY KEY (`chat`,`user`),
6 | KEY `chat` (`chat`)
7 | );
8 |
9 | CREATE TABLE IF NOT EXISTS `complaints` (
10 | `id` int NOT NULL AUTO_INCREMENT,
11 | `chat` bigint NOT NULL,
12 | `message` int NOT NULL,
13 | `complainant` bigint NOT NULL,
14 | PRIMARY KEY (`id`),
15 | KEY `chat` (`chat`,`message`) USING BTREE
16 | );
17 |
18 | CREATE TABLE IF NOT EXISTS `messages` (
19 | `chat` bigint NOT NULL,
20 | `message` int NOT NULL,
21 | `user` bigint NOT NULL,
22 | `executor` bigint NOT NULL,
23 | `isspam` int NOT NULL,
24 | `username` varchar(64) NOT NULL,
25 | PRIMARY KEY (`chat`,`message`)
26 | );
27 |
28 | CREATE TABLE IF NOT EXISTS `users` (
29 | `id` bigint NOT NULL,
30 | `appearance` bigint NOT NULL,
31 | `name` varchar(256) NOT NULL,
32 | `rate` int NOT NULL,
33 | `spammer` int NOT NULL,
34 | PRIMARY KEY (`id`)
35 | );
36 |
--------------------------------------------------------------------------------
/src/languages/adminhelperd.en.po:
--------------------------------------------------------------------------------
1 | msgid ""
2 | msgstr ""
3 | "Project-Id-Version: \n"
4 | "POT-Creation-Date: \n"
5 | "PO-Revision-Date: \n"
6 | "Last-Translator: \n"
7 | "Language-Team: \n"
8 | "Language: en\n"
9 | "MIME-Version: 1.0\n"
10 | "Content-Type: text/plain; charset=UTF-8\n"
11 | "Content-Transfer-Encoding: 8bit\n"
12 | "X-Generator: Poedit 3.5\n"
13 |
14 | #: actionadminhelper._sbnalrdyrlbck
15 | msgctxt "actionadminhelper._sbnalrdyrlbck"
16 | msgid "This ban action has already been rolled back"
17 | msgstr ""
18 |
19 | #: actionadminhelper._sbnrlbck
20 | msgctxt "actionadminhelper._sbnrlbck"
21 | msgid "The user's ban was rolled back: unbanning and rating returning "
22 | msgstr ""
23 |
24 | #: actionadminhelper._scmplnntisfldbybt
25 | msgctxt "actionadminhelper._scmplnntisfldbybt"
26 | msgid "The complaint is filed by the bot itself"
27 | msgstr ""
28 |
29 | #: actionadminhelper._scnfrmtnrlbckbn
30 | msgctxt "actionadminhelper._scnfrmtnrlbckbn"
31 | msgid "Do you think the ban was wrong? If the ban is rolled back, the complainant's rating will be downgraded and the inspected user who sent this message will be unbanned."
32 | msgstr ""
33 |
34 | #: actionadminhelper._sdbgspminf
35 | #, object-pascal-format
36 | msgctxt "actionadminhelper._sdbgspminf"
37 | msgid "Ln spam probability: %n, Ln ham probability: %n. Spam Factor: %n"
38 | msgstr ""
39 |
40 | #: actionadminhelper._shelptext
41 | msgctxt "actionadminhelper._shelptext"
42 | msgid "Help Text for TAdminHelper"
43 | msgstr ""
44 | "Group members notify administrators of spam messages themselves using the `/spam` command. \n"
45 | "The command should be sent in response to a spam message.\n"
46 | "All administrators receive a copy of the inspected message with the ability to check whether the member has correctly pointed to the spam message. \n"
47 | "If it is indeed a spam message, the member's rating is increased. \n"
48 | "At a certain number of points, spam messages are automatically deleted without the administrators' approval. \n"
49 | "If the inspected message is incorrectly identified as a spam, the member's rating is downgraded.\n"
50 | "In order for the bot to receive a list of administrators in a group or in case of deleting or adding a new one, it is necessary to send the `/update` command from any of the current administrators.\n"
51 | "Due to the fact that these commands are instantly deleted by the bot itself in the group, reports and updates occur unnoticed by users"
52 |
53 | #: actionadminhelper._sinspctdmsgwschckdot
54 | msgctxt "actionadminhelper._sinspctdmsgwschckdot"
55 | msgid "The message has already been verified"
56 | msgstr ""
57 |
58 | #: actionadminhelper._sspmbsemj
59 | msgid "It is identified as a spam based on emojies in the message"
60 | msgstr ""
61 |
62 | #: actionadminhelper._sstarttext
63 | msgctxt "actionadminhelper._sstarttext"
64 | msgid "Start Text for TAdminHelper"
65 | msgstr "The bot helps quickly and silently ban spammers. See details by /help command"
66 |
67 | #: actionadminhelper._syrrghts
68 | #, object-pascal-format
69 | msgctxt "actionadminhelper._syrrghts"
70 | msgid "Status: %s"
71 | msgstr ""
72 |
73 | #: actionadminhelper._syrrtng
74 | #, object-pascal-format
75 | msgctxt "actionadminhelper._syrrtng"
76 | msgid "Your rating is %d"
77 | msgstr ""
78 |
79 | #: telegram_cmn._sbndusr
80 | msgctxt "telegram_cmn._sbndusr"
81 | msgid "Banned user"
82 | msgstr ""
83 |
84 | #: telegram_cmn._scmplnnt
85 | msgctxt "telegram_cmn._scmplnnt"
86 | msgid "Complainant"
87 | msgstr ""
88 |
89 | #: telegram_cmn._sinspctdmsg
90 | msgctxt "telegram_cmn._sinspctdmsg"
91 | msgid "Inspected message"
92 | msgstr ""
93 |
94 | #: telegram_cmn._sinspctdmsghsdlt
95 | msgctxt "telegram_cmn._sinspctdmsghsdlt"
96 | msgid "The message was successfully deleted and the spammer was banned"
97 | msgstr ""
98 |
99 | #: telegram_cmn._sinspctdmsgisntspm
100 | msgctxt "telegram_cmn._sinspctdmsgisntspm"
101 | msgid "The message is marked as NOT spam. Erroneous complaint"
102 | msgstr ""
103 |
104 | #: telegram_cmn._sinspctdusr
105 | msgctxt "telegram_cmn._sinspctdusr"
106 | msgid "Inspected user"
107 | msgstr ""
108 |
109 | #: telegram_cmn._sisernsbn
110 | msgctxt "telegram_cmn._sisernsbn"
111 | msgid "Is this erroneous ban?"
112 | msgstr ""
113 |
114 | #: telegram_cmn._smybitsntspm
115 | msgctxt "telegram_cmn._smybitsntspm"
116 | msgid "\"Probably it's not a spam\". More info..."
117 | msgstr ""
118 |
119 | #: telegram_cmn._smybitsspm
120 | msgctxt "telegram_cmn._smybitsspm"
121 | msgid "\"Probably it's a spam\". More info..."
122 | msgstr ""
123 |
124 | #: telegram_cmn._sprvntvlybnd
125 | #, object-pascal-format
126 | msgctxt "telegram_cmn._sprvntvlybnd"
127 | msgid "The user #`%0:d` [%1:s](tg://user?id=%0:d) was preventively banned"
128 | msgstr ""
129 |
130 |
--------------------------------------------------------------------------------
/src/languages/adminhelperd.pot:
--------------------------------------------------------------------------------
1 | msgid ""
2 | msgstr "Content-Type: text/plain; charset=UTF-8"
3 |
4 | #: actionadminhelper._sbnalrdyrlbck
5 | msgctxt "actionadminhelper._sbnalrdyrlbck"
6 | msgid "This ban action has already been rolled back"
7 | msgstr ""
8 |
9 | #: actionadminhelper._sbnrlbck
10 | msgctxt "actionadminhelper._sbnrlbck"
11 | msgid "The user's ban was rolled back: unbanning and rating returning "
12 | msgstr ""
13 |
14 | #: actionadminhelper._scmplnntisfldbybt
15 | msgctxt "actionadminhelper._scmplnntisfldbybt"
16 | msgid "The complaint is filed by the bot itself"
17 | msgstr ""
18 |
19 | #: actionadminhelper._scnfrmtnrlbckbn
20 | msgctxt "actionadminhelper._scnfrmtnrlbckbn"
21 | msgid "Do you think the ban was wrong? If the ban is rolled back, the complainant's rating will be downgraded and the inspected user who sent this message will be unbanned."
22 | msgstr ""
23 |
24 | #: actionadminhelper._sdbgspminf
25 | #, object-pascal-format
26 | msgctxt "actionadminhelper._sdbgspminf"
27 | msgid "Ln spam probability: %n, Ln ham probability: %n. Spam Factor: %n"
28 | msgstr ""
29 |
30 | #: actionadminhelper._shelptext
31 | msgctxt "actionadminhelper._shelptext"
32 | msgid "Help Text for TAdminHelper"
33 | msgstr ""
34 |
35 | #: actionadminhelper._sinspctdmsgwschckdot
36 | msgctxt "actionadminhelper._sinspctdmsgwschckdot"
37 | msgid "The message has already been verified"
38 | msgstr ""
39 |
40 | #: actionadminhelper._sspmbsemj
41 | msgid "It is identified as a spam based on emojies in the message"
42 | msgstr ""
43 |
44 | #: actionadminhelper._sstarttext
45 | msgctxt "actionadminhelper._sstarttext"
46 | msgid "Start Text for TAdminHelper"
47 | msgstr ""
48 |
49 | #: actionadminhelper._syrrghts
50 | #, object-pascal-format
51 | msgctxt "actionadminhelper._syrrghts"
52 | msgid "Status: %s"
53 | msgstr ""
54 |
55 | #: actionadminhelper._syrrtng
56 | #, object-pascal-format
57 | msgctxt "actionadminhelper._syrrtng"
58 | msgid "Your rating is %d"
59 | msgstr ""
60 |
61 | #: telegram_cmn._sbndusr
62 | msgctxt "telegram_cmn._sbndusr"
63 | msgid "Banned user"
64 | msgstr ""
65 |
66 | #: telegram_cmn._scmplnnt
67 | msgctxt "telegram_cmn._scmplnnt"
68 | msgid "Complainant"
69 | msgstr ""
70 |
71 | #: telegram_cmn._sinspctdmsg
72 | msgctxt "telegram_cmn._sinspctdmsg"
73 | msgid "Inspected message"
74 | msgstr ""
75 |
76 | #: telegram_cmn._sinspctdmsghsdlt
77 | msgctxt "telegram_cmn._sinspctdmsghsdlt"
78 | msgid "The message was successfully deleted and the spammer was banned"
79 | msgstr ""
80 |
81 | #: telegram_cmn._sinspctdmsgisntspm
82 | msgctxt "telegram_cmn._sinspctdmsgisntspm"
83 | msgid "The message is marked as NOT spam. Erroneous complaint"
84 | msgstr ""
85 |
86 | #: telegram_cmn._sinspctdusr
87 | msgctxt "telegram_cmn._sinspctdusr"
88 | msgid "Inspected user"
89 | msgstr ""
90 |
91 | #: telegram_cmn._sisernsbn
92 | msgctxt "telegram_cmn._sisernsbn"
93 | msgid "Is this erroneous ban?"
94 | msgstr ""
95 |
96 | #: telegram_cmn._smybitsntspm
97 | msgctxt "telegram_cmn._smybitsntspm"
98 | msgid "\"Probably it's not a spam\". More info..."
99 | msgstr ""
100 |
101 | #: telegram_cmn._smybitsspm
102 | msgctxt "telegram_cmn._smybitsspm"
103 | msgid "\"Probably it's a spam\". More info..."
104 | msgstr ""
105 |
106 | #: telegram_cmn._sprvntvlybnd
107 | #, object-pascal-format
108 | msgctxt "telegram_cmn._sprvntvlybnd"
109 | msgid "The user #`%0:d` [%1:s](tg://user?id=%0:d) was preventively banned"
110 | msgstr ""
111 |
112 |
--------------------------------------------------------------------------------
/src/languages/adminhelperd.ru.po:
--------------------------------------------------------------------------------
1 | msgid ""
2 | msgstr ""
3 | "Project-Id-Version: \n"
4 | "POT-Creation-Date: \n"
5 | "PO-Revision-Date: \n"
6 | "Last-Translator: \n"
7 | "Language-Team: \n"
8 | "Language: ru\n"
9 | "MIME-Version: 1.0\n"
10 | "Content-Type: text/plain; charset=UTF-8\n"
11 | "Content-Transfer-Encoding: 8bit\n"
12 | "X-Generator: Poedit 3.5\n"
13 |
14 | #: actionadminhelper._sbnalrdyrlbck
15 | msgctxt "actionadminhelper._sbnalrdyrlbck"
16 | msgid "This ban action has already been rolled back"
17 | msgstr ""
18 |
19 | #: actionadminhelper._sbnrlbck
20 | msgctxt "actionadminhelper._sbnrlbck"
21 | msgid "The user's ban was rolled back: unbanning and rating returning "
22 | msgstr ""
23 |
24 | #: actionadminhelper._scmplnntisfldbybt
25 | msgctxt "actionadminhelper._scmplnntisfldbybt"
26 | msgid "The complaint is filed by the bot itself"
27 | msgstr ""
28 |
29 | #: actionadminhelper._scnfrmtnrlbckbn
30 | msgctxt "actionadminhelper._scnfrmtnrlbckbn"
31 | msgid "Do you think the ban was wrong? If the ban is rolled back, the complainant's rating will be downgraded and the inspected user who sent this message will be unbanned."
32 | msgstr ""
33 |
34 | #: actionadminhelper._sdbgspminf
35 | #, object-pascal-format
36 | msgctxt "actionadminhelper._sdbgspminf"
37 | msgid "Ln spam probability: %n, Ln ham probability: %n. Spam Factor: %n"
38 | msgstr ""
39 |
40 | #: actionadminhelper._shelptext
41 | msgctxt "actionadminhelper._shelptext"
42 | msgid "Help Text for TAdminHelper"
43 | msgstr ""
44 | "Бот помогает модерировать сообщения и быстро банить спамеров в группах. \n"
45 | "Участники группы сами уведомляют администраторов о спам сообщении с помощью команды `/spam`. \n"
46 | "Команду следует отправить в ответ на спам сообщение. \n"
47 | "Всем администраторам приходит копия сообщения с возможностью указания правильно ли участник указал на спам-сообщение. \n"
48 | "Если это действительно спам-сообщение, то рейтинг участника повышается. \n"
49 | "При определенном количестве баллов сообщение автоматически удаляется без одобрения администраторов. \n"
50 | "В случае неверного определения спам сообщения рейтинг участника понижается.\n"
51 | "Для того, чтобы бот получил список администраторов в группе или в случае удаления или добавления нового, следует любому из действующих администраторов отправить команду `/update`\n"
52 | "Благодаря тому, что эти команды мгновенно удаляются самим ботом в группе - репорты и обновления происходит незаметно для пользователей "
53 |
54 | #: actionadminhelper._sinspctdmsgwschckdot
55 | msgctxt "actionadminhelper._sinspctdmsgwschckdot"
56 | msgid "The message has already been verified"
57 | msgstr ""
58 |
59 | #: actionadminhelper._sspmbsemj
60 | msgid "It is identified as a spam based on emojies in the message"
61 | msgstr ""
62 |
63 | #: actionadminhelper._sstarttext
64 | msgctxt "actionadminhelper._sstarttext"
65 | msgid "Start Text for TAdminHelper"
66 | msgstr "Бот помогает быстро и бесшумно банить спамеров. Подробности можно узнать с помощью команды /help"
67 |
68 | #: actionadminhelper._syrrghts
69 | #, object-pascal-format
70 | msgctxt "actionadminhelper._syrrghts"
71 | msgid "Status: %s"
72 | msgstr "Статус: %s"
73 |
74 | #: actionadminhelper._syrrtng
75 | #, object-pascal-format
76 | msgctxt "actionadminhelper._syrrtng"
77 | msgid "Your rating is %d"
78 | msgstr "Ваш рейтинг %d"
79 |
80 | #: telegram_cmn._sbndusr
81 | msgctxt "telegram_cmn._sbndusr"
82 | msgid "Banned user"
83 | msgstr ""
84 |
85 | #: telegram_cmn._scmplnnt
86 | msgctxt "telegram_cmn._scmplnnt"
87 | msgid "Complainant"
88 | msgstr ""
89 |
90 | #: telegram_cmn._sinspctdmsg
91 | msgctxt "telegram_cmn._sinspctdmsg"
92 | msgid "Inspected message"
93 | msgstr ""
94 |
95 | #: telegram_cmn._sinspctdmsghsdlt
96 | msgctxt "telegram_cmn._sinspctdmsghsdlt"
97 | msgid "The message was successfully deleted and the spammer was banned"
98 | msgstr ""
99 |
100 | #: telegram_cmn._sinspctdmsgisntspm
101 | msgctxt "telegram_cmn._sinspctdmsgisntspm"
102 | msgid "The message is marked as NOT spam. Erroneous complaint"
103 | msgstr ""
104 |
105 | #: telegram_cmn._sinspctdusr
106 | msgctxt "telegram_cmn._sinspctdusr"
107 | msgid "Inspected user"
108 | msgstr ""
109 |
110 | #: telegram_cmn._sisernsbn
111 | msgctxt "telegram_cmn._sisernsbn"
112 | msgid "Is this erroneous ban?"
113 | msgstr ""
114 |
115 | #: telegram_cmn._smybitsntspm
116 | msgctxt "telegram_cmn._smybitsntspm"
117 | msgid "\"Probably it's not a spam\". More info..."
118 | msgstr ""
119 |
120 | #: telegram_cmn._smybitsspm
121 | msgctxt "telegram_cmn._smybitsspm"
122 | msgid "\"Probably it's a spam\". More info..."
123 | msgstr ""
124 |
125 | #: telegram_cmn._sprvntvlybnd
126 | #, object-pascal-format
127 | msgctxt "telegram_cmn._sprvntvlybnd"
128 | msgid "The user #`%0:d` [%1:s](tg://user?id=%0:d) was preventively banned"
129 | msgstr ""
130 |
131 |
--------------------------------------------------------------------------------
/src/spamfilter_implementer.pas:
--------------------------------------------------------------------------------
1 | unit spamfilter_implementer;
2 |
3 | {$mode ObjFPC}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | SysUtils, spamfilter_worker
9 | ;
10 |
11 | type
12 |
13 | { TSpamFilterRunner }
14 |
15 | TSpamFilterRunner = class
16 | public
17 | class procedure ServerStart({%H-}Sender: TObject);
18 | class procedure ServerStop({%H-}Sender: TObject);
19 | end;
20 |
21 | var
22 | _SpamFilterWorker: TSpamFilterThread = nil;
23 |
24 | implementation
25 |
26 | { TSpamFilterRunner }
27 |
28 | class procedure TSpamFilterRunner.ServerStart(Sender: TObject);
29 | begin
30 | _SpamFilterWorker:=TSpamFilterThread.Create;
31 | _SpamFilterWorker.Start;
32 | _SpamFilterWorker.Logger.Debug('Worker started');
33 | _SpamFilterWorker.Load;
34 | _SpamFilterWorker.Logger.Debug('Base loaded');
35 | end;
36 |
37 | class procedure TSpamFilterRunner.ServerStop(Sender: TObject);
38 | begin
39 | _SpamFilterWorker.Save;
40 | _SpamFilterWorker.TerminateWorker;
41 | _SpamFilterWorker.WaitFor;
42 | FreeAndNil(_SpamFilterWorker);
43 | end;
44 |
45 | end.
46 |
47 |
--------------------------------------------------------------------------------
/src/spamfilter_worker.pas:
--------------------------------------------------------------------------------
1 | unit spamfilter_worker;
2 |
3 | {$mode ObjFPC}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils, taskworker, spamfilter, tgsendertypes, tgtypes, adminhelper_orm, telegram_cmn
9 | ;
10 |
11 | type
12 |
13 | TFilterTaskCommand = (ftcNone, ftcTrain, ftcClassify, ftcLoad, ftcSave);
14 |
15 | { TSpamFilterTask }
16 |
17 | TSpamFilterTask = class
18 | private
19 | FComplainant: TTelegramUserObj;
20 | FInspectedChat: TTelegramChatObj;
21 | FInspectedMessage: String;
22 | FInspectedMessageID: Integer;
23 | FInspectedUser: TTelegramUserObj;
24 | FIsSpam: Boolean;
25 | FTaskCommand: TFilterTaskCommand;
26 | procedure SetComplainant(AValue: TTelegramUserObj);
27 | procedure SetInspectedChat(AValue: TTelegramChatObj);
28 | procedure SetInspectedUser(AValue: TTelegramUserObj);
29 | protected
30 | procedure Assign(aSrc: TCurrentEvent);
31 | procedure AssignTo(aDest: TCurrentEvent);
32 | public
33 | constructor Create(aTaskCommand: TFilterTaskCommand; aCurrentEvent: TCurrentEvent=nil; aIsSpam: Boolean = False);
34 | destructor Destroy; override;
35 | property InspectedMessage: String read FInspectedMessage write FInspectedMessage;
36 | property InspectedMessageID: Integer read FInspectedMessageID write FInspectedMessageID;
37 | { 3 properties below clone its value while assigning because asynchronous handling of the taskworker }
38 | property InspectedUser: TTelegramUserObj read FInspectedUser write SetInspectedUser;
39 | property InspectedChat: TTelegramChatObj read FInspectedChat write SetInspectedChat;
40 | property Complainant: TTelegramUserObj read FComplainant write SetComplainant;
41 | property IsSpam: Boolean read FIsSpam write FIsSpam;
42 | property TaskCommand: TFilterTaskCommand read FTaskCommand;
43 | end;
44 |
45 | TCustomSpamFilterThread = specialize TgTaskWorkerThread;
46 |
47 | { TSpamFilterThread }
48 |
49 | TSpamFilterThread = class(TCustomSpamFilterThread)
50 | private
51 | FBot: TTelegramSender;
52 | FBotORM: TBotORM;
53 | FSpamFilter: TSpamFilter;
54 | FCurrent: TCurrentEvent;
55 | protected
56 | procedure ProcessTask(aTask: TSpamFilterTask); override;
57 | property ORM: TBotORM read FBotORM;
58 | public
59 | constructor Create; override;
60 | destructor Destroy; override;
61 | procedure Classify(aCurrentEvent: TCurrentEvent);
62 | procedure Load;
63 | procedure Save;
64 | procedure Train(aCurrentEvent: TCurrentEvent; aIsSpam: Boolean);
65 | end;
66 |
67 | implementation
68 |
69 | uses
70 | adminhelper_conf, eventlog
71 | ;
72 |
73 | { TSpamFilterTask }
74 |
75 | procedure TSpamFilterTask.SetInspectedUser(AValue: TTelegramUserObj);
76 | begin
77 | if FInspectedUser=AValue then Exit;
78 | FreeAndNil(FInspectedUser);
79 | if Assigned(AValue) then
80 | FInspectedUser:=AValue.Clone;
81 | end;
82 |
83 | procedure TSpamFilterTask.Assign(aSrc: TCurrentEvent);
84 | begin
85 | if not Assigned(aSrc) then
86 | begin
87 | Complainant:= nil;
88 | InspectedChat:= nil;
89 | InspectedUser:= nil;
90 | InspectedMessage:= EmptyStr;
91 | InspectedMessageID:=0;
92 | Exit;
93 | end;
94 | Complainant:= aSrc.Complainant;
95 | InspectedChat:= aSrc.InspectedChat;
96 | InspectedUser:= aSrc.InspectedUser;
97 | InspectedMessage:= aSrc.InspectedMessage;
98 | InspectedMessageID:=aSrc.InspectedMessageID;
99 | end;
100 |
101 | procedure TSpamFilterTask.AssignTo(aDest: TCurrentEvent);
102 | begin
103 | aDest.Complainant:= Complainant;
104 | aDest.InspectedChat:= InspectedChat;
105 | aDest.InspectedUser:= InspectedUser;
106 | aDest.InspectedMessage:= InspectedMessage;
107 | aDest.InspectedMessageID:=InspectedMessageID;
108 | end;
109 |
110 | constructor TSpamFilterTask.Create(aTaskCommand: TFilterTaskCommand; aCurrentEvent: TCurrentEvent; aIsSpam: Boolean);
111 | begin
112 | Assign(aCurrentEvent);
113 | FIsSpam:=aIsSpam;
114 | FTaskCommand:=aTaskCommand;
115 | end;
116 |
117 | destructor TSpamFilterTask.Destroy;
118 | begin
119 | FComplainant.Free;
120 | FInspectedChat.Free;
121 | FInspectedUser.Free;
122 | inherited Destroy;
123 | end;
124 |
125 | procedure TSpamFilterTask.SetComplainant(AValue: TTelegramUserObj);
126 | begin
127 | if FComplainant=AValue then Exit;
128 | FreeAndNil(FComplainant);
129 | if Assigned(AValue) then
130 | FComplainant:=AValue.Clone;
131 | end;
132 |
133 | procedure TSpamFilterTask.SetInspectedChat(AValue: TTelegramChatObj);
134 | begin
135 | if FInspectedChat=AValue then Exit;
136 | FreeAndNil(FInspectedChat);
137 | if Assigned(AValue) then
138 | FInspectedChat:=AValue.Clone;
139 | end;
140 |
141 | { TSpamFilterThread }
142 |
143 | procedure TSpamFilterThread.ProcessTask(aTask: TSpamFilterTask);
144 | begin
145 | try
146 | try
147 | aTask.AssignTo(FCurrent);
148 | case aTask.FTaskCommand of
149 | ftcTrain: FCurrent.TrainFromMessage(FSpamFilter, aTask.IsSpam);
150 | ftcClassify: FCurrent.ClassifyMessage(FSpamFilter);
151 | ftcLoad: FSpamFilter.Load;
152 | ftcSave: FSpamFilter.Save;
153 | end;
154 | finally
155 | aTask.Free;
156 | end;
157 | except
158 | on E: Exception do Logger.Error('ProcessTask. '+E.ClassName+': '+E.Message);
159 | end;
160 | end;
161 |
162 | constructor TSpamFilterThread.Create;
163 | begin
164 | inherited Create;
165 |
166 | FBot:=TTelegramSender.Create(Conf.AdminHelperBot.Telegram.Token);
167 | FBot.BotUsername:=Conf.AdminHelperBot.Telegram.UserName;
168 | FBot.Logger:=Logger;
169 | FBot.Logger.LogType:=ltFile;
170 | FBot.Logger.AppendContent:=True;
171 | FBot.BotUsername:=Conf.AdminHelperBot.Telegram.UserName;
172 | FBot.Logger.FileName:=IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0)))+'spamfilter.log';
173 | FBot.LogDebug:=Conf.AdminHelperBot.Debug;
174 |
175 | FBotORM:=TBotORM.Create(Conf.AdminHelperDB);
176 | FBotORM.LogFileName:='worker_db_sql.log';
177 |
178 | FCurrent:=TCurrentEvent.Create(FBot, ORM);
179 |
180 | FSpamFilter:=TSpamFilter.Create;
181 | FSpamFilter.StorageDir:=ConfDir;
182 | FSpamFilter.InitialSpamMessage:='crypto';
183 | FSpamFilter.InitialHamMessage:='lazarus and FreePascal/Pascal';
184 | end;
185 |
186 | destructor TSpamFilterThread.Destroy;
187 | begin
188 | FSpamFilter.Free;
189 | FCurrent.Free;
190 | FBotORM.Free;
191 | FBot.Free;
192 | inherited Destroy;
193 | end;
194 |
195 | procedure TSpamFilterThread.Classify(aCurrentEvent: TCurrentEvent);
196 | begin
197 | PushTask(TSpamFilterTask.Create(ftcClassify, aCurrentEvent));
198 | end;
199 |
200 | procedure TSpamFilterThread.Load;
201 | begin
202 | PushTask(TSpamFilterTask.Create(ftcLoad));
203 | end;
204 |
205 | procedure TSpamFilterThread.Save;
206 | begin
207 | PushTask(TSpamFilterTask.Create(ftcSave));
208 | end;
209 |
210 | procedure TSpamFilterThread.Train(aCurrentEvent: TCurrentEvent; aIsSpam: Boolean);
211 | begin
212 | PushTask(TSpamFilterTask.Create(ftcTrain, aCurrentEvent, aIsSpam));
213 | end;
214 |
215 | end.
216 |
217 |
--------------------------------------------------------------------------------
/src/telegram_cmn.pas:
--------------------------------------------------------------------------------
1 | unit telegram_cmn;
2 |
3 | {$mode ObjFPC}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils, tgtypes, tgsendertypes, adminhelper_orm, spamfilter
9 | ;
10 |
11 | type
12 |
13 | { TCurrentEvent }
14 |
15 | TCurrentEvent = class
16 | private
17 | FBot: TTelegramSender;
18 | FComplainant: TTelegramUserObj;
19 | FBotORM: TBotORM;
20 | FEmojiMarker: Boolean;
21 | FInspectedChat: TTelegramChatObj;
22 | FInspectedMessage: String;
23 | FInspectedMessageID: Integer;
24 | FInspectedUser: TTelegramUserObj;
25 | FSpamProbability, FHamProbability: Double;
26 | protected
27 | property Bot: TTelegramSender read FBot;
28 | property ORM: TBotORM read FBotORM;
29 | public
30 | procedure AssignInspectedFromMsg(aMessage: TTelegramMessageObj);
31 | procedure BanOrNotToBan(aInspectedChat, aInspectedUser: Int64; const aInspectedUserName: String;
32 | aInspectedMessage: LongInt; aIsSpam: Boolean);
33 | constructor Create(aBot: TTelegramSender; aBotORM: TBotORM);
34 | procedure ProcessComplaint(aCanBeSilentBan: Boolean; aSpamStatus: Integer);
35 | function IsGroup: Boolean;
36 | procedure ClassifyMessage(aSpamFilter: TSpamFilter);
37 | procedure TrainFromMessage(aSpamFilter: TSpamFilter; aIsSpam: Boolean);
38 | function SpamFactor: Double;
39 | procedure SendMessagesToAdmins(aIsDefinitlySpam: Boolean; aIsPreventively: Boolean = False);
40 | procedure SendToModerator(aModerator: Int64; aIsDefinitelySpam, aIsPreventively: Boolean;
41 | var aIsUserPrivacy: Boolean);
42 | property InspectedChat: TTelegramChatObj read FInspectedChat write FInspectedChat;
43 | property InspectedUser: TTelegramUserObj read FInspectedUser write FInspectedUser;
44 | property InspectedMessage: String read FInspectedMessage write FInspectedMessage;
45 | property InspectedMessageID: Integer read FInspectedMessageID write FInspectedMessageID;
46 | property Complainant: TTelegramUserObj read FComplainant write FComplainant;
47 | property SpamProbability: Double read FSpamProbability write FSpamProbability;
48 | property HamProbability: Double read FHamProbability write FHamProbability;
49 | property EmojiMarker: Boolean read FEmojiMarker write FEmojiMarker;
50 | end;
51 |
52 | function RouteCmdSpamLastChecking(aChat: Int64; aMsg: Integer; IsConfirmation: Boolean): String;
53 | function RouteMsgUsrPrvcy: String;
54 | function RouteMsgCmplnntIsBt(): String;
55 | function RouteMsgPrbblySpm(aSpamProbability, aHamProbability: Double; aIsEmojiMarker: Boolean = False): String;
56 |
57 | const
58 | _sBtnPair='%s: %s';
59 | _dTgUsrUrl='tg://user?id=%d';
60 | _tgErrBtnUsrPrvcyRstrctd='Bad Request: BUTTON_USER_PRIVACY_RESTRICTED';
61 | _dtUsrPrvcy='UsrPrvcy';
62 | _dtCmplnntIsBt='CmplnntIsBt';
63 | _dtPrbblySpm='PrbblySpm';
64 | _dSpm = 'spam';
65 | _dtR= 'r'; // rollback ban action
66 | _dtRC='rc'; // confirmation of rollback ban action
67 |
68 | resourcestring
69 | _sInspctdUsr='Inspected user';
70 | _sBndUsr= 'Banned user';
71 |
72 | implementation
73 |
74 | uses
75 | StrUtils, tgutils, adminhelper_conf, emojiutils
76 | ;
77 |
78 | resourcestring
79 | _sPrvntvlyBnd= 'The user #`%0:d` [%1:s](tg://user?id=%0:d) was preventively banned';
80 | _sInspctdMsg= 'Inspected message';
81 | _sCmplnnt= 'Complainant';
82 | _sIsErnsBn= 'Is this erroneous ban?';
83 | _sMybItsSpm= '"Probably it''s a spam". More info...';
84 | _sMybItsNtSpm= '"Probably it''s not a spam". More info...';
85 | _sInspctdMsgHsDlt= 'The message was successfully deleted and the spammer was banned';
86 | _sInspctdMsgIsNtSpm= 'The message is marked as NOT spam. Erroneous complaint';
87 |
88 | const
89 | _emjbot='🤖';
90 | _emjInfrmtn='ℹ️';
91 |
92 | var
93 | _sBtnBtCmplnnt: String;
94 |
95 |
96 | function RouteCmdSpam(aChat: Int64; aMsg: Integer; IsSpam: Boolean): String;
97 | begin
98 | Result:=_dSpm+' '+aChat.ToString+' '+aMsg.ToString+' '+IsSpam.ToString;
99 | end;
100 |
101 | function RouteCmdSpamLastChecking(aChat: Int64; aMsg: Integer; IsConfirmation: Boolean): String;
102 | var
103 | aSym: String;
104 | begin
105 | if IsConfirmation then
106 | aSym:=_dtRC
107 | else
108 | aSym:=_dtR;
109 | Result:=_dSpm+' '+aChat.ToString+' '+aMsg.ToString+' '+aSym;
110 | end;
111 |
112 | function RouteMsgUsrPrvcy: String;
113 | begin
114 | Result:='m'+' '+_dtUsrPrvcy;
115 | end;
116 |
117 | function RouteMsgCmplnntIsBt(): String;
118 | begin
119 | Result:='m'+' '+_dtCmplnntIsBt;
120 | end;
121 |
122 | function RouteMsgPrbblySpm(aSpamProbability, aHamProbability: Double; aIsEmojiMarker: Boolean): String;
123 | begin
124 | Result:='m'+' '+_dtPrbblySpm+' '+aSpamProbability.ToString+' '+aHamProbability.ToString;
125 | if aIsEmojiMarker then
126 | Result+=' '+'emj';
127 | end;
128 |
129 | function BuildMsgUrl(aChat: TTelegramChatObj; aMsgID: Integer): String;
130 | const
131 | _ChatIDPrefix='-100';
132 | var
133 | aTpl, aChatName: String;
134 | begin
135 | aChatName:=aChat.Username;
136 | if aChatName.IsEmpty then
137 | begin
138 | aChatName:=aChat.ID.ToString;
139 | if StartsStr(_ChatIDPrefix, aChatName) then
140 | aChatName:=RightStr(aChatName, Length(aChatName)-Length(_ChatIDPrefix))
141 | else
142 | Exit('https://t.me/'); { #todo : Maybe other handling? }
143 | aTpl:='https://t.me/c/%s/%d';
144 | end
145 | else
146 | aTpl:='https://t.me/%s/%d';
147 | Result:=Format(aTpl, [aChatName, aMsgID]);
148 | end;
149 |
150 | { TCurrentEvent }
151 |
152 | procedure TCurrentEvent.AssignInspectedFromMsg(aMessage: TTelegramMessageObj);
153 | begin
154 | FInspectedMessage:=aMessage.Text;
155 | if FInspectedMessage.IsEmpty then
156 | FInspectedMessage:=aMessage.Caption;
157 | FInspectedChat:=aMessage.Chat;
158 | FInspectedUser:=aMessage.From;
159 | FInspectedMessageID:=aMessage.MessageId;
160 | end;
161 |
162 | procedure TCurrentEvent.BanOrNotToBan(aInspectedChat, aInspectedUser: Int64; const aInspectedUserName: String;
163 | aInspectedMessage: LongInt; aIsSpam: Boolean);
164 | var
165 | aMsg: String;
166 | begin
167 | ORM.UpdateRatings(aInspectedChat, aInspectedMessage, aIsSpam);
168 | if aIsSpam then
169 | begin
170 | Bot.deleteMessage(aInspectedChat, aInspectedMessage);
171 | Bot.banChatMember(aInspectedChat, aInspectedUser);
172 | ORM.SaveUserSpamStatus(aInspectedUser, aInspectedUserName);
173 | aMsg:=_sInspctdMsgHsDlt;
174 | end
175 | else begin
176 | ORM.SaveUserSpamStatus(aInspectedUser, aInspectedUserName, False);
177 | aMsg:=_sInspctdMsgIsNtSpm;
178 | end;
179 | if Assigned(Bot.CurrentUser) then
180 | Bot.sendMessage(Bot.CurrentUser.ID, aMsg);
181 | end;
182 |
183 | constructor TCurrentEvent.Create(aBot: TTelegramSender; aBotORM: TBotORM);
184 | begin
185 | FBot:=aBot;
186 | FBotORM:=aBotORM;
187 | inherited Create;
188 | end;
189 |
190 | procedure TCurrentEvent.ProcessComplaint(aCanBeSilentBan: Boolean; aSpamStatus: Integer);
191 | var
192 | aInspectedUserName: String;
193 | aIsFirstComplaint: Boolean;
194 | aComplainant: Int64;
195 | begin
196 | aInspectedUserName:=CaptionFromUser(InspectedUser);
197 | if Assigned(Complainant) then
198 | aComplainant:=Complainant.ID
199 | else
200 | aComplainant:=0;
201 | ORM.GetNSaveMessage(aInspectedUserName, InspectedUser.ID, InspectedChat.ID, aComplainant, InspectedMessageID,
202 | aIsFirstComplaint, aSpamStatus);
203 | if aIsFirstComplaint then
204 | if not aCanBeSilentBan then
205 | SendMessagesToAdmins(aSpamStatus=_msSpam);
206 | if Assigned(Complainant) then
207 | ORM.AddComplaint(aComplainant, InspectedChat.ID, InspectedMessageID);
208 | if aSpamStatus=_msSpam then
209 | BanOrNotToBan(InspectedChat.ID, InspectedUser.ID, aInspectedUserName, InspectedMessageID, True);
210 | end;
211 |
212 | function TCurrentEvent.IsGroup: Boolean;
213 | begin
214 | Result:=Assigned(FInspectedUser) and (FInspectedUser.ID<>FInspectedChat.ID)
215 | end;
216 |
217 | procedure TCurrentEvent.ClassifyMessage(aSpamFilter: TSpamFilter);
218 | var
219 | aSpamStatus: Integer;
220 | begin
221 | FEmojiMarker:=False;
222 | if CountEmojis(InspectedMessage)Conf.SpamFilter.DefinitelySpam then
226 | aSpamStatus:=_msSpam
227 | else
228 | aSpamStatus:=_msUnknown;
229 | end
230 | else begin
231 | FHamProbability:=0;
232 | FSpamProbability:=0;
233 | FEmojiMarker:=True;
234 | aSpamStatus:=_msSpam;
235 | end;
236 | ProcessComplaint(False, aSpamStatus);
237 | end;
238 |
239 | procedure TCurrentEvent.TrainFromMessage(aSpamFilter: TSpamFilter; aIsSpam: Boolean);
240 | begin
241 | aSpamFilter.Train(InspectedMessage, aIsSpam);
242 | end;
243 |
244 | function TCurrentEvent.SpamFactor: Double;
245 | begin
246 | Result:=FSpamProbability-FHamProbability;
247 | end;
248 |
249 | procedure TCurrentEvent.SendMessagesToAdmins(aIsDefinitlySpam: Boolean; aIsPreventively: Boolean);
250 | var
251 | aChatMembers: TopfChatMembers.TEntities;
252 | aIsUserPrivacy: Boolean;
253 | aChatMember: TChatMember;
254 | begin
255 | aChatMembers:=TopfChatMembers.TEntities.Create;
256 | try
257 | ORM.GetModeratorsByChat(FInspectedChat.ID, aChatMembers);
258 | aIsUserPrivacy:=False;
259 | for aChatMember in aChatMembers do
260 | if aChatMember.Moderator then
261 | SendToModerator(aChatMember.User, aIsDefinitlySpam, aIsPreventively, aIsUserPrivacy);
262 | finally
263 | aChatMembers.Free;
264 | end;
265 | end;
266 |
267 | procedure TCurrentEvent.SendToModerator(aModerator: Int64; aIsDefinitelySpam, aIsPreventively: Boolean;
268 | var aIsUserPrivacy: Boolean);
269 | var
270 | aReplyMarkup: TReplyMarkup;
271 | aKB: TInlineKeyboard;
272 | aInspctdUsr, aCmplnnt, s: String;
273 | begin
274 | aReplyMarkup:=TReplyMarkup.Create;
275 | try
276 | aKB:=aReplyMarkup.CreateInlineKeyBoard;
277 | if aIsDefinitelySpam then
278 | begin
279 | aInspctdUsr:= Format(_sBtnPair, [_sBndUsr, CaptionFromUser(InspectedUser)]);
280 | if Assigned(Complainant) then
281 | aCmplnnt:=Format(_sBtnPair, [_sCmplnnt, CaptionFromUser(Complainant)])
282 | else
283 | aCmplnnt:=_sBtnBtCmplnnt;
284 | if aIsUserPrivacy then
285 | begin
286 | aKB.Add.AddButton(aInspctdUsr, RouteMsgUsrPrvcy);
287 | if Assigned(Complainant) then
288 | aKB.Add.AddButton(aCmplnnt, RouteMsgUsrPrvcy)
289 | else
290 | aKB.Add.AddButton(aCmplnnt, RouteMsgCmplnntIsBt);
291 | end
292 | else begin
293 | aKB.Add.AddButtonUrl(aInspctdUsr, Format(_dTgUsrUrl, [FInspectedUser.ID]));
294 | if Assigned(Complainant) then
295 | aKB.Add.AddButtonUrl(aCmplnnt, Format(_dTgUsrUrl, [FComplainant.ID]))
296 | else
297 | aKB.Add.AddButton(aCmplnnt, RouteMsgCmplnntIsBt);
298 | end;
299 | if not aIsPreventively then
300 | aKB.Add.AddButton(_sIsErnsBn,
301 | RouteCmdSpamLastChecking(InspectedChat.ID, InspectedMessageID, True))
302 | end
303 | else begin
304 | aKB.Add.AddButtons(
305 | ['It is spam', RouteCmdSpam(InspectedChat.ID, InspectedMessageID, True),
306 | 'It isn''t spam!', RouteCmdSpam(InspectedChat.ID, InspectedMessageID, False)]
307 | );
308 | aKB.Add.AddButtonUrl(_sInspctdMsg, BuildMsgUrl(InspectedChat, InspectedMessageID));
309 | aInspctdUsr:=Format(_sBtnPair, [_sInspctdUsr, CaptionFromUser(InspectedUser)]);
310 | if aIsUserPrivacy then
311 | aKB.Add.AddButton(aInspctdUsr, RouteMsgUsrPrvcy)
312 | else
313 | aKB.Add.AddButtonUrl(aInspctdUsr, Format(_dTgUsrUrl, [InspectedUser.ID]));
314 | if not Assigned(Complainant) then
315 | aKB.Add.AddButton(_sBtnBtCmplnnt, RouteMsgCmplnntIsBt);
316 | end;
317 | if not (Assigned(Complainant) or aIsPreventively) then
318 | begin
319 | s:=_emjInfrmtn+' ';
320 | if (SpamFactor>0) or EmojiMarker then
321 | s+= _sMybItsSpm
322 | else
323 | s+=_sMybItsNtSpm;
324 | aKB.Add.AddButton(s, RouteMsgPrbblySpm(SpamProbability, HamProbability, EmojiMarker));
325 | end;
326 | if aIsPreventively then
327 | Bot.sendMessage(aModerator, Format(_sPrvntvlyBnd, [InspectedUser.ID,
328 | CaptionFromUser(InspectedUser)]), pmMarkdown, aIsDefinitelySpam, aReplyMarkup)
329 | else
330 | Bot.copyMessage(aModerator, InspectedChat.ID, InspectedMessageID, aIsDefinitelySpam, aReplyMarkup);
331 | finally
332 | aReplyMarkup.Free;
333 | end;
334 | if not aIsUserPrivacy then
335 | begin
336 | aIsUserPrivacy:=(Bot.LastErrorCode=400) and ContainsStr(Bot.LastErrorDescription, _tgErrBtnUsrPrvcyRstrctd);
337 | if aIsUserPrivacy then
338 | SendToModerator(aModerator, aIsDefinitelySpam, aIsPreventively, aIsUserPrivacy);
339 | end;
340 | end;
341 |
342 | initialization
343 | _sBtnBtCmplnnt:=Format(_emjbot+' '+_sBtnPair, [_sCmplnnt, 'the bot']);
344 |
345 | end.
346 |
347 |
--------------------------------------------------------------------------------