├── .gitignore ├── LICENSE.md ├── NsfwBox.deployproj ├── NsfwBox.dpr ├── NsfwBox.dproj ├── README.md ├── assets ├── Kisspeace-NsfwBox-icon.ico ├── android-icons │ ├── Kisspeace-NsfwBox-icon.svg │ ├── nsfwbox144.png │ ├── nsfwbox192.png │ ├── nsfwbox36.png │ ├── nsfwbox48.png │ ├── nsfwbox72.png │ └── nsfwbox96.png ├── fmxstyle.style ├── github │ ├── screenshot_1.jpg │ ├── screenshot_2.jpg │ └── screenshot_3.jpg ├── themes │ ├── dark.json │ ├── default.json │ └── default │ │ ├── add.png │ │ ├── app-icon.png │ │ ├── bookmarks.png │ │ ├── cartoons.png │ │ ├── content-origin--1.png │ │ ├── content-origin--2.png │ │ ├── content-origin-0.png │ │ ├── content-origin-1.png │ │ ├── content-origin-2.png │ │ ├── content-origin-3.png │ │ ├── content-origin-4.png │ │ ├── content-origin-5.png │ │ ├── copy.png │ │ ├── current-tab.png │ │ ├── delete.png │ │ ├── download.png │ │ ├── downloads.png │ │ ├── edit.png │ │ ├── gay.png │ │ ├── heterosexual.png │ │ ├── image.png │ │ ├── menu.png │ │ ├── new-tab.png │ │ ├── next.png │ │ ├── play.png │ │ ├── readme.md │ │ ├── repair.png │ │ ├── save.png │ │ ├── search.png │ │ ├── settings.png │ │ ├── tab-close.png │ │ ├── tag.png │ │ ├── transgender.png │ │ └── video.png └── windows.style ├── libs ├── libsqliteX.so └── readme.md └── source ├── DbHelper.pas ├── FMX.Color.pas ├── FMX.Scroller.pas ├── NetHttpClient.Downloader.pas ├── NsfwBox.MessageForDeveloper.pas ├── NsfwBox.UpdateChecker.pas ├── NsfwBoxBookmarks.pas ├── NsfwBoxContentScraper.pas ├── NsfwBoxDownloadManager.pas ├── NsfwBoxFileSystem.pas ├── NsfwBoxGraphics.Browser.pas ├── NsfwBoxGraphics.Rectangle.pas ├── NsfwBoxGraphics.pas ├── NsfwBoxHelper.pas ├── NsfwBoxInterfaces.pas ├── NsfwBoxOrigin9hentaiToApi.pas ├── NsfwBoxOriginBookmarks.pas ├── NsfwBoxOriginConst.pas ├── NsfwBoxOriginCoomerParty.pas ├── NsfwBoxOriginGivemepornClub.pas ├── NsfwBoxOriginNsfwXxx.pas ├── NsfwBoxOriginPseudo.pas ├── NsfwBoxOriginR34App.pas ├── NsfwBoxOriginR34JsonApi.pas ├── NsfwBoxSettings.pas ├── NsfwBoxStyling.pas ├── NsfwBoxThreading.pas ├── SimpleClipboard.pas ├── Unit1.fmx ├── Unit1.pas ├── Unit2.pas └── bookmarks-db.sql /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.apk 36 | *.drc 37 | *.map 38 | *.dres 39 | *.rsm 40 | *.tds 41 | *.dcu 42 | *.lib 43 | *.a 44 | *.o 45 | *.ocx 46 | 47 | # Delphi autogenerated files (duplicated info) 48 | *.cfg 49 | *.hpp 50 | *Resource.rc 51 | 52 | # Delphi local files (user-specific info) 53 | *.local 54 | *.identcache 55 | *.projdata 56 | *.tvsconfig 57 | *.dsk 58 | 59 | # Delphi history and backups 60 | __history/ 61 | __recovery/ 62 | *.~* 63 | 64 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 65 | *.stat 66 | 67 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 68 | modules/ 69 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 Kisspeace 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 | -------------------------------------------------------------------------------- /NsfwBox.dpr: -------------------------------------------------------------------------------- 1 | program NsfwBox; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | Unit1 in 'source\Unit1.pas' {Form1}, 7 | NsfwBoxSettings in 'source\NsfwBoxSettings.pas', 8 | NsfwBoxInterfaces in 'source\NsfwBoxInterfaces.pas', 9 | NsfwBoxOriginNsfwXxx in 'source\NsfwBoxOriginNsfwXxx.pas', 10 | NsfwBoxOriginR34JsonApi in 'source\NsfwBoxOriginR34JsonApi.pas', 11 | NsfwBoxOriginR34App in 'source\NsfwBoxOriginR34App.pas', 12 | NsfwBoxContentScraper in 'source\NsfwBoxContentScraper.pas', 13 | NsfwBoxGraphics in 'source\NsfwBoxGraphics.pas', 14 | NsfwBoxOriginPseudo in 'source\NsfwBoxOriginPseudo.pas', 15 | NsfwBoxGraphics.Browser in 'source\NsfwBoxGraphics.Browser.pas', 16 | NsfwBoxOriginConst in 'source\NsfwBoxOriginConst.pas', 17 | NsfwBoxStyling in 'source\NsfwBoxStyling.pas', 18 | NsfwBoxGraphics.Rectangle in 'source\NsfwBoxGraphics.Rectangle.pas', 19 | Unit2 in 'source\Unit2.pas', 20 | NsfwBoxDownloadManager in 'source\NsfwBoxDownloadManager.pas', 21 | NsfwBoxBookmarks in 'source\NsfwBoxBookmarks.pas', 22 | DbHelper in 'source\DbHelper.pas', 23 | NsfwBoxHelper in 'source\NsfwBoxHelper.pas', 24 | NsfwBoxOriginBookmarks in 'source\NsfwBoxOriginBookmarks.pas', 25 | NetHttpClient.Downloader in 'source\NetHttpClient.Downloader.pas', 26 | Fmx.Scroller in 'source\Fmx.Scroller.pas', 27 | NsfwBoxFileSystem in 'source\NsfwBoxFileSystem.pas', 28 | FMX.Color in 'source\FMX.Color.pas', 29 | SimpleClipboard in 'source\SimpleClipboard.pas', 30 | NsfwBoxThreading in 'source\NsfwBoxThreading.pas', 31 | NsfwBoxOriginGivemepornClub in 'source\NsfwBoxOriginGivemepornClub.pas', 32 | NsfwBoxOrigin9hentaiToApi in 'source\NsfwBoxOrigin9hentaiToApi.pas', 33 | NsfwBox.UpdateChecker in 'source\NsfwBox.UpdateChecker.pas', 34 | NsfwBox.MessageForDeveloper in 'source\NsfwBox.MessageForDeveloper.pas', 35 | NsfwBoxOriginCoomerParty in 'source\NsfwBoxOriginCoomerParty.pas'; 36 | 37 | {$R *.res} 38 | 39 | begin 40 | // GlobalUseSkia := True; 41 | Application.Initialize; 42 | Application.FormFactor.Orientations := [TFormOrientation.Portrait, TFormOrientation.InvertedPortrait, TFormOrientation.Landscape, TFormOrientation.InvertedLandscape]; 43 | Application.CreateForm(TForm1, Form1); 44 | Application.Run; 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 |

NsfwBox

2 | 3 | ![written_on](https://img.shields.io/badge/_-RAD_Studio-darkcyan?style=for-the-badge&logo=delphi) 4 | ![Platforms](https://img.shields.io/badge/Android-1A2541?style=for-the-badge&logo=android&logoColor=white) 5 | ![Platforms](https://img.shields.io/badge/Windows-1A2541?style=for-the-badge&logo=windows) 6 | ![Downloads](https://img.shields.io/github/downloads/kisspeace/NsfwBox/total?style=for-the-badge&labelColor=1A2541) 7 |

8 | 9 | Native android and windows app for download content from porn sites. 10 | Developed on RAD Studio 11 Alexandria. 11 | 12 | #### Censored screenshots: 13 |
14 | 15 | 16 | 17 |
18 | 19 | #### Supported sites / APIs: 20 | * [nsfw.xxx](https://nsfw.xxx), [pornpic.xxx](https://pornpic.xxx/), [hdporn.pics](https://hdporn.pics/) 21 | * [r34.app](https://r34.app) 22 | * [Rule34 Json API](https://github.com/KuroZen/r34-json-api) 23 | * [givemeporn.club](https://givemeporn.club/) 24 | * [kemono.party](https://kemono.party), [coomer.party](https://coomer.party) 25 | 26 | #### Dependencies: 27 | * [Alcinoe](https://github.com/Zeus64/alcinoe) 28 | * [ZeosLib 8.0](https://sourceforge.net/p/zeoslib/code-0/HEAD/tree/branches/8.0-patches/) 29 | * [x-superobject](https://github.com/onryldz/x-superobject) 30 | * [HTMLp](https://github.com/RomanYankovsky/HTMLp) 31 | * [delphi-r34.app-api-wrapper](https://github.com/Kisspeace/delphi-r34.app-api-wrapper) 32 | * [delphi-r34-json-api-wrapper](https://github.com/Kisspeace/delphi-r34-json-api-wrapper) 33 | * [delphi-nsfw.xxx-scraper](https://github.com/Kisspeace/delphi-nsfw.xxx-scraper) 34 | * [delphi-givemeporn.club-scraper](https://github.com/Kisspeace/delphi-givemeporn.club-scraper) 35 | * [delphi-9hentai.to-api-wrapper](https://github.com/Kisspeace/delphi-9hentai.to-api-wrapper) 36 | * [coomer.party-scraper](https://github.com/Kisspeace/coomer.party-scraper) 37 | 38 | #### Download last release: 39 | [![download](https://img.shields.io/badge/Android_(64--bit)-1A2541?style=for-the-badge&logo=android&logoColor=white)](https://github.com/Kisspeace/NsfwBox/releases/download/v1.2.0/Kisspeace.NsfwBox.v1.2.0.apk) 40 | [![download](https://img.shields.io/badge/Windows_(32--bit)-1A2541?style=for-the-badge&logo=windows)](https://github.com/Kisspeace/NsfwBox/releases/download/v1.2.0/Kisspeace.NsfwBox-ins32.v1.2.0.exe) 41 | [![download](https://img.shields.io/badge/Windows_(64--bit)-1A2541?style=for-the-badge&logo=windows)](https://github.com/Kisspeace/NsfwBox/releases/download/v1.2.0/Kisspeace.NsfwBox-ins64.v1.2.0.exe) 42 | -------------------------------------------------------------------------------- /assets/Kisspeace-NsfwBox-icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/Kisspeace-NsfwBox-icon.ico -------------------------------------------------------------------------------- /assets/android-icons/Kisspeace-NsfwBox-icon.svg: -------------------------------------------------------------------------------- 1 | 2 | 21 | 23 | 26 | 30 | 34 | 35 | 44 | 45 | 70 | 72 | 73 | 75 | image/svg+xml 76 | 78 | 79 | 80 | 81 | 82 | 86 | 92 | 99 | 106 | 107 | 108 | -------------------------------------------------------------------------------- /assets/android-icons/nsfwbox144.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/android-icons/nsfwbox144.png -------------------------------------------------------------------------------- /assets/android-icons/nsfwbox192.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/android-icons/nsfwbox192.png -------------------------------------------------------------------------------- /assets/android-icons/nsfwbox36.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/android-icons/nsfwbox36.png -------------------------------------------------------------------------------- /assets/android-icons/nsfwbox48.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/android-icons/nsfwbox48.png -------------------------------------------------------------------------------- /assets/android-icons/nsfwbox72.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/android-icons/nsfwbox72.png -------------------------------------------------------------------------------- /assets/android-icons/nsfwbox96.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/android-icons/nsfwbox96.png -------------------------------------------------------------------------------- /assets/github/screenshot_1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/github/screenshot_1.jpg -------------------------------------------------------------------------------- /assets/github/screenshot_2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/github/screenshot_2.jpg -------------------------------------------------------------------------------- /assets/github/screenshot_3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/github/screenshot_3.jpg -------------------------------------------------------------------------------- /assets/themes/default/add.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/add.png -------------------------------------------------------------------------------- /assets/themes/default/app-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/app-icon.png -------------------------------------------------------------------------------- /assets/themes/default/bookmarks.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/bookmarks.png -------------------------------------------------------------------------------- /assets/themes/default/cartoons.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/cartoons.png -------------------------------------------------------------------------------- /assets/themes/default/content-origin--1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/content-origin--1.png -------------------------------------------------------------------------------- /assets/themes/default/content-origin--2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/content-origin--2.png -------------------------------------------------------------------------------- /assets/themes/default/content-origin-0.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/content-origin-0.png -------------------------------------------------------------------------------- /assets/themes/default/content-origin-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/content-origin-1.png -------------------------------------------------------------------------------- /assets/themes/default/content-origin-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/content-origin-2.png -------------------------------------------------------------------------------- /assets/themes/default/content-origin-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/content-origin-3.png -------------------------------------------------------------------------------- /assets/themes/default/content-origin-4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/content-origin-4.png -------------------------------------------------------------------------------- /assets/themes/default/content-origin-5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/content-origin-5.png -------------------------------------------------------------------------------- /assets/themes/default/copy.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/copy.png -------------------------------------------------------------------------------- /assets/themes/default/current-tab.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/current-tab.png -------------------------------------------------------------------------------- /assets/themes/default/delete.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/delete.png -------------------------------------------------------------------------------- /assets/themes/default/download.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/download.png -------------------------------------------------------------------------------- /assets/themes/default/downloads.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/downloads.png -------------------------------------------------------------------------------- /assets/themes/default/edit.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/edit.png -------------------------------------------------------------------------------- /assets/themes/default/gay.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/gay.png -------------------------------------------------------------------------------- /assets/themes/default/heterosexual.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/heterosexual.png -------------------------------------------------------------------------------- /assets/themes/default/image.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/image.png -------------------------------------------------------------------------------- /assets/themes/default/menu.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/menu.png -------------------------------------------------------------------------------- /assets/themes/default/new-tab.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/new-tab.png -------------------------------------------------------------------------------- /assets/themes/default/next.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/next.png -------------------------------------------------------------------------------- /assets/themes/default/play.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/play.png -------------------------------------------------------------------------------- /assets/themes/default/readme.md: -------------------------------------------------------------------------------- 1 | #### Icons from: 2 | * [flaticon.com](https://www.flaticon.com) 3 | * [icons8.com](https://icons8.com) 4 | -------------------------------------------------------------------------------- /assets/themes/default/repair.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/repair.png -------------------------------------------------------------------------------- /assets/themes/default/save.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/save.png -------------------------------------------------------------------------------- /assets/themes/default/search.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/search.png -------------------------------------------------------------------------------- /assets/themes/default/settings.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/settings.png -------------------------------------------------------------------------------- /assets/themes/default/tab-close.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/tab-close.png -------------------------------------------------------------------------------- /assets/themes/default/tag.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/tag.png -------------------------------------------------------------------------------- /assets/themes/default/transgender.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/transgender.png -------------------------------------------------------------------------------- /assets/themes/default/video.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/themes/default/video.png -------------------------------------------------------------------------------- /assets/windows.style: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/assets/windows.style -------------------------------------------------------------------------------- /libs/libsqliteX.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/XXX-porn-stuff/NsfwBox/20db7227ed724fd3d79aa8bba14ad1b9a0bc6b55/libs/libsqliteX.so -------------------------------------------------------------------------------- /libs/readme.md: -------------------------------------------------------------------------------- 1 | **libsqliteX.so** - SQLite lib for Android x64, Downloaded from [sqlite.org](https://sqlite.org/download.html) 2 | -------------------------------------------------------------------------------- /source/DbHelper.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit DbHelper; 3 | 4 | interface 5 | uses 6 | ZConnection, DB, classes, system.sysutils, 7 | ZDataset, System.IOUtils, NsfwBoxFilesystem; 8 | 9 | type 10 | 11 | TDbHelper = class(TObject) 12 | protected 13 | Query: TZQuery; 14 | procedure SetFilename(const value: string); 15 | function GetFilename: string; 16 | function BaseExists: boolean; 17 | procedure CreateBase; virtual; abstract; 18 | public 19 | Connection: TZConnection; 20 | property Filename: string read GetFilename write SetFilename; 21 | constructor Create(ADbFilename: string); virtual; 22 | destructor Destroy; virtual; 23 | end; 24 | 25 | implementation 26 | 27 | { TDbListManager } 28 | 29 | function TDbHelper.BaseExists: boolean; 30 | begin 31 | Result := FileExists(Connection.Database); 32 | end; 33 | 34 | constructor TDbHelper.Create(ADbFilename: string); 35 | begin 36 | Connection := TZConnection.Create(nil); 37 | Query := TZQuery.Create(nil); 38 | Query.Connection := Connection; 39 | 40 | with Connection do begin 41 | {$IFDEF ANDROID} 42 | Connection.LibraryLocation := TNBoxPath.GetLibPath('libsqliteX.so'); 43 | {$ENDIF} 44 | Protocol := 'sqlite'; 45 | ClientCodepage := 'UTF-8'; 46 | Database := ADbFilename; 47 | Password := ''; 48 | User := ''; 49 | end; 50 | 51 | if not BaseExists then begin 52 | Connection.Connect; 53 | CreateBase; 54 | end; 55 | end; 56 | 57 | destructor TDbHelper.Destroy; 58 | begin 59 | if connection.Connected then 60 | Connection.Disconnect; 61 | Connection.Free; 62 | Query.Free; 63 | end; 64 | 65 | function TDbHelper.GetFilename: string; 66 | begin 67 | Result := Connection.Database; 68 | end; 69 | 70 | procedure TDbHelper.SetFilename(const value: string); 71 | begin 72 | Connection.Database := Value; 73 | end; 74 | 75 | end. 76 | -------------------------------------------------------------------------------- /source/FMX.Color.pas: -------------------------------------------------------------------------------- 1 | unit FMX.Color; 2 | 3 | interface 4 | uses 5 | System.classes, System.uitypes, system.SysUtils; 6 | 7 | function GetColor(R, G, B: Byte; A: byte = 255): TAlphaColor; 8 | function GetRandomColor(AAlpha: boolean): TAlphaColor; overload; 9 | Function GetRandomColor(AAlpha: boolean; ABrightness: byte): TAlphaColor; overload; 10 | function ChangeBrightnessColor(AColor: TAlphaColor; AValue: byte): TAlphaColor; 11 | function BGRToHex(AColor: TAlphaColor): string; 12 | function ABGRToHex(Acolor: TAlphaColor): string; 13 | 14 | implementation 15 | 16 | function BgrToHex(Acolor: TAlphaColor): string; 17 | begin 18 | Result := 19 | Inttohex(TAlphaColorRec(AColor).B, 1) + 20 | Inttohex(TAlphaColorRec(AColor).G, 1) + 21 | Inttohex(TAlphaColorRec(AColor).R, 1) 22 | ; 23 | end; 24 | 25 | function AbgrToHex(Acolor: TAlphaColor): string; 26 | begin 27 | result := Inttohex(TAlphaColorRec(AColor).A, 1) + BGRToHex(AColor); 28 | end; 29 | 30 | function GetColor(R, G, B: Byte; A: byte = 255): TAlphaColor; 31 | begin 32 | TAlphaColorRec(Result).R := R; 33 | TAlphaColorRec(Result).G := G; 34 | TAlphaColorRec(Result).B := B; 35 | TAlphaColorRec(Result).A := A; 36 | end; 37 | 38 | 39 | function GetRandomColor(AAlpha: boolean): TAlphaColor; 40 | begin 41 | Result := GetColor(Random(256), Random(256), Random(256)); 42 | if AAlpha then 43 | TAlphaColorRec(Result).A := Random(256); 44 | end; 45 | 46 | Function GetRandomColor(AAlpha: boolean; ABrightness: byte): TAlphaColor; 47 | begin 48 | Result := GetColor(Random(ABrightness), Random(ABrightness), Random(ABrightness)); 49 | if AAlpha then 50 | TAlphaColorRec(Result).A := Random(256); 51 | end; 52 | 53 | function ChangeBrightnessColor(AColor: TAlphaColor; AValue: byte): TAlphaColor; 54 | var 55 | R, G, B: byte; 56 | begin 57 | R := TAlphaColorRec(AColor).R; 58 | G := TAlphaColorRec(AColor).G; 59 | B := TAlphaColorRec(AColor).B; 60 | 61 | if R < AValue then AValue := R; 62 | if G < AValue then AValue := G; 63 | if B < AValue then AValue := B; 64 | 65 | Result := GetColor(R - AValue, G - AValue, B - AValue, TAlphaColorRec(AColor).A); 66 | end; 67 | 68 | end. 69 | -------------------------------------------------------------------------------- /source/FMX.Scroller.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | // Maybe rewrite this classes later 3 | unit Fmx.Scroller; 4 | 5 | interface 6 | 7 | uses 8 | System.SysUtils, System.Types, System.UITypes, System.Classes, 9 | System.Variants, Fmx.Layouts, FMX.Controls, Fmx.Types; 10 | 11 | type 12 | 13 | TMultiLayout = Class(TLayout) 14 | private 15 | FIndent: Single; 16 | FPlusHeight: Single; 17 | FBlockPos: integer; 18 | procedure FsetIndent(A: single); virtual; 19 | procedure FSetPlusHeight(A: single); virtual; 20 | procedure FSetBlockCount(A: cardinal); virtual; 21 | function FGetBlockCount: Cardinal; 22 | function FAddBlock: Tlayout; virtual; 23 | protected 24 | procedure Resize; override; 25 | public 26 | AutoCalculateHeight: boolean; 27 | PlaceItemBySize: boolean; 28 | HeightMultiplier: single; 29 | Blocks: TControlList; 30 | function GetControls: TControlList; 31 | Function GetItemWidth: Single; 32 | procedure AddControl(AControl: Tcontrol); 33 | procedure UpdateItemHeight; virtual; 34 | procedure UpdateBlocks; virtual; 35 | procedure ReCalcBlocksSize; virtual; 36 | procedure UpdateHeight; virtual; 37 | function GetMinBlock: TControl; 38 | property PlusHeight: single Read FPlusHeight write FSetPlusHeight; 39 | property LayoutIndent: Single read Findent write FsetIndent; 40 | property BlockCount: cardinal Read FGetBlockCount write FSetblockCount; 41 | property BlockPos: integer read FBlockPos write FBlockPos; 42 | Constructor Create(Aowner: Tcomponent); overload; override; 43 | Constructor Create(Aowner: Tcomponent; AblockCount: cardinal); overload; 44 | Destructor Destroy; override; 45 | end; 46 | 47 | TMultiLayoutScroller = Class(TVertScrollbox) 48 | private 49 | procedure FSetLayoutIndent(A: single); 50 | function FGetLayoutIndent: Single; 51 | public 52 | MultiLayout: TmultiLayout; 53 | property LayoutIndent: Single read FGetLayoutIndent write FSetLayoutIndent; 54 | constructor Create(Aowner: Tcomponent); override; 55 | destructor Destroy; override; 56 | End; 57 | 58 | procedure _ReExtendHeight(Acontrol: Tcontrol); 59 | 60 | implementation 61 | 62 | procedure _deleteNilControls(Acontrols: TcontrolList); 63 | var 64 | i: integer; 65 | b: boolean; 66 | begin 67 | b := true; 68 | while b do begin 69 | b := false; 70 | for i := 0 to acontrols.Count - 1 do begin 71 | if Acontrols.Items[i] = nil then begin 72 | b := true; 73 | acontrols.Delete(i); 74 | break; 75 | end; 76 | end; 77 | end; 78 | end; 79 | 80 | //procedure _FreeControls(AControls:TcontrolList); 81 | //var 82 | //i: integer; 83 | //begin 84 | //if Acontrols.Count < 1 then 85 | //exit; 86 | //for i := 0 to acontrols.Count - 1 do begin 87 | //Acontrols.Items[0].Free; 88 | //end; 89 | //end; 90 | 91 | function _GetHighest(Acontrols: TcontrolList):integer; 92 | var 93 | i, N: integer; 94 | H: single; 95 | begin 96 | Result := -1; 97 | 98 | if Acontrols.Count < 1 then 99 | exit; 100 | 101 | N := 0; 102 | H := Acontrols.First.Height; 103 | 104 | for I := 1 to Acontrols.Count - 1 do begin 105 | if Acontrols.Items[i].Height > H then begin 106 | H := Acontrols.Items[i].Height; 107 | N := i; 108 | end; 109 | end; 110 | 111 | Result := N; 112 | end; 113 | 114 | function _GetHeight(AControl: TControl):single; 115 | begin 116 | Result := AControl.Height + AControl.Margins.Top + AControl.Margins.Bottom; 117 | end; 118 | 119 | procedure _ReExtendHeight(Acontrol: Tcontrol); 120 | var 121 | i: integer; 122 | H: single; 123 | begin 124 | H := 0; 125 | for i := 0 to acontrol.Controls.Count - 1 do begin 126 | H := H + _GetHeight(Acontrol.Controls.Items[i]); 127 | end; 128 | Acontrol.Height := H; 129 | end; 130 | 131 | procedure _ExtendHeight(Acontrol: Tcontrol); 132 | var 133 | H: single; 134 | begin 135 | H := Acontrol.Height + _GetHeight(Acontrol.Controls.Last); 136 | acontrol.Height := H; 137 | end; 138 | 139 | Constructor TMultiLayout.Create(Aowner: Tcomponent); 140 | begin 141 | inherited create(aowner); 142 | FblockPos := 0; 143 | Blocks := Tcontrollist.Create; 144 | end; 145 | 146 | Constructor TMultiLayout.Create(Aowner: Tcomponent; AblockCount:cardinal); 147 | begin 148 | Create(Aowner); 149 | BlockCount := AblockCount; 150 | end; 151 | 152 | function TMultiLayout.GetControls:TControlList; 153 | var 154 | i: integer; 155 | begin 156 | result := Tcontrollist.Create; 157 | for i := 0 to blockcount - 1 do begin 158 | result.AddRange(Blocks.Items[i].Controls); 159 | end; 160 | end; 161 | 162 | Function TMultiLayout.GetItemWidth:Single; 163 | begin 164 | Result := (self.Width / controls.Count) - self.FIndent; 165 | end; 166 | 167 | procedure TMultiLayout.AddControl(AControl: Tcontrol); 168 | var 169 | Block: Tcontrol; 170 | begin 171 | if (FblockPos >= blocks.Count) then 172 | FblockPos := 0; 173 | 174 | if self.PlaceItemBySize then 175 | Block := GetMinBlock 176 | else 177 | Block := blocks.Items[FBlockPos]; 178 | 179 | with AControl do begin 180 | parent := block; 181 | Position.Y := block.Height; 182 | Align := talignlayout.Top; 183 | if self.AutoCalculateHeight then begin 184 | acontrol.Height := self.GetItemWidth * self.HeightMultiplier; 185 | end; 186 | end; 187 | 188 | if Block.Controlscount = 1 then begin 189 | _ReExtendHeight(block); 190 | end else 191 | _ExtendHeight(Block); 192 | 193 | self.UpdateHeight; 194 | inc(self.FBlockPos); 195 | end; 196 | 197 | procedure TMultiLayout.UpdateItemHeight; 198 | var 199 | i: integer; 200 | ctrls: Tcontrollist; 201 | begin 202 | if self.AutoCalculateHeight then begin 203 | ctrls := self.GetControls; 204 | if ctrls.Count < 1 then 205 | exit; 206 | 207 | for I := 0 to ctrls.Count - 1 do begin 208 | with ctrls.Items[i] do begin 209 | height := width * self.HeightMultiplier; 210 | end; 211 | end; 212 | end; 213 | end; 214 | 215 | procedure TMultiLayout.ReCalcBlocksSize; 216 | var 217 | I: integer; 218 | begin 219 | if Blocks.Count < 1 then 220 | exit; 221 | for I := 0 to Blocks.Count - 1 do begin 222 | _ReExtendHeight(Blocks.Items[i]); 223 | end; 224 | self.UpdateHeight; 225 | end; 226 | 227 | function TMultiLayout.GetMinBlock: Tcontrol; 228 | var 229 | i: integer; 230 | begin 231 | Result := nil; 232 | if self.Blocks.Count < 1 then 233 | exit; 234 | Result := Blocks.Items[0]; 235 | for I := 0 to self.Blocks.Count - 1 do begin 236 | if self.Blocks.Items[i].Height < result.Height then begin 237 | result := self.Blocks.Items[i]; 238 | end; 239 | end; 240 | 241 | end; 242 | 243 | procedure TMultiLayout.UpdateHeight; 244 | var 245 | N: integer; 246 | begin 247 | N := _GetHighest(blocks); 248 | self.Height := blocks.Items[n].Height + Fplusheight; 249 | end; 250 | 251 | procedure TmultiLayout.UpdateBlocks; 252 | var 253 | i: integer; 254 | W, X, P: single; 255 | begin 256 | if blocks.Count < 1 then 257 | exit; 258 | 259 | W := (self.Width / blocks.Count); 260 | X := 0; 261 | 262 | P := LayoutIndent / 2; 263 | 264 | for i := 0 to (blocks.Count - 1) do begin 265 | with Blocks.Items[i] do begin 266 | Width := W; 267 | Padding.Left := P; 268 | Padding.Right := P; 269 | position.X := X; 270 | X := X + W; 271 | end; 272 | end; 273 | 274 | blocks.First.Padding.Left := P * 2; 275 | blocks.Last.Padding.Right := P * 2; 276 | end; 277 | 278 | procedure TMultiLayout.FsetIndent(A: single); 279 | begin 280 | FIndent := A; 281 | self.UpdateBlocks; 282 | end; 283 | 284 | procedure TMultiLayout.FSetPlusHeight(A: single); 285 | begin 286 | FPlusheight := A; 287 | self.ReCalcBlocksSize; 288 | end; 289 | 290 | function TMultiLayout.FGetBlockCount:Cardinal; 291 | begin 292 | Result := blocks.Count; 293 | end; 294 | 295 | procedure TMultiLayout.FSetBlockCount(A: cardinal); 296 | var 297 | I: integer; 298 | cntrls: TcontrolList; 299 | begin 300 | if A = self.blockCount then exit; 301 | 302 | cntrls := GetControls; 303 | if cntrls.Count > 0 then begin 304 | for i := 0 to cntrls.Count - 1 do begin 305 | cntrls.Items[i].Parent := nil; 306 | end; 307 | end; 308 | 309 | if blockcount > 0 then begin 310 | for i := 0 to blocks.Count - 1 do begin 311 | blocks.Items[i].Free; 312 | end; 313 | end; 314 | blocks.Clear; 315 | 316 | for i := 1 to A do begin 317 | self.FAddBlock; 318 | end; 319 | 320 | if cntrls.Count > 0 then begin 321 | for i := 0 to cntrls.Count - 1 do begin 322 | self.AddControl(cntrls.Items[i]); 323 | end; 324 | end; 325 | 326 | self.FBlockPos := 0; 327 | self.UpdateBlocks; 328 | Cntrls.Free; 329 | end; 330 | 331 | function TMultiLayout.FAddBlock:Tlayout; 332 | var 333 | L: Tlayout; 334 | block: Tcontrol; 335 | Pos: single; 336 | begin 337 | if blocks.Count > 0 then begin 338 | block := blocks.Last; 339 | Pos := block.Position.X + block.Width; 340 | end else 341 | pos := 0; 342 | 343 | L := tlayout.Create(self); 344 | L.Parent := self; 345 | L.Position.Y := 0; 346 | L.Position.X := Pos; 347 | 348 | Result := L; 349 | Blocks.Add(L); 350 | end; 351 | 352 | destructor TMultiLayout.Destroy; 353 | begin 354 | //_freeControls(self.Controls); 355 | blocks.Free; 356 | inherited Destroy; 357 | end; 358 | 359 | procedure TMultiLayout.Resize; 360 | begin 361 | self.UpdateBlocks; 362 | UpdateItemHeight; 363 | self.ReCalcBlocksSize; 364 | end; 365 | 366 | constructor TMultiLayoutScroller.Create(Aowner:Tcomponent); 367 | begin 368 | inherited create(Aowner); 369 | MultiLayout := tmultilayout.Create(Self); 370 | MultiLayout.Parent := self; 371 | Multilayout.Align := Talignlayout.Top; 372 | end; 373 | 374 | 375 | procedure TMultiLayoutScroller.FSetLayoutIndent(A:single); 376 | begin 377 | self.MultiLayout.LayoutIndent := A; 378 | end; 379 | 380 | function TMultiLayoutScroller.FGetLayoutIndent:Single; 381 | begin 382 | Result := self.MultiLayout.LayoutIndent; 383 | end; 384 | 385 | destructor TMultiLayoutScroller.destroy; 386 | begin 387 | Multilayout.Free; 388 | inherited destroy; 389 | end; 390 | 391 | end. 392 | -------------------------------------------------------------------------------- /source/NetHttpClient.Downloader.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NetHttpClient.Downloader; 3 | 4 | interface 5 | uses 6 | System.Net.URLClient, System.Net.HttpClient, System.SyncObjs, 7 | System.Net.HttpClientComponent, SysUtils, classes, System.Threading; 8 | 9 | type 10 | 11 | TCreateWebClientEvent = procedure(const Sender: TObject; AWebClient: TNetHttpClient) of object; 12 | 13 | TDownloader = Class(TComponent) 14 | protected 15 | FTask: ITask; 16 | FLock: TCriticalSection; 17 | FIsRunning: boolean; 18 | FIsAborted: boolean; 19 | FAsynchronous: boolean; 20 | FSynchronizeEvents: boolean; 21 | FAutoRetry: boolean; 22 | FRetriedCount: int64; 23 | FRetryTimeout: int64; // Milliseconds Timeout before retry 24 | FStream: TStream; // ContentStream 25 | FUrl: string; 26 | FLostConnectionCount: int64; 27 | FContentLength: int64; 28 | FReadCount: int64; 29 | procedure DoOnFinish; virtual; 30 | procedure DoOnSendData(const Sender: TObject; AContentLength: Int64; AWriteCount: Int64; var AAbort: Boolean); 31 | procedure DoOnReceiveData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var AAbort: Boolean); virtual; 32 | private 33 | FOnRecievData: TReceiveDataEvent; 34 | FOnSendData: TSendDataEvent; 35 | FOnRequestException: TRequestExceptionEvent; 36 | FOnFinish: TNotifyEvent; 37 | FOnCreateWebClient: TCreateWebClientEvent; 38 | procedure SafeSet(var AVar: boolean; ANew: boolean); overload; 39 | procedure SafeSet(var AVar: string; ANew: string); overload; 40 | procedure SafeSet(var AVar: int64; ANew: int64); overload; 41 | function SafeGet(var AVar: boolean): boolean; overload; 42 | function SafeGet(var AVar: string): string; overload; 43 | function SafeGet(var AVar: int64): int64; overload; 44 | //--setters getters-- 45 | function GetIsRunning: boolean; 46 | function GetIsAborted: boolean; 47 | procedure SetIsAborted(const Value: boolean); 48 | function GetAutoRetry: boolean; 49 | procedure SetAutoRetry(const Value: boolean); 50 | function GetRetryTimeout: int64; 51 | procedure SetRetryTimeout(const Value: int64); 52 | function GetUrl: string; 53 | procedure SetUrl(const Value: string); 54 | function GetReadCount: int64; 55 | procedure SetReadCount(const Value: int64); 56 | function GetContentLength: int64; 57 | procedure SetContentLength(const Value: int64); 58 | function GetSynchronizeEvents: boolean; 59 | procedure SetSynchronizeEvents(const Value: boolean); 60 | function GetRetriedCount: int64; 61 | public 62 | procedure Start; virtual; 63 | procedure AbortRequest; 64 | property Stream: TStream read FStream write FStream; 65 | property IsRunning: boolean read GetIsRunning; 66 | property IsAborted: boolean read GetIsAborted write SetIsAborted; 67 | property AutoRetry: boolean read GetAutoRetry write SetAutoRetry; 68 | property RetriedCount: int64 read GetRetriedCount; 69 | property RetryTimeout: int64 read GetRetryTimeout write SetRetryTimeout; 70 | property SynchronizeEvents: boolean read GetSynchronizeEvents write SetSynchronizeEvents; 71 | property Url: string read GetUrl write SetUrl; 72 | property ReadCount: int64 read GetReadCount write SetReadCount; 73 | property ContentLength: int64 read GetContentLength write SetContentLength; 74 | property OnReceiveData: TReceiveDataEvent read FOnRecievData write FOnRecievData; 75 | property OnSendData: TSendDataEvent read FOnSendData write FOnSendData; 76 | property OnRequestException: TRequestExceptionEvent read FOnRequestException write FOnRequestException; 77 | property OnCreateWebClient: TCreateWebClientEvent read FOnCreateWebClient write FOnCreateWebClient; 78 | property OnFinish: TNotifyEvent read FOnFinish write FOnFinish; 79 | Constructor Create(AOwner: TComponent); 80 | Destructor Destroy; override; 81 | End; 82 | 83 | TFileDownloader = class(TDownloader) 84 | protected 85 | FFilename: string; 86 | procedure DoOnFinish; override; 87 | private 88 | procedure SetFilename(const Value: string); 89 | function GetFilename: string; 90 | public 91 | procedure Start; override; 92 | property Filename: string read GetFilename write SetFilename; 93 | end; 94 | 95 | TNetHttpDownloader = TFileDownloader; 96 | 97 | implementation 98 | 99 | { TDownloader } 100 | 101 | procedure TDownloader.AbortRequest; 102 | begin 103 | IsAborted := true; 104 | end; 105 | 106 | constructor TDownloader.Create(AOwner: TComponent); 107 | begin 108 | inherited; 109 | FLock := TCriticalSection.Create; 110 | FTask := nil; 111 | FStream := nil; 112 | FIsRunning := false; 113 | FIsAborted := false; 114 | FAutoRetry := true; 115 | FRetryTimeout := 1400; 116 | FUrl := ''; 117 | FContentLength := 0; 118 | FRetriedCount := 0; 119 | FReadCount := 0; 120 | FLostConnectionCount := 0; 121 | end; 122 | 123 | destructor TDownloader.Destroy; 124 | begin 125 | if IsRunning then 126 | Self.AbortRequest; 127 | 128 | while IsRunning do begin 129 | if System.MainThreadID = TThread.Current.ThreadID then 130 | CheckSynchronize(0); 131 | Sleep(10); 132 | end; 133 | 134 | Flock.Free; 135 | inherited; 136 | end; 137 | 138 | 139 | function TDownloader.GetAutoRetry: boolean; 140 | begin 141 | Result := SafeGet(FAutoRetry); 142 | end; 143 | 144 | function TDownloader.GetContentLength: int64; 145 | begin 146 | Result := SafeGet(FContentLength); 147 | end; 148 | 149 | function TDownloader.GetIsAborted: boolean; 150 | begin 151 | Result := SafeGet(FIsAborted); 152 | end; 153 | 154 | function TDownloader.GetIsRunning: boolean; 155 | begin 156 | Result := SafeGet(FIsRunning); 157 | end; 158 | 159 | function TDownloader.GetReadCount: int64; 160 | begin 161 | Result := SafeGet(FReadCount); 162 | end; 163 | 164 | function TDownloader.GetRetriedCount: int64; 165 | begin 166 | Result := SafeGet(FRetriedCount); 167 | end; 168 | 169 | function TDownloader.GetRetryTimeout: int64; 170 | begin 171 | Result := SafeGet(FRetryTimeout); 172 | end; 173 | 174 | function TDownloader.GetSynchronizeEvents: boolean; 175 | begin 176 | Result := SafeGet(FSynchronizeEvents); 177 | end; 178 | 179 | function TDownloader.GetUrl: string; 180 | begin 181 | Result := SafeGet(Furl); 182 | end; 183 | 184 | procedure TDownloader.DoOnFinish; 185 | begin 186 | if Assigned(OnFinish) then begin 187 | if SynchronizeEvents then 188 | Tthread.Synchronize(TTHread.Current, procedure begin OnFinish(Self); end) 189 | else 190 | OnFinish(Self); 191 | end; 192 | end; 193 | 194 | procedure TDownloader.DoOnReceiveData(const Sender: TObject; AContentLength, 195 | AReadCount: Int64; var AAbort: Boolean); 196 | begin 197 | Flock.Enter; 198 | try 199 | FReadCount := AReadCount; 200 | FContentLength := AContentLength; 201 | Aabort := FIsAborted; 202 | finally 203 | FLock.Leave; 204 | if Assigned(OnReceiveData) then begin 205 | if SynchronizeEvents then begin 206 | var PseudoAbort := AAbort; 207 | TThread.Synchronize(Tthread.Current, procedure begin OnReceiveData(Self, AContentLength, AReadCount, PseudoAbort); end); 208 | end else 209 | OnReceiveData(Self, AContentLength, AReadCount, AAbort); 210 | end; 211 | end; 212 | end; 213 | 214 | procedure TDownloader.DoOnSendData(const Sender: TObject; AContentLength, 215 | AWriteCount: Int64; var AAbort: Boolean); 216 | begin 217 | Aabort := IsAborted; 218 | if Assigned(OnSendData) then begin 219 | if SynchronizeEvents then begin 220 | var PseudoAbort := AAbort; 221 | TThread.Synchronize(Tthread.Current, procedure begin OnSendData(Self, AContentLength, AWriteCount, PseudoAbort); end); 222 | end else 223 | OnSendData(Self, AContentLength, AWriteCount, AAbort); 224 | end; 225 | end; 226 | 227 | function TDownloader.SafeGet(var AVar: boolean): boolean; 228 | begin 229 | FLock.Enter; 230 | try 231 | Result := Avar; 232 | finally 233 | FLock.Leave; 234 | end; 235 | end; 236 | 237 | function TDownloader.SafeGet(var AVar: string): string; 238 | begin 239 | FLock.Enter; 240 | try 241 | Result := Avar; 242 | finally 243 | FLock.Leave; 244 | end; 245 | end; 246 | 247 | function TDownloader.SafeGet(var AVar: int64): int64; 248 | begin 249 | FLock.Enter; 250 | try 251 | Result := Avar; 252 | finally 253 | FLock.Leave; 254 | end; 255 | end; 256 | 257 | procedure TDownloader.SafeSet(var AVar: boolean; ANew: boolean); 258 | begin 259 | FLock.Enter; 260 | try 261 | AVar := ANew; 262 | finally 263 | FLock.Leave; 264 | end; 265 | end; 266 | 267 | procedure TDownloader.SafeSet(var AVar: string; ANew: string); 268 | begin 269 | FLock.Enter; 270 | try 271 | AVar := ANew; 272 | finally 273 | FLock.Leave; 274 | end; 275 | end; 276 | 277 | procedure TDownloader.SafeSet(var AVar: int64; ANew: int64); 278 | begin 279 | FLock.Enter; 280 | try 281 | AVar := ANew; 282 | finally 283 | FLock.Leave; 284 | end; 285 | end; 286 | 287 | 288 | procedure TDownloader.SetAutoRetry(const Value: boolean); 289 | begin 290 | SafeSet(FAutoRetry, value); 291 | end; 292 | 293 | procedure TDownloader.SetContentLength(const Value: int64); 294 | begin 295 | SafeSet(FContentLength, Value); 296 | end; 297 | 298 | procedure TDownloader.SetIsAborted(const Value: boolean); 299 | begin 300 | SafeSet(FIsAborted, value); 301 | end; 302 | 303 | procedure TDownloader.SetReadCount(const Value: int64); 304 | begin 305 | SafeSet(FReadCount, Value); 306 | end; 307 | 308 | procedure TDownloader.SetRetryTimeout(const Value: int64); 309 | begin 310 | SafeSet(FRetryTimeout, value); 311 | end; 312 | 313 | procedure TDownloader.SetSynchronizeEvents(const Value: boolean); 314 | begin 315 | SafeSet(FSynchronizeEvents, Value); 316 | end; 317 | 318 | procedure TDownloader.SetUrl(const Value: string); 319 | begin 320 | FLock.Enter; 321 | try 322 | if not FIsRunning then 323 | Furl := Value; 324 | finally 325 | FLock.Leave; 326 | end; 327 | end; 328 | 329 | procedure TDownloader.Start; 330 | begin 331 | if IsRunning then exit; 332 | FLock.Enter; 333 | try 334 | FIsRunning := true; 335 | FIsAborted := false; 336 | finally 337 | FLock.Leave; 338 | end; 339 | 340 | FTask := TTask.Create( 341 | procedure 342 | var 343 | WebClient: TNetHttpClient; 344 | GotError: boolean; 345 | begin 346 | try 347 | try 348 | WebClient := TNetHttpClient.Create(Self); 349 | 350 | if Assigned(OnCreateWebClient) then begin 351 | if SynchronizeEvents then 352 | TThread.Synchronize(TThread.Current, procedure begin OnCreateWebClient(Self, WebClient); end) 353 | else 354 | OnCreateWebClient(Self, WebClient); 355 | end; 356 | 357 | with WebClient do begin 358 | Asynchronous := false; 359 | SynchronizeEvents := false; 360 | OnReceiveData := Self.DoOnReceiveData; 361 | OnSendData := Self.DoOnSendData; 362 | end; 363 | 364 | while true do begin 365 | GotError := false; 366 | 367 | if IsAborted then 368 | FTask.Cancel; 369 | 370 | FTask.CheckCanceled; 371 | try 372 | // var StartPos: int64; 373 | // 374 | // if FStream.Size < 1 then 375 | // StartPos := 0 376 | // else begin 377 | // StartPos := FStream.Size; 378 | // FStream.Position := StartPos; 379 | // end; 380 | 381 | WebClient.GetRange(Url, FStream.Position, -1, FStream); 382 | except 383 | On E: Exception do begin 384 | GotError := true; 385 | 386 | if Assigned(OnRequestException) then 387 | OnRequestException(Self, E); 388 | 389 | if AutoRetry and ( not IsAborted ) then begin 390 | 391 | Flock.Enter; 392 | try 393 | inc(FRetriedCount); 394 | finally 395 | Flock.Leave; 396 | end; 397 | 398 | Sleep(RetryTimeout); 399 | Continue; 400 | end; 401 | 402 | end; 403 | 404 | end; 405 | Break; 406 | end; 407 | 408 | finally 409 | Flock.Enter; 410 | try 411 | FIsRunning := false; 412 | FTask := nil; 413 | finally 414 | FLock.Leave; 415 | DoOnFinish; 416 | end; 417 | end; 418 | except 419 | 420 | end; 421 | end); 422 | FTask.Start; 423 | end; 424 | 425 | { TFileDownloader } 426 | 427 | procedure TFileDownloader.DoOnFinish; 428 | begin 429 | if Assigned(FStream) then 430 | FStream.Free; 431 | inherited; 432 | end; 433 | 434 | function TFileDownloader.GetFilename: string; 435 | begin 436 | Result := SafeGet(FFilename); 437 | end; 438 | 439 | procedure TFileDownloader.SetFilename(const Value: string); 440 | begin 441 | FLock.Enter; 442 | try 443 | if not FIsRunning then 444 | FFilename := Value; 445 | finally 446 | FLock.Leave; 447 | end; 448 | end; 449 | 450 | procedure TFileDownloader.Start; 451 | begin 452 | if IsRunning then exit; 453 | FLock.Enter; 454 | try 455 | FStream := TFileStream.Create(FFilename, FmCreate); 456 | finally 457 | Flock.Leave; 458 | end; 459 | inherited; 460 | end; 461 | 462 | end. 463 | -------------------------------------------------------------------------------- /source/NsfwBox.MessageForDeveloper.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBox.MessageForDeveloper; 3 | 4 | interface 5 | uses 6 | Classes, SysUtils, Net.HttpClient, Net.HttpClientComponent, 7 | XSuperObject, System.NetEncoding; 8 | 9 | 10 | function SendMessage(ANickname, AMessage: string): boolean; 11 | 12 | implementation 13 | uses unit1; 14 | 15 | function SendMessage(ANickname, AMessage: string): boolean; 16 | const 17 | DUCK: string = 'aHR0cHM6Ly9kaXNjb3JkLmNvbS9hcGkvd2ViaG9va3MvMTAwMzM4' + 18 | 'NzA3NjU0MjIwNTk1Mi9pN1BaekhwM3Y3dnh0TmZTdmJza29zU21FTHl2UW9YampVTU9Q' + 19 | 'ZDNTaVplSkpxbmI2QXVDUk9hNi1nOHlFZFp0eWZHNz93YWl0PXRydWU='; 20 | var 21 | Client: TNetHttpClient; 22 | Json: ISuperObject; 23 | RequestBody: TStringStream; 24 | Response: IHttpResponse; 25 | Url: string; 26 | begin 27 | Result := false; 28 | Json := SO(); 29 | ANickname := trim(ANickName); 30 | 31 | if ( not ANickname.IsEmpty ) then 32 | Json.S['username'] := ANickname; 33 | Json.S['content'] := AMessage; 34 | 35 | Client := TNetHttpClient.Create(nil); 36 | Client.UserAgent := 'Mozilla/5.0 (Windows NT 10.0; rv:102.0) Gecko/20100101 Firefox/102.0'; 37 | Client.ContentType := 'application/json'; 38 | Client.AcceptEncoding := 'gzip, deflate'; 39 | Client.Accept := '*/*'; 40 | Client.SendTimeout := 5000; 41 | Client.ConnectionTimeout := 5000; 42 | Client.ResponseTimeout := 6000; 43 | 44 | RequestBody := TStringStream.Create(Json.AsJSON(false)); 45 | Url := TNetEncoding.Base64String.Decode(DUCK); 46 | try 47 | Response := Client.Post(Url, RequestBody); 48 | try 49 | Json := SO(Response.ContentAsString); 50 | Result := Json.Contains('content'); 51 | except 52 | 53 | end; 54 | //unit1.Log(Response.ContentAsString); 55 | finally 56 | Client.Free; 57 | RequestBody.Free; 58 | end; 59 | end; 60 | 61 | end. 62 | -------------------------------------------------------------------------------- /source/NsfwBox.UpdateChecker.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBox.UpdateChecker; 3 | 4 | interface 5 | uses 6 | System.SysUtils, Classes, System.Net.HttpClient, 7 | {$IFDEF ANDROID} 8 | AndroidApi.Helpers, 9 | AndroidApi.JNI.JavaTypes, 10 | AndroidApi.JNI.GraphicsContentViewText, 11 | {$ENDIF} 12 | System.Net.HttpClientComponent, XSuperObject; 13 | 14 | type 15 | 16 | TGithubUser = record 17 | [ALIAS('login')] Login: string; 18 | [ALIAS('id')] Id: Uint64; 19 | [ALIAS('avatar_url')] AvatarUrl: string; 20 | end; 21 | 22 | TGithubAsset = record 23 | [ALIAS('id')] Id: Uint64; 24 | [ALIAS('name')] Name: string; 25 | //[ALIAS('uploader')] Uploader: TGithubUser; 26 | [ALIAS('size')] Size: int64; 27 | [ALIAS('download_count')] DownloadCount: integer; 28 | [ALIAS('created_at')] CreatedAt: TDateTime; 29 | [ALIAS('updated_at')] UpdatedAt: TDateTime; 30 | [ALIAS('browser_download_url')] DownloadUrl: string; 31 | end; 32 | 33 | TGithubAssetAr = TArray; 34 | 35 | TGithubRelease = record 36 | [ALIAS('id')] Id: Uint64; 37 | [ALIAS('author')] Author: TGithubUser; 38 | [ALIAS('tag_name')] TagName: String; 39 | [ALIAS('name')] Name: string; 40 | [ALIAS('created_at')] CreatedAt: TDateTime; 41 | [ALIAS('updated_at')] UpdatedAt: TDateTime; 42 | [ALIAS('assets')] Assets: TGithubAssetAr; 43 | [ALIAS('html_url')] HtmlUrl: string; 44 | [ALIAS('body')] Body: string; 45 | end; 46 | 47 | TGithubReleaseAr = TArray; 48 | 49 | TGithubClient = Class(TObject) 50 | private const 51 | API_URL: string = 'https://api.github.com'; 52 | public 53 | WebClient: TNetHttpClient; 54 | function GetReleases(AAuthor: string; ARepo: string): TGithubReleaseAr; 55 | constructor Create; 56 | destructor Destroy; 57 | End; 58 | 59 | TSemVer = record 60 | Major: Cardinal; 61 | Minor: Cardinal; 62 | Patch: Cardinal; 63 | function ToString: string; 64 | function ToGhTagString: string; 65 | {* Operator Overloading *} 66 | class operator Equal(a: TSemVer; b: TSemVer): Boolean; 67 | class operator GreaterThan(a: TSemVer; b: TSemVer): Boolean; 68 | class operator GreaterThanOrEqual(a: TSemVer; b: TSemVer): Boolean; 69 | class operator LessThan(a: TSemVer; b: TSemVer): Boolean; 70 | class operator LessThanOrEqual(a: TSemVer; b: TSemVer): Boolean; 71 | {* *} 72 | class function FromString(AString: string): TSemVer; static; 73 | class function FromGhTagString(AString: string): TSemVer; static; 74 | constructor Create(AMajor, AMinor, APatch: Cardinal); 75 | end; 76 | 77 | function GetAppVersion: TSemVer; 78 | function GetLastRealeaseFromGitHub: TGithubRelease; 79 | 80 | implementation 81 | 82 | function GetAppVersion: TSemVer; 83 | begin 84 | {$IFDEF MSWINDOWS} 85 | GetProductVersion(ParamStr(0), 86 | Result.Major, 87 | Result.Minor, 88 | Result.Patch); 89 | {$ENDIF} {$IFDEF ANDROID} 90 | var LPkgInfo: JPackageInfo; 91 | LPkgInfo := TAndroidHelper.Activity.getPackageManager.getPackageInfo( 92 | SharedActivity.getPackageName, 0); 93 | Result := TSemVer.FromString(JStringToString(LPkgInfo.versionName)); 94 | {$ENDIF} 95 | end; 96 | 97 | function GetLastRealeaseFromGitHub: TGithubRelease; 98 | var 99 | Github: TGitHubClient; 100 | Releases: TGithubReleaseAr; 101 | begin 102 | Github := TGitHubClient.Create; 103 | try 104 | Releases := Github.GetReleases('Kisspeace', 'NsfwBox'); 105 | if ( Length(Releases) > 0 ) then 106 | Result := Releases[0]; 107 | finally 108 | Github.Free; 109 | end; 110 | end; 111 | 112 | { TGithubClient } 113 | 114 | constructor TGithubClient.Create; 115 | begin 116 | WebClient := TNetHttpClient.Create(nil); 117 | WebClient.AcceptEncoding := 'gzip, deflate'; 118 | WebClient.Accept := '*/*'; 119 | WebClient.UserAgent := 'Mozilla/5.0 (Windows NT 10.0; rv:102.0) Gecko/20100101 Firefox/102.0'; 120 | end; 121 | 122 | destructor TGithubClient.Destroy; 123 | begin 124 | WebClient.Free; 125 | end; 126 | 127 | function TGithubClient.GetReleases(AAuthor, ARepo: string): TGithubReleaseAr; 128 | var 129 | Content: string; 130 | begin 131 | Content := WebClient.Get(API_URL + '/repos/' + AAuthor + '/' + ARepo + '/releases').ContentAsString; 132 | Result := TJson.Parse(Content); 133 | end; 134 | 135 | { TAppVersion } 136 | 137 | constructor TSemVer.Create(AMajor, AMinor, APatch: Cardinal); 138 | begin 139 | Self.Major := AMajor; 140 | Self.Minor := AMinor; 141 | Self.Patch := APatch; 142 | end; 143 | 144 | 145 | class operator TSemVer.Equal(a, b: TSemVer): Boolean; 146 | begin 147 | Result := ( a.Major = b.Major ) 148 | and ( a.Minor = b.Minor ) 149 | and ( a.Patch = b.Patch ); 150 | end; 151 | 152 | class function TSemVer.FromGhTagString(AString: string): TSemVer; 153 | var 154 | N: integer; 155 | begin 156 | N := Pos('V', AString.ToUpper); 157 | Result := TSemVer.FromString(Copy(AString, N + 1, Length(AString))); 158 | end; 159 | 160 | class function TSemVer.FromString(AString: string): TSemVer; 161 | var 162 | N1, N2, L: integer; 163 | begin 164 | AString := Trim(AString); 165 | L := Length(AString); 166 | N1 := Pos('.', AString); 167 | Result.Major := StrToInt(Copy(AString, Low(AString), N1 - 1)); 168 | N2 := Pos('.', AString, N1 + 1); 169 | Result.Minor := StrToInt(Copy(AString, (N1 + 1), N2 - (N1 + 1))); 170 | Result.Patch := StrToInt(Copy(AString, (N2 + 1), L)); 171 | end; 172 | 173 | class operator TSemVer.GreaterThan(a, b: TSemVer): Boolean; 174 | begin 175 | Result := false; 176 | if ( a.Major > b.Major ) then begin 177 | Result := true; 178 | exit; 179 | end else if ( b.Major = a.Major ) and ( a.Minor > b.Minor ) then begin 180 | Result := true; 181 | exit; 182 | end else if ( b.Minor = a.Minor ) and ( a.Patch > b.Patch ) then begin 183 | Result := true; 184 | exit; 185 | end; 186 | end; 187 | 188 | class operator TSemVer.GreaterThanOrEqual(a, b: TSemVer): Boolean; 189 | begin 190 | Result := ( a > b ) or ( a = b ); 191 | end; 192 | 193 | class operator TSemVer.LessThan(a, b: TSemVer): Boolean; 194 | begin 195 | Result := ( b > a ); 196 | end; 197 | 198 | class operator TSemVer.LessThanOrEqual(a, b: TSemVer): Boolean; 199 | begin 200 | Result := ( a < b ) or ( a = b ); 201 | end; 202 | 203 | function TSemVer.ToGhTagString: string; 204 | begin 205 | Result := 'v' + Self.ToString; 206 | end; 207 | 208 | function TSemVer.ToString: string; 209 | begin 210 | Result := Major.ToString + '.' + Minor.ToString + '.' + Patch.ToString; 211 | end; 212 | 213 | end. 214 | -------------------------------------------------------------------------------- /source/NsfwBoxBookmarks.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxBookmarks; 3 | 4 | interface 5 | uses 6 | SysUtils, Classes, XSuperObject, XSuperJSON, DbHelper, 7 | DB, NsfwBoxInterfaces, NsfwBoxOriginPseudo, NsfwBoxOriginNsfwXxx, 8 | NsfwBoxOriginR34App, NsfwBoxOriginR34JsonApi, NsfwBoxOriginConst, 9 | NsfwBoxHelper; 10 | 11 | type 12 | 13 | TNBoxBookmarkType = ( Content, SearchRequest ); 14 | TNBoxBookmarksDb = class; 15 | 16 | TNBoxBookmark = class(TInterfacedPersistent, IHasOrigin) 17 | private 18 | FId: int64; 19 | FTableName: string; 20 | FObj: TInterfacedPersistent; 21 | FOrigin: integer; 22 | FBookmarkType: TNBoxBookmarkType; 23 | FAbout: string; 24 | FTime: TDateTime; 25 | function GetBookmarkType: TNBoxBookmarkType; 26 | function GetOrigin: integer; 27 | function GetTime: TDateTime; 28 | procedure SetObj(const value: TInterfacedPersistent); 29 | public 30 | property Id: int64 read FId write FId; 31 | property Tablename: string read FTableName write FTableName; 32 | property Obj: TInterfacedPersistent read FObj write SetObj; 33 | property Time: TDateTime read GetTime write FTime; 34 | property About: string read FAbout write FAbout; 35 | property Origin: integer read GetOrigin write FOrigin; 36 | property BookmarkType: TNBoxBookmarkType read GetBookmarkType write FBookmarkType; 37 | function IsRequest: boolean; 38 | function AsItem: INBoxItem; 39 | function AsRequest: INBoxSearchRequest; 40 | constructor Create(AItem: INBoxItem); overload; 41 | constructor Create(AItem: INBoxSearchRequest); overload; 42 | constructor Create; overload; 43 | end; 44 | 45 | TBookmarkAr = TArray; 46 | 47 | TBookmarkGroupRec = record 48 | private 49 | FDb: TNBoxBookmarksDb; 50 | public 51 | Id: int64; 52 | Name: string; 53 | About: string; 54 | Timestamp: TDateTime; 55 | procedure Add(A: TNBoxBookmark); overload; 56 | procedure Add(AValue: INBoxItem); overload; 57 | procedure Add(AValue: INBoxSearchRequest); overload; 58 | function GetPage(APageNum: integer = 1): TBookmarkAr; 59 | function Get(AStart, AEnd: integer): TBookmarkAr; 60 | procedure DeleteGroup; 61 | procedure Delete(ABookmarkId: int64); 62 | function GetMaxId: int64; 63 | procedure UpdateGroup; 64 | end; 65 | 66 | TBookmarkGroupRecAr = TArray; 67 | 68 | TNBoxBookmarksDb = class(TDbHelper) 69 | protected 70 | FPageSize: integer; 71 | procedure CreateBase; override; 72 | function ReadGroup: TBookmarkGroupRec; 73 | public 74 | property PageSize: integer read FPageSize write FPageSize; 75 | function GetBookmarksGroups: TBookmarkGroupRecAr; 76 | function GetGroupById(AGroupId: int64): TBookmarkGroupRec; 77 | procedure UpdateGroup(AGroupId: int64; ANew: TBookmarkGroupRec); 78 | function AddGroup(AName, AAbout: string): TBookmarkGroupRec; 79 | function GetLastGroup: TBookmarkGroupRec; 80 | procedure DeleteGroup(AGroupId: Int64); 81 | procedure DeleteAllGroups; 82 | procedure Delete(ABookmarkId: int64); 83 | procedure Add(AGroupId: int64; A: TNBoxBookmark); overload; 84 | procedure Add(AGroupId: int64; AValue: INBoxItem); overload; 85 | procedure Add(AGroupId: int64; AValue: INBoxSearchRequest); overload; 86 | function GetMaxId(AGroupId: int64): int64; 87 | function GetPage(AGroupId: int64; APageNum: integer = 1): TBookmarkAr; 88 | function Get(AGroupId: int64; AStart, AEnd: integer): TBookmarkAr; 89 | constructor Create(ADbFilename: string); override; 90 | end; 91 | 92 | TNBoxBookmarksHistoryDb = class(TNBoxBookmarksDb) 93 | private const 94 | NAME_SEARCH_HISTORY = 'search history'; 95 | NAME_TAP_HISTORY = 'tap history'; 96 | NAME_DOWNLOAD_HISTORY = 'download history'; 97 | private 98 | FSearchTable: TBookmarkGroupRec; 99 | FTapTable: TBookmarkGroupRec; 100 | FDownloadTable: TBookmarkGroupRec; 101 | protected 102 | procedure CreateBase; override; 103 | public 104 | property SearchGroup: TBookmarkGroupRec read FSearchTable; 105 | property TapGroup: TBookmarkGroupRec read FTapTable; 106 | property DownloadGroup: TBookmarkGroupRec read FDownloadTable; 107 | constructor Create(ADbFilename: string); override; 108 | end; 109 | 110 | Procedure SafeAssignFromJSON(AObject: TInterfacedPersistent; JSON: ISuperObject); overload; 111 | Procedure SafeAssignFromJSON(AObject: TInterfacedPersistent; AJsonString: string); overload; 112 | 113 | implementation 114 | uses unit1; 115 | 116 | Procedure SafeAssignFromJSON(AObject: TInterfacedPersistent; JSON: ISuperObject); 117 | begin 118 | if ( AObject is TNBoxR34AppItem ) then begin 119 | //Unit1.Log('Is R34Item'); 120 | try 121 | // v1.0.1 122 | if ( JSON.O['item'].Ancestor['tags'].DataType = TDataType.dtArray ) then begin 123 | //Unit1.Log('Array'); 124 | var LTagsAr: ISuperArray; 125 | LTagsAr := JSON.O['item'].A['tags'].Clone; 126 | JSON.O['item'].Remove('tags'); 127 | //Log(JSON.AsJSON(true)); 128 | JSON.O['item'].O['tags'].A['general'] := LTagsAr; 129 | end; 130 | 131 | except 132 | On E: Exception do begin 133 | Unit1.Log(E, 'SafeAssignFromJSON: '); 134 | end; 135 | end; 136 | end; 137 | AObject.AssignFromJSON(JSON); 138 | end; 139 | 140 | Procedure SafeAssignFromJSON(AObject: TInterfacedPersistent; AJsonString: string); 141 | begin 142 | SafeAssignFromJSON(AObject, SO(AJSONString)); 143 | end; 144 | 145 | { TNBoxBookmark } 146 | 147 | constructor TNBoxBookmark.Create(AItem: INBoxSearchRequest); 148 | begin 149 | Obj := ( Aitem as TInterfacedPersistent ); 150 | end; 151 | 152 | constructor TNBoxBookmark.Create(Aitem: INBoxItem); 153 | begin 154 | Obj := ( Aitem as TInterfacedPersistent ); 155 | end; 156 | 157 | function TNBoxBookmark.AsItem: INBoxItem; 158 | begin 159 | if Supports(Obj, INBoxItem) then 160 | Result := ( Obj as INBoxItem ) 161 | else 162 | Result := nil; 163 | end; 164 | 165 | function TNBoxBookmark.AsRequest: INBoxSearchRequest; 166 | begin 167 | if Supports(Obj, INBoxSearchRequest) then 168 | Result := ( Obj as INBoxSearchRequest ) 169 | else 170 | Result := nil; 171 | end; 172 | 173 | 174 | constructor TNBoxBookmark.Create; 175 | begin 176 | FObj := nil; 177 | end; 178 | 179 | function TNBoxBookmark.GetBookmarkType: TNBoxBookmarkType; 180 | begin 181 | Result := FBookmarkType; 182 | end; 183 | 184 | 185 | function TNBoxBookmark.GetOrigin: integer; 186 | begin 187 | Result := FOrigin; 188 | end; 189 | 190 | function TNBoxBookmark.GetTime: TDateTime; 191 | begin 192 | Result := FTime; 193 | end; 194 | 195 | function TNBoxBookmark.IsRequest: boolean; 196 | var 197 | Req: INboxSearchRequest; 198 | begin 199 | Req := AsRequest; 200 | Result := Assigned(Req); 201 | end; 202 | 203 | procedure TNBoxBookmark.SetObj(const value: TInterfacedPersistent); 204 | begin 205 | FObj := Value; 206 | if Assigned(Obj) then begin 207 | 208 | Origin := (Obj as IHasOrigin).Origin; 209 | 210 | if Supports(Obj, INboxItem) then 211 | BookmarkType := Content 212 | else 213 | BookmarkType := SearchRequest; 214 | 215 | end; 216 | end; 217 | 218 | { TNBoxBookmarksDb } 219 | 220 | procedure TNBoxBookmarksDb.Add(AGroupId: int64; A: TNBoxBookmark); 221 | begin 222 | if not Connection.Connected then 223 | Connection.Connect; 224 | 225 | With Query do begin 226 | Query.SQL.AddStrings([ 227 | 'INSERT INTO `items` (`group_id`, `origin`, `type`, `about`, `object`)', 228 | 'VALUES', 229 | ' (:group_id, :origin, :type, :about, :object);' 230 | ]); 231 | Params.ParamByName('group_id').AsInt64 := AGroupId; 232 | Params.ParamByName('origin').AsInteger := A.Origin; 233 | Params.ParamByName('type').AsInteger := ord(A.FBookmarkType); 234 | Params.ParamByName('about').AsString := A.About; 235 | //Params.ParamByName('timestamp').AsDateTime := A.Time; 236 | Params.ParamByName('object').AsString := A.Obj.AsJSON(false); 237 | ExecSQL; 238 | SQL.Clear; 239 | end; 240 | end; 241 | 242 | procedure TNBoxBookmarksDb.Add(AGroupId: int64; AValue: INBoxSearchRequest); 243 | var 244 | B: TNboxBookmark; 245 | begin 246 | try 247 | B := TNBoxBookmark.Create(AValue); 248 | B.Time := Now; 249 | Add(AGroupId, B); 250 | finally 251 | B.Free; 252 | end; 253 | end; 254 | 255 | procedure TNBoxBookmarksDb.Add(AGroupId: int64; AValue: INBoxItem); 256 | var 257 | B: TNboxBookmark; 258 | begin 259 | try 260 | B := TNBoxBookmark.Create(AValue); 261 | B.Time := Now; 262 | Add(AGroupId, B); 263 | finally 264 | B.Free; 265 | end; 266 | end; 267 | 268 | function TNBoxBookmarksDb.AddGroup(AName, AAbout: string): TBookmarkGroupRec; 269 | var 270 | NewId: int64; 271 | TableName: string; 272 | begin 273 | if not Connection.Connected then 274 | Connection.Connect; 275 | 276 | Result.FDb := self; 277 | Result.Name := AName; 278 | Result.About := AAbout; 279 | Result.Timestamp := now; 280 | Result.Id := 0; 281 | 282 | with Query do begin 283 | SQL.AddStrings([ 284 | 'INSERT INTO `groups` (`name`, `about`)', 285 | 'VALUES (:name, :about);' 286 | ]); 287 | Params.ParamByName('name').AsString := AName; 288 | Params.ParamByName('about').AsString := AAbout; 289 | ExecSQL; 290 | SQL.Clear; 291 | end; 292 | 293 | Result := Self.GetLastGroup; 294 | end; 295 | 296 | constructor TNBoxBookmarksDb.Create(ADbFilename: string); 297 | begin 298 | inherited; 299 | FPageSize := 25; 300 | end; 301 | 302 | procedure TNBoxBookmarksDb.CreateBase; 303 | begin 304 | Query.SQL.AddStrings([ 305 | 'CREATE TABLE `groups` (', 306 | ' `id` INTEGER PRIMARY KEY AUTOINCREMENT,', 307 | ' `name` VARCHAR(255),', 308 | ' `timestamp` DATETIME DEFAULT CURRENT_TIMESTAMP,', 309 | ' `about` TEXT', 310 | ');' 311 | ]); 312 | Query.ExecSQL; 313 | Query.SQL.Clear; 314 | 315 | Query.SQL.AddStrings([ 316 | 'CREATE TABLE `items` (', 317 | ' `origin` INTEGER,', 318 | ' `type` INTEGER,', 319 | ' `about` TEXT,', 320 | ' `timestamp` DATETIME DEFAULT CURRENT_TIMESTAMP,', 321 | ' `object` JSON,', 322 | ' `group_id` INTEGER DEFAULT 1,', 323 | ' FOREIGN KEY(group_id) REFERENCES `groups` (id)', 324 | ');' 325 | ]); 326 | Query.ExecSQL; 327 | Query.SQL.Clear; 328 | 329 | Query.SQL.AddStrings([ 330 | 'CREATE VIEW `only_content` AS', 331 | ' SELECT * FROM `items` WHERE (`type` = 0);' 332 | ]); 333 | Query.ExecSQL; 334 | Query.SQL.Clear; 335 | 336 | Query.SQL.AddStrings([ 337 | 'CREATE VIEW `only_requests` AS', 338 | ' SELECT * FROM `items` WHERE (`type` = 1);' 339 | ]); 340 | Query.ExecSQL; 341 | Query.SQL.Clear; 342 | end; 343 | 344 | procedure TNBoxBookmarksDb.Delete(ABookmarkId: int64); 345 | begin 346 | if not Connection.Connected then 347 | Connection.Connect; 348 | 349 | Query.SQL.Text := 'DELETE FROM `items` WHERE ( `rowid` = :id);'; 350 | Query.Params.ParamByName('id').AsInt64 := ABookmarkId; 351 | Query.ExecSQL; 352 | Query.SQL.Clear; 353 | end; 354 | 355 | procedure TNBoxBookmarksDb.DeleteAllGroups; 356 | var 357 | I: integer; 358 | Tables: TBookmarkGroupRecAr; 359 | begin 360 | if not Connection.Connected then 361 | Connection.Connect; 362 | 363 | Tables := Self.GetBookmarksGroups; 364 | for I := low(Tables) to high(Tables) do 365 | Tables[I].DeleteGroup; 366 | end; 367 | 368 | procedure TNBoxBookmarksDb.DeleteGroup(AGroupId: Int64); 369 | begin 370 | if not Connection.Connected then 371 | Connection.Connect; 372 | 373 | with Query do begin 374 | SQL.Text := 'DELETE FROM `items` WHERE ( `group_id` = :id );'; 375 | Params.ParamByName('id').AsInt64 := AGroupId; 376 | ExecSql; 377 | 378 | SQL.Text := 'DELETE FROM `groups` WHERE ( `id` = :id );'; 379 | Params.ParamByName('id').AsInt64 := AGroupId; 380 | ExecSql; 381 | 382 | SQL.Clear; 383 | end; 384 | end; 385 | 386 | function TNBoxBookmarksDb.Get(AGroupId: int64; AStart, AEnd: integer): TBookmarkAr; 387 | var 388 | I, Pos: integer; 389 | Bookmark: TNBoxBookmark; 390 | Json: string; 391 | tmp: TInterfacedPersistent; 392 | begin 393 | Result := []; 394 | Pos := 1; 395 | 396 | if not Connection.Connected then 397 | Connection.Connect; 398 | 399 | Query.SQL.Text := 'SELECT `rowid` AS id, * FROM `items` WHERE ( `group_id` = ' + AGroupId.ToString + ' ) LIMIT ' + AStart.ToString + ', ' + (AEnd - AStart).ToString + ';'; 400 | Query.Open; 401 | 402 | Query.First; 403 | while ( not Query.Eof ) do begin 404 | Bookmark := TNBoxBookmark.Create; 405 | 406 | with Bookmark do begin 407 | 408 | Id := Query.FieldByName('id').AsLargeInt; 409 | Origin := Query.FieldByName('origin').AsInteger; 410 | BookmarkType := TNBoxBookmarkType(Query.FieldByName('type').AsInteger); 411 | Json := Query.FieldByName('object').AsString; 412 | 413 | case bookmarktype of 414 | 415 | Content: begin 416 | var Post: INBoxItem; 417 | Post := CreateItemByOrigin(Origin); 418 | tmp := (Post as TInterfacedPersistent); 419 | SafeAssignFromJSON(tmp, Json); 420 | Bookmark.Obj := tmp; 421 | end; 422 | 423 | SearchRequest: begin 424 | var Req: INBoxSearchRequest; 425 | Req := CreateReqByOrigin(Origin); 426 | tmp := (Req as TInterfacedPersistent); 427 | SafeAssignFromJSON(tmp, Json); 428 | Bookmark.Obj := tmp; 429 | end; 430 | 431 | end; 432 | 433 | end; 434 | 435 | Result := Result + [ Bookmark ]; 436 | Query.Next; 437 | inc(Pos); 438 | 439 | end; 440 | 441 | Query.Close; 442 | Query.SQL.Clear; 443 | end; 444 | 445 | function TNBoxBookmarksDb.GetBookmarksGroups: TBookmarkGroupRecAr; 446 | var 447 | Rec: TBookmarkGroupRec; 448 | begin 449 | Result := []; 450 | 451 | if not Connection.Connected then 452 | Connection.Connect; 453 | 454 | Query.SQL.Text := 'SELECT * FROM `groups`;'; 455 | Query.Open; 456 | Query.First; 457 | 458 | while ( not Query.Eof ) do begin 459 | Rec := Self.ReadGroup; 460 | Result := Result + [Rec]; 461 | Query.Next; 462 | end; 463 | 464 | Query.Close; 465 | Query.SQL.Clear; 466 | end; 467 | 468 | function TNBoxBookmarksDb.GetMaxId(AGroupId: Int64): int64; 469 | begin 470 | if not Connection.Connected then 471 | Connection.Connect; 472 | 473 | Result := -1; 474 | Query.SQL.Text := 'SELECT `rowid` FROM `items` WHERE ( `group_id` = ' + AGroupId.ToString + ' ) ORDER BY `rowid` DESC LIMIT 1;'; 475 | Query.Open; 476 | try 477 | Query.First; 478 | Result := Query.FieldByName('rowid').AsLargeInt; 479 | except 480 | Result := -1; 481 | end; 482 | Query.Close; 483 | Query.SQL.Clear; 484 | end; 485 | // 486 | //function TNBoxBookmarksDb.GetGroupById(AId: int64): TBookmarkGroupRec; 487 | //var 488 | // Tables: TBookmarkTableRecAr; 489 | // I: integer; 490 | //begin 491 | // Tables := Self.GetBookmarksTables; 492 | // for i := Low(Tables) to High(Tables) do begin 493 | // if Tables[I].Id = AId then begin 494 | // Result := Tables[I]; 495 | // exit; 496 | // end; 497 | // end; 498 | // Result.Id := -1; 499 | //end; 500 | 501 | function TNBoxBookmarksDb.GetPage(AGroupId: int64; APageNum: integer): TBookmarkAr; 502 | var 503 | LStart, LEnd: integer; 504 | begin 505 | LStart := (APageNum - 1) * PageSize; 506 | if LStart < 0 then 507 | LStart := 0; 508 | LEnd := LStart + PageSize; 509 | Result := Get(AGroupId, LStart, LEnd); 510 | end; 511 | 512 | function TNBoxBookmarksDb.ReadGroup: TBookmarkGroupRec; 513 | begin 514 | With Result do begin 515 | Id := Query.FieldByName('id').AsLargeInt; 516 | Name := Query.FieldByName('name').AsString; 517 | About := Query.FieldByName('about').AsString; 518 | Timestamp := StrToDateTime(Query.FieldByName('timestamp').AsString); 519 | FDb := Self; 520 | end; 521 | end; 522 | 523 | function TNBoxBookmarksDb.GetGroupById(AGroupId: int64): TBookmarkGroupRec; 524 | begin 525 | if not Connection.Connected then 526 | Connection.Connect; 527 | 528 | with Query do begin 529 | SQL.Text := 'SELECT * FROM `groups` WHERE ( `id` = :id );'; 530 | Params.ParamByName('id').AsInt64 := AGroupId; 531 | Open; 532 | try 533 | First; 534 | Result := Self.ReadGroup; 535 | finally 536 | Close; 537 | SQL.Clear; 538 | end; 539 | end; 540 | end; 541 | 542 | function TNBoxBookmarksDb.GetLastGroup: TBookmarkGroupRec; 543 | begin 544 | if not Connection.Connected then 545 | Connection.Connect; 546 | 547 | With Query do begin 548 | SQL.Text := 'SELECT * FROM `groups` ORDER BY `id` DESC LIMIT 1;'; 549 | Open; 550 | try 551 | First; 552 | Result := Self.ReadGroup; 553 | finally 554 | Close; 555 | SQL.Clear; 556 | end; 557 | end; 558 | end; 559 | 560 | procedure TNBoxBookmarksDb.UpdateGroup(AGroupId: int64; ANew: TBookmarkGroupRec); 561 | begin 562 | if not Connection.Connected then 563 | Connection.Connect; 564 | 565 | with Query do begin 566 | SQL.AddStrings([ 567 | 'UPDATE `groups`', 568 | 'SET `name` = :name,', 569 | ' `about` = :about,', 570 | ' `timestamp` = :timestamp', 571 | 'WHERE ( `id` = :id );' 572 | ]); 573 | Params.ParamByName('name').AsString := ANew.Name; 574 | Params.ParamByName('about').AsString := ANew.About; 575 | Params.ParamByName('timestamp').AsDateTime := ANew.Timestamp; 576 | Params.ParamByName('id').AsInt64 := AGroupId; 577 | ExecSql; 578 | SQL.Clear; 579 | end; 580 | end; 581 | 582 | { TBookmarkGroupRec } 583 | 584 | procedure TBookmarkGroupRec.Add(A: TNBoxBookmark); 585 | begin 586 | FDb.Add(Id, A); 587 | end; 588 | 589 | procedure TBookmarkGroupRec.Add(AValue: INBoxItem); 590 | begin 591 | FDb.Add(Id, AValue); 592 | end; 593 | 594 | procedure TBookmarkGroupRec.Add(AValue: INBoxSearchRequest); 595 | begin 596 | FDb.Add(Id, AValue); 597 | end; 598 | 599 | procedure TBookmarkGroupRec.Delete(ABookmarkId: int64); 600 | begin 601 | FDb.Delete(ABookmarkId); 602 | end; 603 | 604 | procedure TBookmarkGroupRec.DeleteGroup; 605 | begin 606 | FDb.DeleteGroup(Id); 607 | end; 608 | 609 | function TBookmarkGroupRec.Get(AStart, AEnd: integer): TBookmarkAr; 610 | begin 611 | Result := FDb.Get(Id, AStart, AEnd); 612 | end; 613 | 614 | function TBookmarkGroupRec.GetMaxId: int64; 615 | begin 616 | Result := FDb.GetMaxId(Id); 617 | end; 618 | 619 | function TBookmarkGroupRec.GetPage(APageNum: integer): TBookmarkAr; 620 | begin 621 | Result := FDb.GetPage(Id, APageNum); 622 | end; 623 | 624 | procedure TBookmarkGroupRec.UpdateGroup; 625 | begin 626 | FDb.UpdateGroup(Id, Self); 627 | end; 628 | 629 | { TNBoxBookmarksHistoryDb } 630 | 631 | constructor TNBoxBookmarksHistoryDb.Create(ADbFilename: string); 632 | var 633 | Groups: TBookmarkGroupRecAr; 634 | 635 | function GetByName(AName: string): TBookmarkGroupRec; 636 | var 637 | I: integer; 638 | begin 639 | for I := low(Groups) to high(Groups) do begin 640 | if ( Groups[I].Name = AName ) then begin 641 | Result := Groups[i]; 642 | break; 643 | end; 644 | end; 645 | end; 646 | 647 | begin 648 | inherited; 649 | Groups := Self.GetBookmarksGroups; 650 | FSearchTable := GetByName(Self.NAME_SEARCH_HISTORY); 651 | FTapTable := GetByName(Self.NAME_TAP_HISTORY); 652 | FDownloadTable := GetByName(Self.NAME_DOWNLOAD_HISTORY); 653 | end; 654 | 655 | procedure TNBoxBookmarksHistoryDb.CreateBase; 656 | begin 657 | inherited; 658 | AddGroup(Self.NAME_SEARCH_HISTORY, 'list of searched requests.'); 659 | AddGroup(Self.NAME_DOWNLOAD_HISTORY, 'list of downloaded content.'); 660 | AddGroup(Self.NAME_TAP_HISTORY, 'clicked items.'); 661 | end; 662 | 663 | end. 664 | -------------------------------------------------------------------------------- /source/NsfwBoxContentScraper.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxContentScraper; 3 | 4 | interface 5 | 6 | uses 7 | System.SysUtils, System.Generics.Collections, 8 | NetHttp.R34AppApi, R34App.Types, 9 | Nethttp.R34JsonApi, R34JsonAPi.Types, NetHttp.Scraper.NsfwXxx, 10 | NsfwXxx.Types, givemeporn.club.types, givemeporn.club.scraper, 11 | NineHentaito.APITypes, NineHentaito.API, Net.HttpClientComponent, 12 | NsfwBoxInterfaces, NsfwBoxOriginNsfwXxx, NsfwBoxOriginR34JsonApi, 13 | NsfwBoxOriginPseudo, NsfwBoxOriginR34App, 14 | NsfwBoxOriginGivemepornClub, NsfwBoxOrigin9hentaiToApi, 15 | NsfwBoxOriginCoomerParty, CoomerParty.HTMLParser, CoomerParty.Scraper, 16 | CoomerParty.Types, 17 | NsfwBoxOriginConst, NsfwBoxBookmarks, NsfwBoxOriginBookmarks, 18 | IoUtils, NsfwBoxFilesystem, System.Classes, system.SyncObjs, 19 | System.Threading, NsfwBoxThreading; 20 | 21 | type 22 | 23 | TWebClientSetEvent = procedure(Sender: TObject; AWebClient: TNetHttpClient; 24 | AOrigin: integer) of object; 25 | 26 | TINBoxItemEvent = procedure(Sender: TObject; var AItem: INBoxItem) of object; 27 | 28 | TNBoxScraper = class(TObject) 29 | private 30 | FOnWebClientSet: TWebClientSetEvent; 31 | procedure SyncWebClientSet(AClient: TNetHttpClient; AOrigin: integer); 32 | procedure UploadItems(A: TNsfwXXXItemList; AList: INBoxHasOriginList); 33 | function GetContentPseudo(AList: INBoxHasOriginList; ARequest: string ): boolean; 34 | function GetContentNsfwXxx(AList: INBoxHasOriginList; AReqParam: string; ASearchType: TNsfwUrlType; APageNum: integer; Asort: TnsfwSort; ATypes: TNsfwItemTypes; AOrientations: TNsfwOris; ASite: TNsfwXxxSite): boolean; 35 | function GetContentR34JsonApi(AList: INBoxHasOriginList; ATags: string = ''; APageId: integer = 1; ALimit: integer = 20): boolean; 36 | function GetContentR34App(AList: INBoxHasOriginList; ATags: string; APageId: integer; ALimit: integer; ABooru: TR34AppFreeBooru): boolean; 37 | function GetContentGmpClub(AList: INBoxHasOriginList; AReqParam: string; ASearchType: TGmpClubSearchType; APageNum: integer): boolean; 38 | function GetContent9Hentaito(AList: INBoxHasOriginList; const ASearch: T9HentaiBookSearchRec): boolean; 39 | function GetContentCoomerParty(AList: INBoxHasOriginList; ASite: string; ARequest, AUserId, AService: string; APageNum: integer): boolean; 40 | function GetContentBookmarks(AList: INBoxHasOriginList; ABookmarksListId: int64; APageId: integer = 1): boolean; 41 | public 42 | BookmarksDb: TNBoxBookmarksDb; 43 | procedure FetchContentUrls(var APost: INBoxItem); 44 | procedure FetchTags(var APost: INBoxItem); 45 | function TryFetchContentUrls(var APost: INBoxItem): boolean; 46 | function TryFetchTags(var APost: INBoxItem): boolean; 47 | function GetContent(ARequest: INBoxSearchRequest; AList: INBoxHasOriginList): boolean; 48 | property OnWebClientSet: TWebClientSetEvent read FOnWebClientSet write FOnWebClientSet; 49 | constructor Create; 50 | end; 51 | 52 | TNBoxFetchManager = Class(TQueuedThreadComponentBase) 53 | private 54 | FQueue: TList; 55 | FOnWebClientSet: TWebClientSetEvent; 56 | FOnFetched: TINBoxItemEvent; 57 | public 58 | // Critical section 59 | property Queue: TList read FQueue; 60 | // Critical section end 61 | { this executes in locked criticalsec } 62 | function QueueCondition: boolean; override; 63 | //function AutoRestartCondition: boolean; override; 64 | function NewSubTask: ITask; override; 65 | { !! } 66 | property OnFetched: TINBoxItemEvent read FOnFetched write FOnFetched; 67 | property OnWebClientSet: TWebClientSetEvent read FOnWebClientSet write FOnWebClientSet; 68 | procedure Add(AItem: INBoxItem); 69 | constructor Create(AOwner: TComponent); 70 | destructor Destroy; override; 71 | End; 72 | 73 | implementation 74 | uses unit1; 75 | { TNBoxScraper } 76 | 77 | constructor TNBoxScraper.Create; 78 | begin 79 | Self.FOnWebClientSet := nil; 80 | Self.BookmarksDb := nil; 81 | end; 82 | 83 | procedure TNBoxScraper.FetchContentUrls(var APost: INBoxItem); 84 | begin 85 | //unit1.SyncLog('FetchContentUrls: ' + APost.Origin.ToString + ' ' + APost.ThumbnailUrl); 86 | if ( APost is TNBoxNsfwXxxItem ) then begin 87 | 88 | var Client: TNsfwXxxScraper; 89 | var Item: TNBoxNsfwXxxitem; 90 | 91 | Item := ( APost as TNBoxNsfwXxxitem ); 92 | Client := TNsfwXxxScraper.Create; 93 | SyncWebClientSet(Client.WebClient, APost.Origin); 94 | 95 | try 96 | Item.Page := Client.GetPage(Item.Item.PostUrl); 97 | finally 98 | Client.Free; 99 | end; 100 | 101 | end else if ( APost is TNBoxGmpClubItem ) then begin 102 | 103 | var Client: TGmpClubScraper; 104 | var Item: TNBoxGmpClubItem; 105 | 106 | Item := ( APost as TNBoxGmpClubItem ); 107 | Client := TGmpClubScraper.Create; 108 | SyncWebClientSet(Client.WebClient, APost.Origin); 109 | 110 | try 111 | Item.Page := Client.GetPage(Item.Item.GetUrl, false); 112 | finally 113 | Client.Free; 114 | end; 115 | 116 | end else if ( APost is TNBoxCoomerPartyItem ) then begin 117 | 118 | var Client: TCoomerPartyScraper; 119 | var Item: TNBoxCoomerPartyItem; 120 | 121 | Item := ( APost as TNBoxCoomerPartyItem ); 122 | Client := TCoomerPartyScraper.Create; 123 | Client.Host := Item.Site; 124 | SyncWebClientSet(Client.Client, APost.Origin); 125 | 126 | try 127 | Item.Item := Client.GetPost(Item.Item.Author, Item.UIdInt); 128 | finally 129 | Client.Free; 130 | end; 131 | 132 | end; 133 | end; 134 | 135 | procedure TNBoxScraper.FetchTags(var APost: INBoxItem); 136 | begin 137 | self.FetchContentUrls(APost); 138 | end; 139 | 140 | function TNBoxScraper.GetContent(ARequest: INBoxSearchRequest; 141 | AList: INBoxHasOriginList): boolean; 142 | var 143 | RequestAsInt: int64; 144 | begin 145 | Result := false; 146 | if not TryStrToInt64(ARequest.Request, RequestAsInt) then 147 | RequestAsInt := 1; 148 | 149 | case ARequest.Origin of 150 | 151 | ORIGIN_NSFWXXX: 152 | begin 153 | with ( ARequest As TNBoxSearchReqNsfwXxx ) do begin 154 | Result := Self.GetContentNsfwXxx 155 | ( AList, 156 | Request, 157 | SearchType, 158 | Pageid, 159 | SortType, 160 | Types, 161 | Oris, 162 | Site ); 163 | end; 164 | end; 165 | 166 | ORIGIN_R34APP: 167 | begin 168 | with ( ARequest As TNBoxSearchReqR34App ) do begin 169 | Result := self.GetContentR34App 170 | ( AList, 171 | Request, 172 | PageId, 173 | 20, 174 | Booru ); 175 | end; 176 | end; 177 | 178 | ORIGIN_R34JSONAPI: 179 | begin 180 | Result := self.GetContentR34JsonApi 181 | ( AList, 182 | ARequest.Request, 183 | ARequest.PageId ); 184 | end; 185 | 186 | ORIGIN_GIVEMEPORNCLUB: 187 | begin 188 | with ( ARequest As TNBoxSearchReqGmpClub ) do begin 189 | Result := Self.GetContentGmpClub 190 | ( AList, 191 | Request, 192 | SearchType, 193 | PageId ); 194 | end; 195 | end; 196 | 197 | ORIGIN_9HENTAITO: 198 | begin 199 | with ( ARequest As TNBoxSearchReq9Hentaito ) do begin 200 | Result := Self.GetContent9Hentaito 201 | ( AList, 202 | SearchRec); 203 | end; 204 | end; 205 | 206 | ORIGIN_COOMERPARTY: 207 | begin 208 | with ( ARequest As TNBoxSearchReqCoomerParty ) do begin 209 | Result := Self.GetContentCoomerParty 210 | ( AList, 211 | Site, 212 | Request, 213 | UserId, 214 | Service, 215 | PageId 216 | ); 217 | end; 218 | end; 219 | 220 | ORIGIN_PSEUDO: 221 | begin 222 | Result := Self.GetContentPseudo(AList, ARequest.Request); 223 | end; 224 | 225 | ORIGIN_BOOKMARKS: 226 | begin 227 | Result := Self.GetContentBookmarks(Alist, RequestAsInt, ARequest.PageId); 228 | end; 229 | 230 | end; 231 | end; 232 | 233 | function TNBoxScraper.GetContent9Hentaito(AList: INBoxHasOriginList; 234 | const ASearch: T9HentaiBookSearchRec): boolean; 235 | var 236 | Client: T9HentaiClient; 237 | i: integer; 238 | Content: T9HentaiBookAr; 239 | begin 240 | Result := false; 241 | Client := T9HentaiClient.Create; 242 | try 243 | SyncWebClientSet(Client.WebClient, ORIGIN_9HENTAITO); 244 | Content := Client.GetBook(ASearch); 245 | Result := (length(Content) > 0); 246 | for i := 0 to high(Content) do begin 247 | var Item: TNBox9HentaitoItem; 248 | Item := TNBox9HentaitoItem.Create(false); 249 | Item.Item := Content[I]; 250 | AList.Add(Item); 251 | end; 252 | finally 253 | Client.Free; 254 | end; 255 | end; 256 | 257 | function TNBoxScraper.GetContentGmpClub(AList: INBoxHasOriginList; AReqParam: string; 258 | ASearchType: TGmpClubSearchType; APageNum: integer): boolean; 259 | var 260 | Client: TGmpclubScraper; 261 | i: integer; 262 | Content: TGmpclubItemAr; 263 | begin 264 | Result := false; 265 | Client := TGmpclubScraper.create; 266 | try 267 | SyncWebClientSet(Client.WebClient, ORIGIN_GIVEMEPORNCLUB); 268 | 269 | case ASearchType of 270 | 271 | TGmpClubSearchType.Empty: 272 | begin 273 | Content := Client.GetItems(APageNum); 274 | end; 275 | 276 | TGmpClubSearchType.Random: 277 | begin 278 | Content := Client.GetRandomItems; 279 | end; 280 | 281 | TGmpClubSearchType.Tag: 282 | begin 283 | Content := Client.GetItemsByTag(AReqParam, APageNum); 284 | end; 285 | 286 | TGmpClubSearchType.Category: 287 | begin 288 | Content := Client.GetItemsByCategory(AReqParam, APageNum); 289 | end; 290 | 291 | end; 292 | 293 | Result := (length(Content) > 0); 294 | for i := 0 to high(Content) do begin 295 | var Item: TNBoxGmpClubItem; 296 | Item := TNBoxGmpClubItem.Create; 297 | Item.Item := Content[I]; 298 | AList.Add(Item); 299 | end; 300 | 301 | finally 302 | Client.Free; 303 | end; 304 | end; 305 | 306 | function TNBoxScraper.GetContentBookmarks(AList: INBoxHasOriginList; 307 | ABookmarksListId: int64; APageId: integer): boolean; 308 | var 309 | I, C: integer; 310 | Groups: TBookmarkGroupRecAr; 311 | Group: TBookmarkGroupRec; 312 | bookmarks: TBookmarkAr; 313 | begin 314 | Result := false; 315 | if not Assigned(BookmarksDb) then 316 | exit; 317 | 318 | C := AList.Count; 319 | 320 | Groups := BookmarksDb.GetBookmarksGroups; 321 | for I := low(Groups) to high(Groups) do begin 322 | if Groups[i].Id = ABookmarksListId then begin 323 | Group := Groups[i]; 324 | break; 325 | end; 326 | end; 327 | 328 | Bookmarks := Group.GetPage(APageId); 329 | for I := low(bookmarks) to high(bookmarks) do begin 330 | // if Bookmarks[I].BookmarkType = Content then 331 | AList.Add(Bookmarks[I]); 332 | // Bookmarks[I].Free; 333 | end; 334 | Bookmarks := nil; 335 | 336 | Result := (AList.Count > C); 337 | end; 338 | 339 | function TNBoxScraper.GetContentCoomerParty(AList: INBoxHasOriginList; 340 | ASite: string; ARequest, AUserId, AService: string; 341 | APageNum: integer): boolean; 342 | var 343 | Client: TCoomerPartyScraper; 344 | I: integer; 345 | Content: TPartyPostsPage; 346 | begin 347 | Result := false; 348 | Client := TCoomerPartyScraper.Create; 349 | Client.Host := ASite; 350 | try 351 | SyncWebClientSet(Client.Client, ORIGIN_COOMERPARTY); 352 | 353 | if ( Trim(AUserId).IsEmpty or Trim(AService).IsEmpty ) then begin 354 | // Search by recent posts 355 | Content := Client.GetRecentPostsByPageNum(ARequest, APageNum); 356 | end else begin 357 | // Search by artist posts 358 | Content := Client.GetArtistPostsByPageNum(ARequest, AUserId, AService, APageNum); 359 | end; 360 | 361 | Result := ( length(Content.Posts) > 0 ); 362 | for I := 0 to High(Content.Posts) do begin 363 | var Item: TNBoxCoomerPartyItem; 364 | Item := TNBoxCoomerPartyItem.Create; 365 | Item.Site := Client.Host; 366 | Item.UIdInt := Content.Posts[I].Id; 367 | Item.Item := TPartyPostToTPartyPostPage(Content.Posts[I]); 368 | AList.Add(Item); 369 | end; 370 | 371 | finally 372 | Client.Free; 373 | end; 374 | end; 375 | 376 | function TNBoxScraper.GetContentPseudo(AList: INBoxHasOriginList; 377 | ARequest: string): boolean; 378 | var 379 | I, C: integer; 380 | Files: TSearchRecAr; 381 | begin 382 | C := AList.Count; 383 | Files := GetFiles(ARequest); 384 | 385 | for I := Low(Files) to High(Files) do begin 386 | if Files[I].Attr = faDirectory then 387 | continue; 388 | var item: TNBoxPseudoItem; 389 | item := TNBoxPseudoItem.Create; 390 | item.ThumbnailUrl := IoUtils.TPath.Combine(TPAth.GetDirectoryName(ARequest), Files[i].Name); 391 | AList.Add(Item); 392 | end; 393 | Result := (AList.Count > C); 394 | end; 395 | 396 | function TNBoxScraper.GetContentR34JsonApi(AList: INBoxHasOriginList; ATags: string; 397 | APageId, ALimit: integer): boolean; 398 | var 399 | Client: TR34Client; 400 | i: integer; 401 | content: TR34Items; 402 | begin 403 | Result := false; 404 | Client := TR34Client.Create; 405 | Content := nil; 406 | try 407 | SyncWebClientSet(Client.WebClient, ORIGIN_R34JSONAPI); 408 | 409 | Content := Client.GetPosts 410 | ( ATags, 411 | APageId, 412 | ALimit ); 413 | 414 | Result := (length(Content) > 0); 415 | for I := 0 to length(Content) - 1 do begin 416 | var item: TNBoxR34JsonApiItem; 417 | item := TNBoxR34JsonApiItem.Create; 418 | item.Item := Content[i]; 419 | Alist.Add(item); 420 | end; 421 | 422 | finally 423 | Client.Free; 424 | end; 425 | end; 426 | 427 | procedure TNBoxScraper.SyncWebClientSet(AClient: TNetHttpClient; AOrigin: integer); 428 | begin 429 | if Not Assigned(self.OnWebClientSet) then 430 | exit; 431 | 432 | TThread.Synchronize(Nil, procedure begin 433 | OnWebClientSet(Self, AClient, AOrigin); 434 | end); 435 | end; 436 | 437 | function TNBoxScraper.TryFetchContentUrls(var APost: INBoxItem): boolean; 438 | begin 439 | try 440 | FetchContentUrls(APost); 441 | Result := true; 442 | except 443 | Result := false; 444 | end; 445 | end; 446 | 447 | function TNBoxScraper.TryFetchTags(var APost: INBoxItem): boolean; 448 | begin 449 | Self.TryFetchContentUrls(APost); 450 | end; 451 | 452 | function TNBoxScraper.GetContentR34App(AList: INBoxHasOriginList; ATags: string; 453 | APageId, ALimit: integer; ABooru: TR34AppFreeBooru): boolean; 454 | var 455 | Client: TR34AppClient; 456 | i: integer; 457 | content: TR34AppItems; 458 | begin 459 | try 460 | Result := false; 461 | Content := nil; 462 | Client := TR34AppClient.Create; 463 | 464 | SyncWebClientSet(Client.WebClient, ORIGIN_R34APP); 465 | Content := Client.GetPosts(ATags, APageId, ALimit, ABooru); 466 | Result := ( length(Content) > 0 ); 467 | 468 | for I := 0 to Length(Content) - 1 do begin 469 | var item: TNBoxR34AppItem; 470 | item := TNBoxR34AppItem.Create; 471 | item.Item := Content[i]; 472 | Alist.Add(item); 473 | end; 474 | 475 | finally 476 | Client.Free; 477 | end; 478 | end; 479 | 480 | function TNBoxScraper.GetContentNsfwXxx(AList: INBoxHasOriginList; 481 | AReqParam: string; ASearchType: TNsfwUrlType; APageNum: integer; 482 | Asort: TnsfwSort; ATypes: TNsfwItemTypes; AOrientations: TNsfwOris; 483 | ASite: TNsfwXxxSite): boolean; 484 | var 485 | Client: TNsfwXxxScraper; 486 | i: integer; 487 | Content: TNsfwXXXItemList; 488 | begin 489 | Result := false; 490 | try 491 | Client := TNsfwXxxScraper.Create; 492 | Client.Host := TNsfwXxxSiteToUrl(ASite); 493 | Content := TNsfwXXXItemList.Create; 494 | 495 | SyncWebClientSet(Client.WebClient, ORIGIN_NSFWXXX); 496 | 497 | Result := Client.GetItems 498 | ( Content, 499 | AReqParam, 500 | ASearchType, 501 | APageNum, 502 | ASort, 503 | ATypes, 504 | AOrientations ); 505 | 506 | UploadItems(Content, Alist); 507 | finally 508 | Client.Free; 509 | Content.Free; 510 | end; 511 | end; 512 | 513 | procedure TNBoxScraper.UploadItems(A: TNsfwXXXItemList; 514 | AList: INBoxHasOriginList); 515 | var 516 | I: integer; 517 | item: TNBoxNsfwXxxItem; 518 | begin 519 | for I := 0 to A.Count - 1 do begin 520 | item := TNBoxNsfwXxxItem.Create; 521 | item.item := A.Items[i]; 522 | Alist.Add(item); 523 | end; 524 | end; 525 | 526 | { TNBoxFetchManager } 527 | 528 | procedure TNBoxFetchManager.Add(AItem: INBoxItem); 529 | begin 530 | //synclog('Add begin.'); 531 | FLock.Enter; 532 | try 533 | FQueue.Add(AItem); 534 | finally 535 | FLock.Leave; 536 | end; 537 | 538 | // SyncLog('Before if'); 539 | 540 | if ( not IsWorkingNow ) then begin 541 | //synclog('Starting thread!!'); 542 | Self.StartTask; 543 | end; 544 | //synclog('Add end.'); 545 | end; 546 | 547 | constructor TNBoxFetchManager.Create(AOwner: TComponent); 548 | begin 549 | Inherited; 550 | FQueue := TList.Create; 551 | end; 552 | 553 | destructor TNBoxFetchManager.Destroy; 554 | begin 555 | inherited; 556 | FQueue.Free; 557 | end; 558 | 559 | function TNBoxFetchManager.NewSubTask: ITask; 560 | var 561 | LItem: INBoxItem; 562 | begin 563 | LItem := FQueue.First.Clone; 564 | FQueue.Delete(0); 565 | //SyncLog('Deleted: ' + FQueue.Count.ToString); 566 | 567 | Result := TTask.Create( 568 | procedure 569 | var 570 | LScraper: TNBoxScraper; 571 | begin 572 | try 573 | try 574 | LScraper := TNBoxScraper.Create; 575 | LScraper.OnWebClientSet := Self.OnWebClientSet; 576 | 577 | while not LScraper.TryFetchContentUrls(LItem) do begin 578 | TTask.CurrentTask.CheckCanceled; 579 | end; 580 | 581 | // Fetched 582 | TTask.CurrentTask.CheckCanceled; 583 | if ( Assigned(Self.OnFetched) ) then 584 | Self.OnFetched(Self, LItem); 585 | 586 | finally 587 | //TObject(AItem).Free; 588 | LScraper.Free; 589 | end; 590 | Except 591 | 592 | On E: EOperationCancelled do begin 593 | // ignore 594 | end; 595 | 596 | On E: Exception do begin 597 | SyncLog(E, 'TNBoxFetchManager.Execute.Task: ') 598 | end; 599 | 600 | end; 601 | end); 602 | end; 603 | 604 | function TNBoxFetchManager.QueueCondition: boolean; 605 | begin 606 | Result := ( FQueue.Count > 0 ); 607 | end; 608 | 609 | end. 610 | -------------------------------------------------------------------------------- /source/NsfwBoxDownloadManager.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxDownloadManager; 3 | 4 | interface 5 | uses 6 | Classes, NetHttpClient.Downloader, Net.HttpClient, Net.HttpClientComponent, 7 | System.Threading, system.Generics.Collections, system.SyncObjs, 8 | System.SysUtils; 9 | 10 | type 11 | 12 | TOnCreateDownloader = 13 | procedure (Sender: Tobject; const ADownloader: TNetHttpDownloader) of object; 14 | 15 | TOnStartDownloader = TOnCreateDownloader; 16 | 17 | TDownloaderList = TList; 18 | TDownloaderObjList = TObjectList; 19 | 20 | TNBoxDownloadManager = class(TComponent) 21 | private 22 | FNowDestroy: boolean; 23 | FSynchronizeEvents: boolean; 24 | FLock: TCriticalSection; 25 | FMainTask: ITask; 26 | FQueue: TDownloaderList; 27 | FMaxThreadCount: int64; 28 | FOnCreateDownloader: TOnCreateDownloader; 29 | FOnStartDownloader: TOnStartDownloader; 30 | procedure SetMaxThreadCount(const value: int64); 31 | function GetMaxThreadCount: int64; 32 | procedure SetSynchronizeEvents(const value: boolean); 33 | function GetSynchronizeEvents: boolean; 34 | procedure StartMainTask; 35 | procedure CancelAll; 36 | public 37 | function AddDownload(AUrl: string; AFilename: string): TNetHttpDownloader; 38 | property MaxThreadCount: int64 read GetMaxThreadCount write SetMaxThreadCount default 5; 39 | property SynchronizeEvents: boolean read GetSynchronizeEvents write SetSynchronizeEvents default true; 40 | property OnCreateDownloader: TOnCreateDownloader read FOnCreateDownloader write FOnCreateDownloader; 41 | property OnStartDownloader: TOnStartDownloader read FOnStartDownloader write FOnStartDownloader; 42 | constructor Create(AOwner: TComponent); override; 43 | destructor Destroy; override; 44 | end; 45 | 46 | implementation 47 | uses unit1; 48 | { TNBoxDownloadManager } 49 | 50 | function TNBoxDownloadManager.AddDownload(AUrl, 51 | AFilename: string): TNetHttpDownloader; 52 | begin 53 | Result := TNetHttpDownloader.Create(Self); 54 | With Result do begin 55 | Url := AUrl; 56 | Filename := AFilename; 57 | AutoRetry := true; 58 | end; 59 | 60 | if Assigned(OnCreateDownloader) then 61 | OnCreateDownloader(Self, Result); 62 | 63 | FLock.enter; 64 | try 65 | FQueue.Add(Result); 66 | if not Assigned(FMainTask) then 67 | StartMainTask; 68 | 69 | finally 70 | FLock.Leave; 71 | end; 72 | end; 73 | 74 | procedure TNBoxDownloadManager.CancelAll; 75 | begin 76 | FLock.enter; 77 | try 78 | if Assigned(FMainTask) then begin 79 | FMainTask.Cancel; 80 | end; 81 | finally 82 | FLock.Leave; 83 | end; 84 | end; 85 | 86 | constructor TNBoxDownloadManager.Create(AOwner: TComponent); 87 | begin 88 | inherited; 89 | FNowDestroy := false; 90 | FSynchronizeEvents := true; 91 | FLock := TCriticalSection.Create; 92 | FQueue := TDownloaderList.Create; 93 | Self.FMaxThreadCount := 5; 94 | FMainTask := nil; 95 | end; 96 | 97 | destructor TNBoxDownloadManager.Destroy; 98 | var 99 | I: integer; 100 | begin 101 | FLock.enter; 102 | try 103 | FNowDestroy := true; 104 | OnStartDownloader := nil; 105 | finally 106 | FLock.Leave; 107 | end; 108 | 109 | if Assigned(FMainTask) then begin 110 | CancelAll; 111 | if TThread.Current.ThreadID = MainThreadId then begin 112 | try 113 | while not TTask.WaitForAll([FMainTask], 100) do 114 | CheckSynchronize(10); 115 | except 116 | 117 | end; 118 | end; 119 | end; 120 | 121 | For I := 0 to FQueue.Count - 1 do 122 | FQueue[I].Free; 123 | FQueue.Clear; 124 | 125 | FLock.Free; 126 | FQueue.Free; 127 | inherited; 128 | end; 129 | 130 | function TNBoxDownloadManager.GetSynchronizeEvents: boolean; 131 | begin 132 | FLock.Enter; 133 | try 134 | Result := FSynchronizeEvents; 135 | finally 136 | FLock.Leave; 137 | end; 138 | end; 139 | 140 | function TNBoxDownloadManager.GetMaxThreadCount: int64; 141 | begin 142 | Result := TInterlocked.Read(FMaxThreadCount); 143 | end; 144 | 145 | procedure TNBoxDownloadManager.SetSynchronizeEvents(const value: boolean); 146 | begin 147 | FLock.Enter; 148 | try 149 | FSynchronizeEvents := Value; 150 | finally 151 | FLock.Leave; 152 | end; 153 | end; 154 | 155 | procedure TNBoxDownloadManager.SetMaxThreadCount(const value: int64); 156 | begin 157 | TInterLocked.Exchange(FMaxThreadCount, value); 158 | end; 159 | 160 | procedure TNBoxDownloadManager.StartMainTask; 161 | begin 162 | FMainTask := TTask.Create( 163 | procedure 164 | var 165 | I, Count, Pos: integer; 166 | id: string; 167 | Loaders: TDownloaderObjList; 168 | LoadersUpdated: boolean; 169 | 170 | procedure Update; 171 | begin 172 | try 173 | FLock.enter; 174 | try 175 | LoadersUpdated := ( FQueue.Count > 0 ); 176 | if LoadersUpdated then begin 177 | Loaders.AddRange(FQueue); 178 | FQueue.Clear; 179 | end; 180 | finally 181 | FLock.Leave; 182 | end; 183 | except on E: Exception do 184 | SyncLog(E, 'EXCEPTION: On Update: '); 185 | end; 186 | end; 187 | 188 | function CanStart(A: TNetHttpDownloader): boolean; 189 | begin 190 | Result := not ( A.IsAborted or A.IsRunning ); 191 | end; 192 | 193 | function RunningCount: integer; 194 | var 195 | I: integer; 196 | begin 197 | Result := 0; 198 | for I := 0 to Loaders.Count - 1 do begin 199 | if Loaders[I].IsRunning then 200 | Inc(Result); 201 | end; 202 | end; 203 | 204 | begin 205 | try 206 | try 207 | id := TThread.Current.ThreadID.ToString; 208 | Loaders := TDownloaderObjList.Create; 209 | 210 | Update; 211 | 212 | Pos := 0; // Loaders.Items[0]; - Starts from first item. 213 | while LoadersUpdated do begin 214 | LoadersUpdated := false; 215 | 216 | for I := Pos to Loaders.Count - 1 do begin 217 | var Item: TNetHttpDownloader; 218 | Item := Loaders[I]; 219 | Pos := I; 220 | 221 | FMainTask.CheckCanceled; 222 | while ( RunningCount >= MaxThreadCount ) do begin 223 | FMainTask.CheckCanceled; 224 | Sleep(100); 225 | end; 226 | 227 | With Item do begin 228 | if CanStart(Item) then begin 229 | 230 | if Assigned(OnStartDownloader) then begin 231 | if SynchronizeEvents then 232 | TThread.Synchronize(TThread.Current, procedure begin OnStartDownloader(Self, Item) end) 233 | else 234 | OnStartDownloader(Self, Item); 235 | end; 236 | 237 | try 238 | Start; 239 | except 240 | On E: EXception do begin 241 | SyncLog(E, 'Exception: Downloader On Start: '); 242 | end; 243 | end; 244 | 245 | end; 246 | end; 247 | 248 | end; 249 | 250 | while ( RunningCount > 0 ) do begin 251 | FMainTask.CheckCanceled; 252 | sleep(10); 253 | Update; 254 | if LoadersUpdated then begin 255 | Break; 256 | end; 257 | end; 258 | 259 | end; 260 | 261 | finally 262 | 263 | for I := 0 to Loaders.Count - 1 do begin 264 | if Loaders[I].IsRunning then 265 | Loaders.items[I].AbortRequest; 266 | end; 267 | 268 | while ( RunningCount > 0 ) do 269 | sleep(50); 270 | 271 | Loaders.Free; 272 | //SyncLog('Exit from TNBoxDownloadManager main thread'); 273 | FLock.enter; 274 | try 275 | if not FNowDestroy then begin 276 | Count := FQueue.Count; 277 | 278 | if ( Count > 0 ) then 279 | StartMainTask 280 | else 281 | FMainTask := nil; 282 | end; 283 | finally 284 | FLock.Leave; 285 | end; 286 | 287 | end; 288 | except 289 | 290 | On E: EOperationCancelled do begin 291 | // ignore 292 | end; 293 | 294 | On E: exception do begin 295 | SyncLog(E, 'TNBoxDownloadManager: '); 296 | end; 297 | 298 | end; 299 | end); 300 | FmainTask.Start; 301 | end; 302 | 303 | 304 | end. 305 | -------------------------------------------------------------------------------- /source/NsfwBoxFileSystem.pas: -------------------------------------------------------------------------------- 1 | unit NsfwBoxFileSystem; 2 | 3 | interface 4 | uses 5 | Classes, SysUtils, Types, system.IOUtils, system.Hash; 6 | 7 | type 8 | 9 | TNBoxPath = class 10 | public 11 | {$IFDEF MSWINDOWS} 12 | class function GetAppPath: string; static; 13 | {$ENDIF} 14 | class function GetCachePath: string; static; 15 | class function GetAppMainPath: string; static; 16 | class function GetThemesPath: string; static; 17 | class function GetThumbnailsPath: string; static; 18 | class function GetThumbnailByUrl(AUrl: string): string; static; 19 | class function GetLibPath(ALibFilename: string): string; static; 20 | class procedure CreateThumbnailsDir; static; 21 | end; 22 | 23 | TSearchRecAr = TArray; 24 | 25 | 26 | function GetFiles(APath: string = ''; AType: integer = faAnyFile): TSearchRecAr; 27 | 28 | 29 | implementation 30 | 31 | function GetFiles(APath: string; AType: integer): TSearchRecAr; 32 | var 33 | Sr: TSearchRec; 34 | begin 35 | Result := []; 36 | if FindFirst(APath + '*.*', AType, Sr) = 0 then begin 37 | Repeat 38 | Result := Result + [Sr]; 39 | Until FindNext(Sr) <> 0; 40 | FindClose(Sr); 41 | end; 42 | end; 43 | 44 | { TNBoxPath } 45 | 46 | class procedure TNBoxPath.CreateThumbnailsDir; 47 | begin 48 | if not DirectoryExists(TNBoxPath.GetThumbnailsPath) then 49 | CreateDir(TNBoxPath.GetThumbnailsPath); 50 | end; 51 | 52 | class function TNBoxPath.GetAppMainPath: string; 53 | begin 54 | {$IFDEF MSWINDOWS} 55 | Result := TNBoxPath.GetAppPath; 56 | {$ENDIF} 57 | 58 | {$IFDEF ANDROID} 59 | Result := Tpath.GetDocumentsPath; 60 | {$ENDIF} 61 | end; 62 | 63 | {$IFDEF MSWINDOWS} 64 | class function TNBoxPath.GetAppPath: string; 65 | begin 66 | Result := ExtractFilePath(ParamStr(0)); 67 | end; 68 | {$ENDIF} 69 | 70 | class function TNBoxPath.GetCachePath: string; 71 | begin 72 | {$IFDEF MSWINDOWS} 73 | Result := TNBoxPath.GetAppMainPath; 74 | {$ENDIF} 75 | 76 | {$IFDEF ANDROID} 77 | Result := TPath.GetCachePath; 78 | {$ENDIF} 79 | end; 80 | 81 | class function TNBoxPath.GetLibPath(ALibFilename: string): string; 82 | begin 83 | {$IFDEF ANDROID} 84 | Result := TPath.Combine(TPath.GetDocumentsPath, 'libs'); 85 | Result := TPath.Combine(Result, ALibFilename); 86 | {$ENDIF} 87 | 88 | {$IFDEF MSWINDOWS} 89 | Result := ''; 90 | {$ENDIF} 91 | end; 92 | 93 | class function TNBoxPath.GetThemesPath: string; 94 | begin 95 | Result := TPath.Combine(TNBoxPath.GetAppMainPath, 'themes'); 96 | end; 97 | 98 | class function TNBoxPath.GetThumbnailByUrl(AUrl: string): string; 99 | var 100 | FileExt: string; 101 | begin 102 | FileExt := TPath.GetExtension(AUrl); 103 | Result := THashMD5.GetHashString(AUrl) + FileExt; 104 | Result := TPath.Combine(TNBoxPath.GetThumbnailsPath, Result); 105 | end; 106 | 107 | class function TNBoxPath.GetThumbnailsPath: string; 108 | begin 109 | Result := TPath.Combine(TNBoxPath.GetCachePath, 'thumbnails'); 110 | end; 111 | 112 | end. -------------------------------------------------------------------------------- /source/NsfwBoxGraphics.Browser.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxGraphics.Browser; 3 | 4 | interface 5 | uses 6 | SysUtils, Types, System.UITypes, Classes, 7 | System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, 8 | Fmx.Scroller, System.Threading, System.Generics.Collections, Net.HttpClient, 9 | Net.HttpClientComponent, NsfwBoxFileSystem, 10 | // Alcinoe 11 | AlFmxGraphics, AlFmxObjects, 12 | // NsfwBox 13 | NsfwBoxInterfaces, NsfwBoxContentScraper, NsfwBoxOriginPseudo, 14 | NsfwBoxOriginNsfwXxx, NsfwBoxGraphics, NsfwBoxOriginConst, 15 | NsfwBoxBookmarks, NsfwBoxOriginR34App; 16 | 17 | type 18 | 19 | TBrowserItemCreateEvent = procedure (Sender: TObject; var AItem: TNBoxCardBase) of object; 20 | TScraperCreateEvent = procedure (Sender: TObject; var AScraper: TNBoxScraper) of object; 21 | 22 | TNBoxBrowser = class(TMultiLayoutScroller) 23 | protected 24 | type 25 | TBrowserTh = Class; 26 | TBrowserSubTh = class(TThread) 27 | public 28 | Owner: TBrowserTh; 29 | Item: IHasOrigin; 30 | procedure Execute; override; 31 | procedure OnRecievData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var AAbort: Boolean); 32 | end; 33 | TBrowserTh = Class(TThread) 34 | public 35 | Owner: TNBoxBrowser; 36 | Request: INBoxSearchRequest; 37 | MaxThreadsCount: integer; 38 | procedure Execute; override; 39 | destructor Destroy; override; 40 | End; 41 | 42 | TBrowserThList = TObjectList; 43 | private 44 | FThreads: TBrowserThList; 45 | FMaxParallelThumbLoaders: integer; 46 | FRequest: INBoxSearchRequest; 47 | FOnItemCreate: TBrowserItemCreateEvent; 48 | FOnWebClientCreate: TWebClientSetEvent; 49 | FOnScraperCreate: TScraperCreateEvent; 50 | FOnRequestChanged: TNotifyEvent; 51 | FBeforeBrowse: TNotifyEvent; 52 | procedure SetRequest(const value: INBoxSearchRequest); 53 | public 54 | Items: TNBoxCardObjList; 55 | function NewItem: TNBoxCardBase; 56 | procedure GoBrowse; 57 | procedure GoNextPage; 58 | procedure TerminateThreads; 59 | procedure WaitForThreads; 60 | procedure Clear; 61 | property Request: INBoxSearchRequest read FRequest write SetRequest; 62 | property MaxParallelThumbLoaders: integer read FMaxParallelThumbLoaders write FMaxParallelThumbLoaders; 63 | property BeforeBrowse: TNotifyEvent read FBeforeBrowse write FBeforeBrowse; 64 | property OnItemCreate: TBrowserItemCreateEvent read FOnItemCreate write FOnItemCreate; 65 | property OnScraperCreate: TScraperCreateEvent read FOnScraperCreate write FOnScraperCreate; 66 | property OnWebClientCreate: TWebClientSetEvent read FOnWebClientCreate write FOnWebClientCreate; 67 | property OnRequestChanged: TNotifyEvent read FOnRequestChanged write FOnRequestChanged; 68 | constructor Create(Aowner: Tcomponent); override; 69 | destructor Destroy; override; 70 | end; 71 | 72 | TNBoxBrowserList = TList; 73 | 74 | implementation 75 | uses unit1; 76 | 77 | { TNsfwBoxBrowser } 78 | 79 | constructor TNBoxBrowser.Create(Aowner:Tcomponent); 80 | begin 81 | Inherited create(Aowner); 82 | FOnScraperCreate := nil; 83 | FBeforeBrowse := nil; 84 | FOnWebClientCreate := nil; 85 | FOnRequestChanged := nil; 86 | FThreads := TBrowserThList.Create; 87 | items := TNBoxCardObjList.Create; 88 | LayoutIndent := 20; 89 | MultiLayout.PlusHeight := LayoutIndent; 90 | MultiLayout.BlockCount := 2; 91 | FMaxParallelThumbLoaders := 5; 92 | FRequest := TNBoxSearchReqNsfwXxx.create; 93 | end; 94 | 95 | procedure TNBoxBrowser.SetRequest(const value: INBoxSearchRequest); 96 | var 97 | New: INBoxSearchRequest; 98 | begin 99 | 100 | if Assigned(value) then 101 | New := value 102 | else 103 | New := TNBoxSearchReqNsfwXxx.Create; 104 | 105 | if Assigned(FRequest) then 106 | TObject(FRequest).Free; 107 | 108 | FRequest := new; 109 | 110 | if Assigned(OnRequestChanged) then 111 | OnRequestChanged(Self); 112 | end; 113 | 114 | 115 | procedure TNBoxBrowser.TerminateThreads; 116 | var 117 | I: integer; 118 | begin 119 | if ( FThreads.Count < 1 ) then 120 | exit; 121 | for I := 0 to ( FThreads.Count - 1 ) do begin 122 | FThreads.Items[I].Terminate; 123 | end; 124 | end; 125 | 126 | procedure TNBoxBrowser.WaitForThreads; 127 | var 128 | I: integer; 129 | begin 130 | if FThreads.Count < 1 then 131 | exit; 132 | 133 | for I := 0 to FThreads.Count - 1 do begin 134 | FThreads.Items[I].WaitFor; 135 | end; 136 | 137 | FThreads.Clear; 138 | end; 139 | 140 | Destructor TNBoxBrowser.Destroy; 141 | begin 142 | self.Clear; 143 | items.Free; 144 | inherited Destroy; 145 | end; 146 | 147 | procedure TNBoxBrowser.GoBrowse; 148 | var 149 | Th: TBrowserTh; 150 | begin 151 | if Assigned(BeforeBrowse) then 152 | BeforeBrowse(Self); 153 | 154 | Th := TBrowserTh.Create(true); 155 | Th.Owner := Self; 156 | Th.Request := Self.Request.Clone; 157 | Th.MaxThreadsCount := Self.MaxParallelThumbLoaders; 158 | Th.FreeOnTerminate := false; 159 | Th.Start; 160 | FThreads.Add(Th); 161 | while not Th.Started do begin 162 | sleep(1); 163 | end; 164 | end; 165 | 166 | procedure TNBoxBrowser.GoNextPage; 167 | begin 168 | Request.PageId := Request.PageId + 1; 169 | if Assigned(OnRequestChanged) then 170 | OnRequestChanged(Self); 171 | self.GoBrowse; 172 | end; 173 | 174 | function TNBoxBrowser.NewItem: TNBoxCardBase; 175 | begin 176 | Result := TNBoxCardSimple.Create(self); 177 | Items.Add(Result); 178 | Self.MultiLayout.AddControl(Result); 179 | if Assigned(OnItemCreate) then 180 | OnItemCreate(Self, Result); 181 | end; 182 | 183 | 184 | procedure TNBoxBrowser.Clear; 185 | var 186 | I: integer; 187 | begin 188 | try 189 | TerminateThreads; 190 | WaitForThreads; 191 | 192 | if items.Count > 0 then begin 193 | items.Clear; 194 | MultiLayout.RecalcSize; 195 | MultiLayout.BlockPos := 0; 196 | end; 197 | except 198 | On E:Exception do 199 | SyncLog(E, 'TNBoxBrowser.clear: '); 200 | end; 201 | end; 202 | 203 | 204 | { TNBoxBrowser.TBrowserSubTh } 205 | 206 | procedure TNBoxBrowser.TBrowserSubTh.Execute; 207 | var 208 | Web: TNetHttpClient; 209 | Fetched: TStream; 210 | FName: string; 211 | CachedThumb: string; 212 | LItm: TNBoxCardBase; 213 | B: TNBoxBrowser; 214 | LPost: INBoxItem; 215 | LRequest: INBoxSearchRequest; 216 | LBookmark: TNBoxBookmark; 217 | BadThumb: boolean; 218 | Msg: string; 219 | Response: IHttpResponse; 220 | 221 | function IsValidImg(ARes: IHttpResponse): boolean; 222 | var 223 | I, C: integer; 224 | ContentType: string; 225 | const 226 | NotImageTypes: TArray = ['text', 'html', 'json']; 227 | begin 228 | Result := true; 229 | //Unit1.SyncLog(ARes.HeaderValue['Content-Type']); 230 | ContentType := ARes.HeaderValue['Content-Type']; 231 | for I := 0 to High(NotImageTypes) - 1 do begin 232 | if ( pos(NotImageTypes[I].ToUpper, ContentType.ToUpper) > 0 ) then begin 233 | Result := false; 234 | break; 235 | end; 236 | end; 237 | end; 238 | 239 | begin 240 | try 241 | try 242 | Fetched := nil; 243 | web := nil; 244 | LBookmark := nil; 245 | LPost := nil; 246 | LRequest := nil; 247 | Msg := ''; 248 | BadThumb := false; 249 | B := Owner.Owner; 250 | CachedThumb := ''; 251 | 252 | if Supports(Item, INBoxItem) then begin 253 | LPost := ( Item as INBoxItem ) 254 | end else if ( Item is TNBoxBookmark ) then begin 255 | LBookmark := TNBoxBookmark(Item); 256 | if ( LBookmark.BookmarkType = TNBoxBookmarkType.Content ) then 257 | LPost := LBookmark.AsItem 258 | else if ( LBookmark.BookmarkType = SearchRequest ) then 259 | LRequest := LBookmark.AsRequest; 260 | end; 261 | 262 | if Assigned(LPost) then 263 | CachedThumb := TNBoxPath.GetThumbnailByUrl(LPost.ThumbnailUrl); 264 | 265 | if Assigned(LPost) and FileExists(CachedThumb) then begin 266 | while ( not Self.Terminated ) do begin 267 | try 268 | Fetched := TFileStream.Create(CachedThumb, FmOpenRead); //!! 269 | break; 270 | except 271 | Sleep(100); 272 | end; 273 | end; 274 | end else if not ( Item.Origin = ORIGIN_PSEUDO ) and Assigned(LPost) then begin 275 | 276 | Web := TNetHttpClient.Create(nil); 277 | 278 | Self.Synchronize( 279 | procedure begin 280 | if Assigned(B.OnWebClientCreate) then begin 281 | B.OnWebClientCreate(B, Web, Item.Origin); 282 | end; 283 | end); 284 | 285 | Web.SynchronizeEvents := false; 286 | Web.OnReceiveData := OnRecievData; 287 | Web.OnSendData := OnRecievData; 288 | Web.Asynchronous := false; 289 | 290 | try 291 | 292 | Response := Web.Get(LPost.ThumbnailUrl); 293 | Fetched := Response.ContentStream; 294 | BadThumb := ( not IsValidImg(Response)); 295 | 296 | if not BadThumb then begin 297 | TNBoxPath.CreateThumbnailsDir; 298 | (Fetched as TMemoryStream).SaveToFile(CachedThumb); 299 | end; 300 | 301 | except 302 | on E: Exception do begin 303 | Msg := E.ClassName + ': ' + E.Message; 304 | SyncLog(E, 'Fetch thumbnail: '); 305 | Fetched := nil; 306 | end; 307 | end; 308 | end; 309 | 310 | if Terminated then 311 | exit; 312 | 313 | Self.Synchronize( 314 | procedure 315 | var 316 | I: integer; 317 | begin 318 | LItm := B.NewItem; 319 | With LItm do begin 320 | 321 | if Assigned(LBookmark) then 322 | LItm.Item := LBookmark 323 | else 324 | LItm.Item := LPost.Clone; 325 | 326 | try 327 | 328 | if Assigned(Fetched) then begin 329 | // when got thumbnail 330 | try 331 | if not BadThumb then 332 | SetThumbnail(Fetched); 333 | except 334 | on E: Exception do begin 335 | Log(E, 'TNBoxBrowser.TBrowserSubTh.Execute item sync SetThumbnail: '); 336 | BadThumb := true; 337 | end; 338 | end; 339 | end else begin 340 | // when not 341 | if Assigned(LPost) then begin 342 | if Fileexists(LPost.ThumbnailUrl) then 343 | SetThumbnail(LPost.ThumbnailUrl) 344 | else if ( not Msg.IsEmpty ) then begin 345 | 346 | 347 | end; 348 | end else if Assigned(LRequest) then begin 349 | Size.Height := Size.Width * 1; 350 | end; 351 | end; 352 | 353 | if BadThumb then begin 354 | Fill.Kind := TBrushKind.Solid; 355 | end; 356 | 357 | Visible := true; 358 | 359 | if Assigned(LItm.OnResize) then 360 | LItm.OnResize(LItm); 361 | 362 | except 363 | on E: Exception do 364 | Log(E, 'TNBoxBrowser.TBrowserSubTh.Execute item sync: '); 365 | end; 366 | end; 367 | 368 | B.MultiLayout.ReCalcBlocksSize; 369 | end); 370 | 371 | finally 372 | if (Fetched is TFileStream) then Fetched.Free; 373 | if Assigned(Web) then Web.Free; 374 | end; 375 | except 376 | on E: Exception do 377 | SyncLog(E, 'TNBoxBrowser.TBrowserSubTh.Execute: '); 378 | end; 379 | end; 380 | 381 | procedure TNBoxBrowser.TBrowserSubTh.OnRecievData(const Sender: TObject; 382 | AContentLength, AReadCount: Int64; var AAbort: Boolean); 383 | begin 384 | if Self.Terminated then 385 | AAbort := true; 386 | end; 387 | 388 | { TNBoxBrowser.TBrowserTh } 389 | 390 | destructor TNBoxBrowser.TBrowserTh.Destroy; 391 | begin 392 | if Assigned(Request) then 393 | ( Request as TInterfacedPersistent ).Free; 394 | end; 395 | 396 | procedure TNBoxBrowser.TBrowserTh.Execute; 397 | var 398 | I: integer; 399 | Subs: TObjectList; 400 | Scraper: TNBoxScraper; 401 | Content: INBoxHasOriginList; 402 | Fetched: boolean; 403 | 404 | function NotFinishedCount: integer; 405 | var 406 | N: integer; 407 | begin 408 | Result := 0; 409 | for N := 0 to Subs.Count - 1 do begin 410 | if not Subs.Items[N].Finished then 411 | Inc(Result); 412 | end; 413 | end; 414 | 415 | function IsNeedToBeSync: boolean; 416 | begin 417 | Result := ( Request.Origin = ORIGIN_BOOKMARKS ); 418 | end; 419 | 420 | begin 421 | try 422 | Fetched := false; 423 | Subs := TObjectList.create; 424 | Scraper := TNBoxScraper.Create; 425 | Content := INBoxHasOriginList.Create; 426 | 427 | self.Synchronize(procedure begin 428 | if Assigned(Owner.OnWebClientCreate) then 429 | Scraper.OnWebClientSet := Owner.OnWebClientCreate; 430 | 431 | if Assigned(Owner.OnScraperCreate) then 432 | Owner.OnScraperCreate(Self.Owner, Scraper); 433 | end); 434 | 435 | if Terminated then 436 | exit; 437 | 438 | try 439 | 440 | if IsNeedToBeSync then begin 441 | Synchronize(procedure begin Fetched := Scraper.GetContent(Request, Content); end); 442 | end else begin 443 | Fetched := Scraper.GetContent(Request, Content); 444 | end; 445 | 446 | if not Fetched then 447 | exit; 448 | 449 | except 450 | on E: Exception do begin 451 | SyncLog(E, 'Origin: ' + Request.Origin.ToString + ' Browser Main thread -> Scraper.GetContent: '); 452 | exit; 453 | end; 454 | end; 455 | 456 | for I := 0 to Content.Count - 1 do begin 457 | if Terminated then 458 | exit; 459 | 460 | while ( NotFinishedCount >= MaxThreadsCount ) do begin 461 | if Terminated then 462 | exit; 463 | Sleep(10); 464 | end; 465 | 466 | var Th: TBrowserSubTh; 467 | Th := TBrowserSubTh.Create(true); 468 | Th.Owner := Self; 469 | Th.Item := Content.Items[I]; 470 | Th.FreeOnTerminate := false; 471 | Subs.Add(Th); 472 | Th.Start; 473 | while not Th.Started do 474 | sleep(1); 475 | end; 476 | 477 | finally 478 | if Terminated then begin 479 | for I := 0 to Subs.Count - 1 do begin 480 | Subs.Items[I].Terminate; 481 | end; 482 | end; 483 | 484 | for I := 0 to Subs.Count - 1 do begin 485 | while not Subs.Items[I].Finished do 486 | sleep(10); 487 | end; 488 | 489 | Scraper.Free; 490 | Content.Free; 491 | Subs.Free; 492 | end; 493 | end; 494 | 495 | end. 496 | -------------------------------------------------------------------------------- /source/NsfwBoxGraphics.Rectangle.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxGraphics.Rectangle; 3 | 4 | interface 5 | uses 6 | SysUtils, System.Types, System.UITypes, Classes, 7 | FMX.Types, FMX.Controls, FMX.Graphics, 8 | FMX.TextLayout, FMX.MultiResBitmap, 9 | FMX.ActnList, AlFmxObjects, AlFmxGraphics, system.generics.collections; 10 | 11 | type 12 | 13 | TRectText = class(TAlRectangle) 14 | public 15 | Text: TAlText; 16 | constructor Create(AOwner: TComponent); override; 17 | destructor Destroy; override; 18 | end; 19 | 20 | TRectButton = class(TRectText) 21 | protected 22 | procedure Paint; override; 23 | procedure DoMouseEnter; override; 24 | procedure DoMouseLeave; override; 25 | private 26 | FFillDef: TBrush; 27 | FStrokeDef: TStrokeBrush; 28 | FFillMove: TBrush; 29 | FStrokeMove: TStrokeBrush; 30 | procedure SetFillDef(const Value: Tbrush); 31 | procedure SetFillMove(const Value: Tbrush); 32 | procedure SetStrokeDef(const Value: TStrokeBrush); 33 | procedure SetStrokeMove(const Value: TStrokeBrush); 34 | public 35 | Image: TAlImage; 36 | property FillDef: Tbrush read FFillDef write SetFillDef; 37 | property StrokeDef: TStrokeBrush read FStrokeDef write SetStrokeDef; 38 | property FillMove: Tbrush read FFillMove write SetFillMove; 39 | property StrokeMove: TStrokeBrush read FStrokeMove write SetStrokeMove; 40 | constructor Create(AOwner: TComponent); override; 41 | destructor Destroy; override; 42 | end; 43 | 44 | TRectTextCheck = class(TRectText, IIsChecked) 45 | protected 46 | FOnChanged: TNotifyEvent; 47 | FCheckedBrush: Tbrush; 48 | FUnCheckedBrush: Tbrush; 49 | FCheckedStrokeBrush: TStrokeBrush; 50 | FUnCheckedStrokeBrush: TStrokeBrush; 51 | FIsChecked: boolean; 52 | procedure OnTapOverride(sender: TObject; const APoint: TPointF); 53 | procedure SetCheckedBrush(const A: Tbrush); 54 | procedure SetUnCheckedBrush(const A: Tbrush); 55 | procedure SetCheckedStokeBrush(const A: TStrokeBrush); 56 | procedure SetUnCheckedStokeBrush(const A: TStrokeBrush); 57 | procedure OnBrushChanged(Sender: TObject); 58 | procedure UpdateBrush; 59 | procedure Click; override; 60 | function GetIsChecked: Boolean; virtual; 61 | procedure SetIsChecked(const Value: Boolean); virtual; 62 | function IsCheckedStored: Boolean; 63 | public 64 | Constructor Create(Aowner: tcomponent); override; 65 | Destructor Destroy; override; 66 | published 67 | property IsChecked: Boolean read GetIsChecked write SetIsChecked default false; 68 | property FillChecked: Tbrush read FCheckedBrush write SetCheckedBrush; 69 | property FillUnChecked: Tbrush read FUnCheckedBrush write SetUnCheckedBrush; 70 | property StrokeChecked: TStrokeBrush read FCheckedStrokeBrush write SetCheckedStokeBrush; 71 | property StrokeUnchecked: TStrokeBrush read FUnCheckedStrokeBrush write SetUnCheckedStokeBrush; 72 | property OnChanged: TNotifyEvent read FOnChanged Write FOnChanged; 73 | end; 74 | 75 | TIsCheckedList = TList; 76 | 77 | implementation 78 | 79 | Constructor TRectTextCheck.Create(Aowner: tcomponent); 80 | begin 81 | inherited create(Aowner); 82 | FIsChecked := false; 83 | FCheckedBrush := tbrush.Create(Fill.Kind, fill.Color); 84 | FUnCheckedBrush := tbrush.Create(Fill.Kind, fill.Color); 85 | FCheckedStrokeBrush := TStrokeBrush.Create(Fill.Kind, stroke.Color); 86 | FUnCheckedStrokeBrush := TStrokeBrush.Create(Fill.Kind, stroke.Color); 87 | FCheckedStrokeBrush.OnChanged := self.OnBrushChanged; 88 | FUnCheckedStrokeBrush.OnChanged := self.OnBrushChanged; 89 | FCheckedBrush.OnChanged := self.OnBrushChanged; 90 | FUnCheckedBrush.OnChanged := Self.OnBrushChanged; 91 | OnTap := OnTapOverride; 92 | ISChecked := false; 93 | Cursor := CrHandPoint; 94 | end; 95 | 96 | procedure TRectTextCheck.UpdateBrush; 97 | begin 98 | if isChecked then begin 99 | Fill := FCheckedBrush; 100 | Stroke := FCheckedStrokeBrush; 101 | end else begin 102 | Fill := FUnCheckedBrush; 103 | Stroke := FUnCheckedStrokeBrush; 104 | end; 105 | end; 106 | 107 | procedure TRectTextCheck.OnBrushChanged(Sender: tobject); 108 | begin 109 | UpdateBrush; 110 | end; 111 | 112 | Destructor TRectTextCheck.Destroy; 113 | begin 114 | FCheckedBrush.Free; 115 | FUnCheckedBrush.Free; 116 | FCheckedStrokeBrush.Free; 117 | FUnCheckedStrokeBrush.Free; 118 | inherited; 119 | end; 120 | 121 | procedure TRectTextCheck.SetIsChecked(const Value: Boolean); 122 | begin 123 | if Value = FIsChecked then exit; 124 | FIsChecked := value; 125 | UpdateBrush; 126 | if assigned(FOnChanged) then FOnChanged(Self); 127 | end; 128 | 129 | function TRectTextCheck.IsCheckedStored: Boolean; 130 | begin 131 | Result := true; 132 | end; 133 | 134 | function TRectTextCheck.GetIsChecked: Boolean; 135 | begin 136 | Result := FiSChecked; 137 | end; 138 | 139 | procedure TRectTextCheck.OnTapOverride(sender: TObject; const APoint: tpointf); 140 | begin 141 | {$IFDEF ANDROID} 142 | if Enabled then 143 | IsChecked := (Not IsChecked); 144 | {$ENDIF} 145 | end; 146 | 147 | procedure TRectTextCheck.SetCheckedBrush(const A: Tbrush); 148 | begin 149 | FCheckedBrush.Assign(A); 150 | UpdateBrush; 151 | end; 152 | 153 | procedure TRectTextCheck.SetCheckedStokeBrush(const A: TStrokeBrush); 154 | begin 155 | FCheckedStrokeBrush.Assign(A); 156 | UpdateBrush; 157 | end; 158 | 159 | procedure TRectTextCheck.SetUnCheckedBrush(const A: Tbrush); 160 | begin 161 | FUnCheckedBrush.Assign(A); 162 | UpdateBrush; 163 | end; 164 | 165 | procedure TRectTextCheck.SetUnCheckedStokeBrush(const A: TStrokeBrush); 166 | begin 167 | FUnCheckedStrokeBrush.Assign(A); 168 | UpdateBrush; 169 | end; 170 | 171 | procedure TRectTextCheck.Click; 172 | begin 173 | {$IFDEF MSWINDOWS} 174 | if Enabled then 175 | IsChecked := (Not IsChecked); 176 | {$ENDIF} 177 | inherited; 178 | end; 179 | 180 | { TRectText } 181 | 182 | constructor TRectText.Create(AOwner: TComponent); 183 | begin 184 | inherited; 185 | Text := TAlText.create(self); 186 | Text.parent := self; 187 | Text.align := TAlignlayout.client; 188 | Text.hittest := false; 189 | end; 190 | 191 | destructor TRectText.Destroy; 192 | begin 193 | Text.free; 194 | inherited; 195 | end; 196 | 197 | { TRectButton } 198 | 199 | constructor TRectButton.Create(AOwner: TComponent); 200 | begin 201 | inherited; 202 | Cursor := CrhandPoint; 203 | FFillMove := tbrush.Create(Fill.Kind, fill.Color); 204 | FStrokeMove := TStrokeBrush.Create(Fill.Kind, stroke.Color); 205 | FFillDef := tbrush.Create(Fill.Kind, fill.Color);; 206 | FStrokeDef := TStrokeBrush.Create(Fill.Kind, stroke.Color); 207 | 208 | Image := TAlImage.Create(Self); 209 | with Image do begin 210 | parent := Self; 211 | Hittest := false; 212 | Align := TAlignLayout.MostLeft; 213 | end; 214 | end; 215 | 216 | destructor TRectButton.Destroy; 217 | begin 218 | FFillMove.Free; 219 | FFillDef.Free; 220 | FStrokeMove.Free; 221 | FStrokedef.Free; 222 | Image.Free; 223 | inherited; 224 | end; 225 | 226 | procedure TRectButton.DoMouseEnter; 227 | begin 228 | inherited; 229 | Repaint; 230 | end; 231 | 232 | procedure TRectButton.DoMouseLeave; 233 | begin 234 | inherited; 235 | Repaint; 236 | end; 237 | 238 | procedure TRectButton.Paint; 239 | begin 240 | if Self.IsMouseOver then begin 241 | Fill := self.FillMove; 242 | Stroke := Self.FStrokeMove; 243 | end else begin 244 | Fill := Self.FillDef; 245 | Stroke := Self.StrokeDef; 246 | end; 247 | inherited; 248 | end; 249 | 250 | procedure TRectButton.SetFillDef(const Value: Tbrush); 251 | begin 252 | FFillDef.Assign(value); 253 | Repaint; 254 | end; 255 | 256 | procedure TRectButton.SetFillMove(const Value: Tbrush); 257 | begin 258 | FFillMove.Assign(value); 259 | Repaint; 260 | end; 261 | 262 | procedure TRectButton.SetStrokeDef(const Value: TStrokeBrush); 263 | begin 264 | FStrokeDef.Assign(Value); 265 | end; 266 | 267 | procedure TRectButton.SetStrokeMove(const Value: TStrokeBrush); 268 | begin 269 | FStrokeMove.Assign(value); 270 | end; 271 | 272 | end. 273 | 274 | -------------------------------------------------------------------------------- /source/NsfwBoxGraphics.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxGraphics; 3 | 4 | interface 5 | uses 6 | SysUtils, Types, System.UITypes, Classes, System.Variants, FMX.Types, 7 | FMX.Controls, FMX.Forms, FMX.Graphics, Fmx.Color, FMX.Objects, FMX.Effects, 8 | FMX.Controls.Presentation, Fmx.StdCtrls, FMX.Layouts, FMX.Edit, 9 | NetHttpClient.Downloader, FMX.EditBox, FMX.NumberBox, NetHttp.Scraper.NsfwXxx, 10 | system.IOUtils, System.Net.URLClient, System.Net.HttpClient, 11 | System.Net.HttpClientComponent, system.Generics.Collections, FMX.Memo.Types, 12 | FMX.ScrollBox, FMX.Memo, ALFmxObjects, ALFmxGraphics, NsfwXxx.Types, 13 | NsfwBoxInterfaces, NsfwBoxOriginNsfwXxx, NsfwBoxOriginR34JsonApi, 14 | NsfwBoxContentScraper, NsfwBoxGraphics.Rectangle, Fmx.ActnList, 15 | NsfwBoxBookmarks, NsfwBoxHelper; 16 | 17 | type 18 | 19 | TNBoxCardBase = class(TAlRectangle) 20 | protected 21 | FItem: IHasOrigin; 22 | FOnAutoLook: TNotifyEvent; 23 | procedure AutoLook; virtual; 24 | function GetPost: INBoxItem; 25 | procedure SetItem(Value: IHasOrigin); virtual; 26 | function GetBookmark: TNBoxBookmark; 27 | public 28 | procedure SetThumbnail(AStream: TStream); overload; virtual; abstract; 29 | procedure SetThumbnail(AFilename: string); overload; virtual; abstract; 30 | property Item: IHasOrigin read FItem write SetItem; 31 | property Post: INBoxItem Read GetPost; 32 | property Bookmark: TNBoxBookmark read GetBookmark; 33 | property OnAutoLook: TNotifyEvent read FOnAutoLook write FOnAutoLook; 34 | function HasPost: boolean; 35 | function HasBookmark: boolean; 36 | Constructor Create(Aowner: TComponent); override; 37 | Destructor Destroy; override; 38 | end; 39 | 40 | TNBoxCardObjList = TObjectlist; 41 | 42 | TNBoxCardSimple = class(TNBoxCardBase) 43 | protected 44 | procedure AutoLook; override; 45 | procedure SetItem(Value: IHasOrigin); override; 46 | public 47 | Text: TAlText; 48 | Rect: TAlRectangle; 49 | procedure SetThumbnail(AStream: TStream); override; 50 | procedure SetThumbnail(AFilename: string); override; 51 | property Item; 52 | property Post; 53 | property Bookmark; 54 | Constructor Create(Aowner: TComponent); override; 55 | Destructor Destroy; override; 56 | end; 57 | 58 | TTagButton = class(Tlayout) 59 | public 60 | Text: TAlText; 61 | Constructor Create(Aowner: Tcomponent); override; 62 | Destructor Destroy; override; 63 | end; 64 | 65 | TNBoxTab = class(TRectButton) 66 | public 67 | CloseBtn: TRectButton; 68 | constructor Create(Aowner: Tcomponent); override; 69 | destructor Destroy; override; 70 | end; 71 | 72 | TNBoxTabList = Tlist; 73 | 74 | TNBoxEdit = class(TAlRectangle) 75 | public 76 | Edit: TEdit; 77 | constructor Create(AOwner: TComponent); override; 78 | destructor Destroy; override; 79 | end; 80 | 81 | TNBoxCheckButton = class(TRectButton, IIsChecked) 82 | private 83 | function GetIsChecked: Boolean; virtual; 84 | procedure SetIsChecked(const Value: Boolean); virtual; 85 | function IsCheckedStored: Boolean; 86 | procedure OnTapOverride(sender: TObject; const APoint: TPointF); 87 | public 88 | Check: TRectTextCheck; 89 | property IsChecked: Boolean read GetIsChecked write SetIsChecked; 90 | constructor Create(AOwner: TComponent); override; 91 | destructor Destroy; override; 92 | end; 93 | 94 | TNBoxRadioButtonMode = (ByOwnerControls); 95 | 96 | TNBoxRadioButton = class(TNBoxCheckButton) 97 | private 98 | FWorkMode: TNBoxRadioButtonMode; 99 | procedure SetIsChecked(const Value: Boolean); override; 100 | public 101 | property WorkMode: TNBoxRadioButtonMode read FWorkMode write FWorkMode; 102 | end; 103 | 104 | 105 | implementation 106 | //uses unit1; 107 | { TNsfwBoxItem } 108 | 109 | procedure TNBoxCardSimple.AutoLook; 110 | begin 111 | if not Assigned(FItem) then exit; 112 | 113 | if HasPost then begin 114 | 115 | if Supports(Post, IHasCaption) then begin 116 | Text.Text := (Post as IHasCaption).Caption; 117 | Rect.Visible := true; 118 | end else 119 | Rect.Visible := false; 120 | 121 | end else if ( HasBookmark and Bookmark.IsRequest ) then begin 122 | 123 | var str: string; 124 | with Bookmark.AsRequest do begin 125 | str := '[' + OriginToStr(Origin) + ']: ' + SLineBreak 126 | + Request + SLineBreak; 127 | 128 | if PageId > 1 then 129 | str := str + 'Page: ' + PageId.ToString; 130 | 131 | str := trim(str); 132 | end; 133 | 134 | Text.Text := str; 135 | Text.Font.Size := 12; 136 | Rect.Visible := true; 137 | Rect.Align := TAlignlayout.Client; 138 | 139 | end; 140 | 141 | Inherited; 142 | end; 143 | 144 | Constructor TNBoxCardSimple.Create(Aowner: Tcomponent); 145 | const 146 | m: single = 4; 147 | begin 148 | Inherited; 149 | Fill.Kind := tbrushkind.Bitmap; 150 | Fill.Bitmap.WrapMode := twrapmode.TileStretch; 151 | Stroke.Kind := tbrushkind.None; 152 | 153 | Rect := TAlRectangle.Create(self); 154 | with Rect do begin 155 | //Fill.Color := getcolor(0, 0, 0, 180); 156 | Align := talignlayout.MostBottom; 157 | Stroke.Kind := tbrushkind.None; 158 | Parent := self; 159 | Padding.Create(trectf.Create(m, m, m, m)); 160 | HitTest := false; 161 | end; 162 | 163 | Text := TAlText.Create(self); 164 | with Text do begin 165 | HitTest := false; 166 | AutoSize := false; 167 | Parent := rect; 168 | Color := talphacolorrec.White; 169 | Align := talignlayout.Top; 170 | WordWrap := true; 171 | TextSettings.VertAlign := TTextalign.Center; 172 | TextSettings.HorzAlign := TtextAlign.Center; 173 | end; 174 | end; 175 | 176 | procedure TNBoxCardSimple.SetItem(Value: IHasOrigin); 177 | begin 178 | inherited; 179 | AutoLook; 180 | end; 181 | 182 | procedure TNBoxCardSimple.SetThumbnail(AFilename: string); 183 | begin 184 | Fill.Kind := TBrushKind.Bitmap; 185 | Fill.Bitmap.Bitmap.LoadFromFile(AFilename); 186 | end; 187 | 188 | procedure TNBoxCardSimple.SetThumbnail(AStream: TStream); 189 | begin 190 | Fill.Kind := TBrushKind.Bitmap; 191 | Fill.Bitmap.Bitmap.LoadFromStream(AStream); 192 | end; 193 | 194 | Destructor TNBoxCardSimple.Destroy; 195 | begin 196 | Text.Free; 197 | Rect.Free; 198 | inherited; 199 | end; 200 | 201 | 202 | { TTagButton } 203 | 204 | Constructor TTagButton.Create(Aowner: Tcomponent); 205 | begin 206 | inherited create(Aowner); 207 | HitTest := true; 208 | margins.Rect := trectf.Create(5, 5, 5, 5); 209 | Text := tAltext.Create(self); 210 | with text do begin 211 | Parent := self; 212 | HitTest := false; 213 | Align := Talignlayout.Contents; 214 | Color := talphacolorrec.White; 215 | textsettings.HorzAlign := ttextalign.Center; 216 | textsettings.VertAlign := ttextalign.Center; 217 | end; 218 | end; 219 | 220 | Destructor TTagButton.Destroy; 221 | begin 222 | Text.Free; 223 | inherited Destroy; 224 | end; 225 | 226 | { TNBoxTab } 227 | 228 | constructor TNBoxTab.Create(Aowner: tcomponent); 229 | begin 230 | inherited create(Aowner); 231 | Closebtn := TRectButton.Create(self); 232 | with closebtn do begin 233 | Parent := self; 234 | Align := talignlayout.MostRight; 235 | Cursor := CrHandPoint; 236 | end; 237 | 238 | with text do begin 239 | Align := talignlayout.Client; 240 | Font.Size := 11; 241 | AutoSize := false; 242 | WordWrap := false; 243 | Margins.Left := 8; 244 | Margins.Right := 4; 245 | HitTest := false; 246 | HorzTextAlign := ttextalign.Leading; 247 | VertTextAlign := ttextalign.Center; 248 | Color := talphacolorrec.White; 249 | end; 250 | 251 | end; 252 | 253 | destructor TNBoxTab.Destroy; 254 | begin 255 | Closebtn.Free; 256 | inherited Destroy; 257 | end; 258 | 259 | 260 | { TNBoxEdit } 261 | 262 | constructor TNBoxEdit.Create(AOwner: TComponent); 263 | begin 264 | inherited; 265 | Padding.Rect := TRectF.Create(4, 4, 4, 4); 266 | 267 | Edit := TEdit.Create(Self); 268 | with edit do begin 269 | Parent := Self; 270 | Align := TAlignlayout.Client; 271 | StyledSettings := []; 272 | end; 273 | end; 274 | 275 | destructor TNBoxEdit.Destroy; 276 | begin 277 | 278 | inherited; 279 | end; 280 | 281 | { TNBoxCheckButton } 282 | 283 | constructor TNBoxCheckButton.Create(AOwner: TComponent); 284 | begin 285 | inherited; 286 | Ontap := OnTapOverride; 287 | 288 | Check := TRectTextCheck.Create(Self); 289 | with Check do begin 290 | Parent := self; 291 | Align := TAlignLayout.Right; 292 | Margins.Rect := TRectF.Create(0, 16, 16, 16); 293 | hitTest := false; 294 | end; 295 | end; 296 | 297 | destructor TNBoxCheckButton.Destroy; 298 | begin 299 | Check.Free; 300 | inherited; 301 | end; 302 | 303 | function TNBoxCheckButton.GetIsChecked: Boolean; 304 | begin 305 | Result := Check.IsChecked; 306 | end; 307 | 308 | function TNBoxCheckButton.IsCheckedStored: Boolean; 309 | begin 310 | Result := true; 311 | end; 312 | 313 | procedure TNBoxCheckButton.OnTapOverride(sender: TObject; 314 | const APoint: TPointF); 315 | begin 316 | IsChecked := ( not IsChecked ); 317 | end; 318 | 319 | procedure TNBoxCheckButton.SetIsChecked(const Value: Boolean); 320 | begin 321 | Check.IsChecked := Value; 322 | end; 323 | 324 | { TNBoxRadioButton } 325 | 326 | procedure TNBoxRadioButton.SetIsChecked(const Value: Boolean); 327 | var 328 | I: integer; 329 | List: TControlList; 330 | begin 331 | inherited; 332 | if ( not IsChecked ) then 333 | exit; 334 | 335 | if WorkMode = ByOwnerControls then begin 336 | List := TControl(Owner).Controls; 337 | for I := 0 to List.Count - 1 do begin 338 | if ( List.Items[I] is TNBoxRadioButton ) then 339 | ( List.Items[I] as IIsChecked ).IsChecked := false; 340 | end; 341 | end; 342 | 343 | end; 344 | 345 | 346 | { TNBoxCard } 347 | 348 | procedure TNBoxCardBase.AutoLook; 349 | begin 350 | if Assigned(OnAutoLook) then 351 | OnAutoLook(Self); 352 | end; 353 | 354 | constructor TNBoxCardBase.Create(Aowner: TComponent); 355 | begin 356 | inherited; 357 | FItem := nil; 358 | end; 359 | 360 | destructor TNBoxCardBase.Destroy; 361 | begin 362 | // if Assigned(FItem) then // !!!! 363 | // ( FItem as TInterfacedPersistent ).Free; 364 | inherited; 365 | end; 366 | 367 | function TNBoxCardBase.GetBookmark: TNBoxBookmark; 368 | begin 369 | if HasBookmark then 370 | Result := (FItem as TNBoxBookmark) 371 | else 372 | Result := nil; 373 | end; 374 | 375 | function TNBoxCardBase.GetPost: INBoxItem; 376 | begin 377 | if not Assigned(FItem) then begin 378 | Result := nil; 379 | exit; 380 | end; 381 | 382 | if ( FItem is TNBoxBookmark ) then begin 383 | if TNBoxBookmark(FItem).BookmarkType = Content then 384 | Result := TNBoxBookmark(FItem).AsItem 385 | else 386 | Result := nil; 387 | end else begin 388 | Result := ( FItem as INBoxItem ); 389 | end; 390 | end; 391 | 392 | function TNBoxCardBase.HasBookmark: boolean; 393 | begin 394 | Result := ( FItem is TNBoxBookmark); 395 | end; 396 | 397 | function TNBoxCardBase.HasPost: boolean; 398 | begin 399 | Result := Assigned(Post); 400 | end; 401 | 402 | procedure TNBoxCardBase.SetItem(Value: IHasOrigin); 403 | begin 404 | if not Assigned(Value) then 405 | exit; 406 | 407 | if Assigned(FItem) then // !!!! 408 | ( FItem as TInterfacedPersistent ).Free; 409 | 410 | // if Supports(Value, INBoxItem) then 411 | // FItem := ( Value as INBoxItem ).Clone // !!!! 412 | // else 413 | // FItem := Value; 414 | FItem := Value; 415 | end; 416 | 417 | end. 418 | -------------------------------------------------------------------------------- /source/NsfwBoxHelper.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxHelper; 3 | 4 | interface 5 | uses 6 | NsfwBoxInterfaces, 7 | NsfwBoxOriginPseudo, NsfwBoxOriginNsfwXxx, NsfwBoxOriginR34App, 8 | NsfwBoxOriginBookmarks, NsfwBoxOriginR34JsonApi, 9 | NsfwBoxOriginGivemepornClub, NsfwBoxOrigin9HentaitoApi, 10 | NsfwBoxOriginCoomerParty, 11 | NsfwBoxOriginConst, 12 | classes, sysutils, NsfwXxx.Types; 13 | 14 | function CreateItemByOrigin(AOrigin: integer): INBoxItem; 15 | function CreateReqByOrigin(AOrigin: integer): INBoxSearchRequest; 16 | function CreateRelatedReq(APost: INBoxItem): INBoxSearchRequest; 17 | function CreateAuthorReq(APost: INBoxItem): INBoxSearchRequest; 18 | function CreateTagReq(AOrigin: integer; ATag: string = ''): INBoxSearchRequest; 19 | 20 | function OriginToStr(AOrigin: integer): string; 21 | 22 | implementation 23 | 24 | function CreateItemByOrigin(AOrigin: integer): INBoxItem; 25 | begin 26 | Case AOrigin of 27 | ORIGIN_NSFWXXX: Result := TNBoxNsfwXxxItem.Create; 28 | ORIGIN_R34APP: Result := TNBoxR34AppItem.Create; 29 | ORIGIN_R34JSONAPI: Result := TNBoxR34JsonApiItem.Create; 30 | ORIGIN_GIVEMEPORNCLUB: Result := TNBoxGmpClubItem.Create; 31 | ORIGIN_PSEUDO: Result := TNBoxPseudoItem.Create; 32 | ORIGIN_9HENTAITO: Result := TNBox9HentaiToItem.Create; 33 | ORIGIN_COOMERPARTY: Result := TNBoxCoomerPartyItem.Create; 34 | end; 35 | end; 36 | 37 | function CreateReqByOrigin(AOrigin: integer): INBoxSearchRequest; 38 | begin 39 | Case AOrigin of 40 | ORIGIN_NSFWXXX: Result := TNBoxSearchReqNsfwXxx.Create; 41 | ORIGIN_R34APP: Result := TNBoxSearchReqR34App.Create; 42 | ORIGIN_R34JSONAPI: Result := TNBoxSearchReqR34JsonApi.Create; 43 | ORIGIN_GIVEMEPORNCLUB: Result := TNBoxSearchReqGmpClub.Create; 44 | ORIGIN_PSEUDO: Result := TNBoxSearchReqPseudo.Create; 45 | ORIGIN_BOOKMARKS: Result := TNBoxSearchReqBookmarks.Create; 46 | ORIGIN_9HENTAITO: Result := TNBoxSearchReq9HentaiTo.Create; 47 | ORIGIN_COOMERPARTY: Result := TNBoxSearchReqCoomerParty.Create; 48 | end; 49 | end; 50 | 51 | function CreateRelatedReq(APost: INBoxItem): INBoxSearchRequest; 52 | begin 53 | if ( APost is TNBoxNsfwxxxitem ) then begin 54 | Result := TNBoxSearchReqNsfwXxx.create; 55 | with ( Result as TNBoxSearchReqNsfwXxx ) do begin 56 | with ( APost as TNBoxNsfwXxxItem ) do begin 57 | Result.Request := Item.PostUrl; 58 | end; 59 | SearchType := TNsfwUrlType.Related; 60 | end; 61 | end else begin 62 | Result := nil; 63 | end; 64 | end; 65 | 66 | function CreateAuthorReq(APost: INBoxItem): INBoxSearchRequest; 67 | begin 68 | Result := nil; 69 | if Supports(APost, IHasAuthor) 70 | and (APost as IHasAuthor).AuthorName.IsEmpty then 71 | exit; 72 | 73 | if ( APost is TNBoxNsfwXxxItem ) then begin 74 | 75 | Result := TNBoxSearchReqNsfwXxx.create; 76 | with ( Result as TNBoxSearchReqNsfwXxx ) do begin 77 | with ( APost as TNBoxNsfwXxxItem ) do 78 | Result.Request := AuthorName; 79 | SearchType := TNsfwUrlType.User; 80 | end; 81 | 82 | end else if ( APost is TNBoxR34AppItem ) then begin 83 | 84 | Result := TNBoxSearchReqR34App.Create; 85 | Result.Request := TNBoxR34AppItem(APost).AuthorName; 86 | 87 | end else if ( APost is TNBoxCoomerPartyItem ) then begin 88 | 89 | var LPost: TNBoxCoomerPartyItem; 90 | var LReq: TNBoxSearchReqCoomerParty; 91 | LReq := TNBoxSearchReqCoomerParty.Create; 92 | LPost := ( APost as TNBoxCoomerPartyItem ); 93 | 94 | LReq.Site := LPost.Site; 95 | LReq.UserId := LPost.Item.Author.Id; 96 | LReq.Service := LPost.Item.Author.Service; 97 | 98 | Result := LReq; 99 | end; 100 | 101 | end; 102 | 103 | function CreateTagReq(AOrigin: integer; ATag: string = ''): INBoxSearchRequest; 104 | begin 105 | Result := CreateReqByOrigin(AOrigin); 106 | Result.Request := ATag; 107 | case AOrigin of 108 | ORIGIN_NSFWXXX: 109 | ( Result as TNBoxSearchReqNsfwXxx ).SearchType := TNsfwUrlType.Category; 110 | ORIGIN_GIVEMEPORNCLUB: 111 | ( Result as TNBoxSearchReqGmpClub ).SearchType := TGmpClubSearchType.Tag; 112 | end; 113 | 114 | end; 115 | 116 | function OriginToStr(AOrigin: integer): string; 117 | begin 118 | Case AOrigin of 119 | ORIGIN_NSFWXXX: Result := 'nsfw.xxx'; 120 | ORIGIN_R34JSONAPI: Result := 'R34-json-api'; 121 | ORIGIN_R34APP: Result := 'R34.app'; 122 | ORIGIN_GIVEMEPORNCLUB: Result := 'givemeporn.club'; 123 | ORIGIN_9HENTAITO: Result := '9hentai.to'; 124 | ORIGIN_COOMERPARTY: Result := '(coomer\kemono).party'; 125 | 126 | ORIGIN_BOOKMARKS: Result := 'Bookmarks'; 127 | ORIGIN_PSEUDO: Result := 'None'; 128 | end; 129 | end; 130 | 131 | end. 132 | -------------------------------------------------------------------------------- /source/NsfwBoxInterfaces.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxInterfaces; 3 | 4 | interface 5 | 6 | uses 7 | System.SysUtils, Classes, System.Generics.Collections, XSuperObject; 8 | 9 | type 10 | {* 11 | IBeautyTemplate = interface 12 | 13 | //--Setters and Getters--// 14 | 15 | //--Properties--// 16 | 17 | end; 18 | *} 19 | 20 | IHasOrigin = interface 21 | ['{59DFFA49-9CB7-49D0-BAF0-6230CEA2F3D5}'] 22 | //--Setters and Getters--// 23 | function GetOrigin: integer; 24 | //--Properties--// 25 | property Origin: integer read GetOrigin; 26 | end; 27 | 28 | IUIdAsInt = interface 29 | ['{2258085A-60A0-4FB0-B68F-C4D3F44285B1}'] 30 | //--Setters and Getters--// 31 | //procedure SetUidInt(const value: int64); 32 | function GetUidInt: int64; 33 | //--Properties--// 34 | property UIdInt: int64 read GetUIdInt; // write SetUIdInt; 35 | end; 36 | 37 | IHasTags = interface 38 | ['{598FEFF0-4DAD-425D-9480-4B78EA3B98FE}'] 39 | //--Setters and Getters--// 40 | // procedure SetTags(const Value: TArray); 41 | function GetTags: TArray; 42 | //--Properties--// 43 | property Tags: TArray read GetTags; // write SetTags; 44 | end; 45 | 46 | IHasAuthor = interface 47 | ['{6DD3C056-7BB6-4022-8AB4-217B2CB4777B}'] 48 | //--Setters and Getters--// 49 | function GetAuthorName: string; 50 | //procedure SetAuthorName(const Value: string); 51 | //--Properties--// 52 | property AuthorName: string read GetAuthorName; // write SetAuthorName; 53 | end; 54 | 55 | IHasCaption = interface 56 | ['{75A5AF4D-D3F4-4919-A742-37684522013C}'] 57 | //--Setters and Getters--// 58 | //procedure SetCaption(const Value: String); 59 | function GetCaption: string; 60 | //--Properties--// 61 | property Caption: string read GetCaption; // write SetCaption; 62 | end; 63 | 64 | IFetchableContent = interface 65 | ['{F3D17945-B4EB-471D-8ACA-3BB30EE25C35}'] 66 | //--Setters and Getters--// 67 | function GetContentFetched: boolean; 68 | //--Properties--// 69 | property ContentFetched: boolean read GetContentFetched; 70 | end; 71 | 72 | IFetchableTags = interface 73 | ['{E90EDD2F-348D-4765-9F8F-C6748AF555BF}'] 74 | //--Setters and Getters--// 75 | function GetTagsFetched: boolean; 76 | //--Properties--// 77 | property TagsFetched: boolean read GetTagsFetched; 78 | end; 79 | 80 | INBoxItem = interface(IHasOrigin) 81 | ['{8AB3F5DB-4DD1-4CD7-BD1C-EE6D35F98270}'] 82 | //--Setters and Getters--// 83 | //procedure SetContentUrls(const Value: TArray); 84 | function GetContentUrls: TArray; 85 | //procedure SetThumbnailUrl(const Value: string); 86 | function GetThumbnailUrl: string; 87 | procedure Assign(ASource: INBoxItem); 88 | function Clone: INBoxItem; 89 | //--Public methods--// 90 | function ContentUrlCount: integer; 91 | function ContentUrl: string; 92 | //--Properties--// 93 | property ThumbnailUrl: string read GetThumbnailUrl; // write SetThumbnailUrl; 94 | property ContentUrls: TArray read GetContentUrls; // write SetContentUrls; 95 | end; 96 | 97 | INBoxItemList = TList; 98 | INBoxHasOriginList = TList; 99 | 100 | TNBoxItemBase = class(TInterfacedPersistent, INBoxItem, IHasOrigin) 101 | protected 102 | FOrigin: Integer; 103 | //procedure SetContentUrls(const Value: TArray); virtual; abstract; 104 | function GetContentUrls: TArray; virtual; abstract; 105 | //procedure SetThumbnailUrl(const Value: string); virtual; abstract; 106 | function GetThumbnailUrl: string; virtual; abstract; 107 | function GetOrigin: integer; virtual; 108 | procedure SetOrigin(const Value: integer); virtual; 109 | public 110 | function ContentUrlCount: integer; virtual; 111 | function ContentUrl: string; virtual; 112 | procedure Assign(ASource: INBoxItem); virtual; abstract; 113 | function Clone: INBoxItem; virtual; abstract; 114 | [DISABLE] property Origin: integer Read GetOrigin write SetOrigin; 115 | [DISABLE] property ThumbnailUrl: string read GetThumbnailUrl; // write SetThumbnailUrl; 116 | [DISABLE] property ContentUrls: TArray read GetContentUrls; // write SetContentUrls; 117 | end; 118 | 119 | INBoxSearchRequest = interface(IHasOrigin) 120 | ['{E4BFD2A5-6D0C-450C-A2F8-F43EE36EB998}'] 121 | //--Setters and Getters--// 122 | function GetRequest: string; 123 | procedure SetRequest(const Value: string); 124 | function GetPageId: integer; 125 | procedure SetPageId(const Value: integer); 126 | function Clone: INBoxSearchRequest; 127 | //--Properties--// 128 | property Request: string read GetRequest write SetRequest; 129 | property PageId: integer read GetPageId write SetPageId; 130 | end; 131 | 132 | TNBoxSearchRequestBase = class(TInterfacedPersistent, INBoxSearchRequest, IHasOrigin) 133 | protected 134 | FRequest: string; 135 | FPageId: integer; 136 | //--Setters and Getters--// 137 | function GetOrigin: integer; virtual; abstract; 138 | function GetRequest: string; 139 | procedure SetRequest(const Value: string); virtual; 140 | function GetPageId: integer; virtual; 141 | procedure SetPageId(const Value: integer); virtual; 142 | procedure SetOrigin(const Value: integer); virtual; 143 | public 144 | function Clone: INBoxSearchRequest; virtual; abstract; 145 | //--Properties--// 146 | property Origin: integer read GetOrigin write SetOrigin; 147 | [DISABLE] property Request: string read GetRequest write SetRequest; 148 | [DISABLE] property PageId: integer read GetPageId write SetPageId; 149 | constructor Create; virtual; 150 | end; 151 | 152 | implementation 153 | 154 | { TNBoxSearchRequestBase } 155 | 156 | constructor TNBoxSearchRequestBase.Create; 157 | begin 158 | PageId := 1; 159 | Request := ''; 160 | end; 161 | 162 | function TNBoxSearchRequestBase.GetPageId: integer; 163 | begin 164 | Result := FPageId; 165 | end; 166 | 167 | function TNBoxSearchRequestBase.GetRequest: string; 168 | begin 169 | Result := FRequest; 170 | end; 171 | 172 | procedure TNBoxSearchRequestBase.SetOrigin(const Value: integer); 173 | begin 174 | 175 | end; 176 | 177 | procedure TNBoxSearchRequestBase.SetPageId(const Value: integer); 178 | begin 179 | FPageId := Value; 180 | end; 181 | 182 | procedure TNBoxSearchRequestBase.SetRequest(const Value: string); 183 | begin 184 | FRequest := Value; 185 | end; 186 | 187 | { TNBoxItemBase } 188 | 189 | function TNBoxItemBase.ContentUrl: string; 190 | begin 191 | if ( ContentUrlCount > 0 ) then 192 | Result := ContentUrls[0] 193 | else 194 | Result := ''; 195 | end; 196 | 197 | function TNBoxItemBase.ContentUrlCount: integer; 198 | begin 199 | Result := Length(ContentUrls); 200 | end; 201 | 202 | function TNBoxItemBase.GetOrigin: integer; 203 | begin 204 | Result := FOrigin; 205 | end; 206 | 207 | procedure TNBoxItemBase.SetOrigin(const Value: integer); 208 | begin 209 | //FOrigin := Value; 210 | end; 211 | 212 | 213 | end. 214 | -------------------------------------------------------------------------------- /source/NsfwBoxOrigin9hentaiToApi.pas: -------------------------------------------------------------------------------- 1 | unit NsfwBoxOrigin9hentaiToApi; 2 | 3 | interface 4 | uses 5 | System.SysUtils, System.Classes, XSuperObject, 6 | Ninehentaito.APITypes, NsfwBoxInterfaces, NsfwBoxOriginConst; 7 | 8 | type 9 | 10 | TNBox9HentaitoItem = class(TNBoxItemBase, IUIdAsInt, IHasTags, IHasCaption) //IBook 11 | private 12 | FItem: T9HentaiBook; 13 | //FCurrentPage: integer; // default = -1 display cover image 14 | function GetTags: TArray; 15 | function GetTagsCount: integer; 16 | function GetCaption: string; 17 | function GetContentUrls: TArray; override; 18 | function GetThumbnailUrl: string; override; 19 | function GetUidInt: int64; 20 | public 21 | procedure Assign(ASource: INBoxItem); override; 22 | function Clone: INBoxItem; override; 23 | //--New--// 24 | property Item: T9HentaiBook read FItem write FItem; 25 | //--Properties--// 26 | property Origin; 27 | [DISABLE] property ThumbnailUrl; 28 | [DISABLE] property ContentUrls; 29 | [DISABLE] property UIdInt: int64 read GetUidInt; 30 | [DISABLE] property Caption: string read GetCaption; 31 | [DISABLE] property Tags: TArray read GetTags; 32 | constructor Create(AWithItem: boolean = true); 33 | destructor Destroy; override; 34 | end; 35 | 36 | TNBoxSearchReq9Hentaito = class(TInterfacedPersistent, INBoxSearchRequest, 37 | IHasOrigin) 38 | protected 39 | FSearchRec: T9HentaiBookSearchRec; 40 | //FIncludedTags: T9HentaiTagAr; 41 | //FExcludedTags: T9HentaiTagAr; 42 | function GetOrigin: integer; 43 | procedure SetOrigin(const value: integer); 44 | procedure SetRequest(const value: string); 45 | function GetRequest: string; 46 | procedure SetPageId(const value: integer); 47 | function GetPageId: integer; 48 | public 49 | function Clone: INBoxSearchRequest; 50 | property Origin: integer read GetOrigin write SetOrigin; 51 | property SearchRec: T9HentaiBookSearchRec read FSearchRec write FSearchRec; 52 | [DISABLE] property Request: string read GetRequest write SetRequest; 53 | [DISABLE] property PageId: integer read GetPageId write SetPageId; 54 | constructor Create; 55 | end; 56 | 57 | implementation 58 | 59 | { TNBoxGmpClubItem } 60 | 61 | procedure TNBox9HentaitoItem.Assign(ASource: INBoxItem); 62 | begin 63 | inherited; 64 | if not ( ASource is TNBox9HentaitoItem ) then 65 | Exit; 66 | with ( ASource as TNBox9HentaitoItem ) do begin 67 | Self.FItem.Id := Item.Id; 68 | Self.FItem.Title := Item.Title; 69 | Self.FItem.AltTitle := Item.AltTitle; 70 | Self.FItem.TotalPage := Item.TotalPage; 71 | Self.FItem.TotalFavorite := Item.TotalFavorite; 72 | Self.FItem.TotalDownload := Item.TotalDownload; 73 | Self.FItem.TotalView := Item.TotalView; 74 | Self.FItem.ImageServer := Item.ImageServer; 75 | Self.FItem.Tags := Item.Tags; 76 | end; 77 | end; 78 | 79 | function TNBox9HentaitoItem.Clone: INBoxItem; 80 | begin 81 | Result := TNBox9HentaitoItem.Create; 82 | Result.Assign(Self); 83 | end; 84 | 85 | constructor TNBox9HentaitoItem.Create(AWithItem: boolean); 86 | begin 87 | FOrigin := ORIGIN_9HENTAITO; 88 | if AWithItem then 89 | FItem := T9HentaiBook.Create; 90 | end; 91 | 92 | destructor TNBox9HentaitoItem.Destroy; 93 | begin 94 | FItem.Free; 95 | inherited; 96 | end; 97 | 98 | function TNBox9HentaitoItem.GetCaption: string; 99 | begin 100 | Result := Item.Title; 101 | end; 102 | 103 | function TNBox9HentaitoItem.GetContentUrls: TArray; 104 | var 105 | I: integer; 106 | begin 107 | SetLength(Result, Item.TotalPage); 108 | for I := 0 to high(Result) do begin 109 | Result[I] := Item.GetImageUrl(I + 1); 110 | end; 111 | end; 112 | 113 | function TNBox9HentaitoItem.GetTags: TArray; 114 | var 115 | I: integer; 116 | begin 117 | SetLength(Result, Length(Item.Tags)); 118 | for I := 0 to High(Result) do 119 | Result[i] := Item.Tags[I].Name; 120 | end; 121 | 122 | function TNBox9HentaitoItem.GetTagsCount: integer; 123 | begin 124 | Result := length(Item.Tags); 125 | end; 126 | 127 | function TNBox9HentaitoItem.GetThumbnailUrl: string; 128 | begin 129 | Result := Item.GetSmallCoverUrl; 130 | end; 131 | 132 | function TNBox9HentaitoItem.GetUidInt: int64; 133 | begin 134 | Result := Item.Id; 135 | end; 136 | 137 | { TNBoxSearchReq9Hentaito } 138 | 139 | function TNBoxSearchReq9Hentaito.Clone: INBoxSearchRequest; 140 | begin 141 | Result := TNBoxSearchReq9Hentaito.Create; 142 | with ( Result as TNBoxSearchReq9Hentaito ) do 143 | SearchRec := Self.FSearchRec; 144 | end; 145 | 146 | constructor TNBoxSearchReq9Hentaito.Create; 147 | begin 148 | FSearchRec := T9HentaiBookSearchRec.New; 149 | end; 150 | 151 | function TNBoxSearchReq9Hentaito.GetOrigin: integer; 152 | begin 153 | Result := ORIGIN_9HENTAITO; 154 | end; 155 | 156 | function TNBoxSearchReq9Hentaito.GetPageId: integer; 157 | begin 158 | Result := FSearchRec.Page; 159 | end; 160 | 161 | function TNBoxSearchReq9Hentaito.GetRequest: string; 162 | begin 163 | Result := FSearchRec.Text; 164 | end; 165 | 166 | procedure TNBoxSearchReq9Hentaito.SetOrigin(const value: integer); 167 | begin 168 | 169 | end; 170 | 171 | procedure TNBoxSearchReq9Hentaito.SetPageId(const value: integer); 172 | begin 173 | FSearchRec.Page := value; 174 | end; 175 | 176 | procedure TNBoxSearchReq9Hentaito.SetRequest(const value: string); 177 | begin 178 | FSearchRec.text := value; 179 | end; 180 | 181 | end. 182 | -------------------------------------------------------------------------------- /source/NsfwBoxOriginBookmarks.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxOriginBookmarks; 3 | 4 | interface 5 | uses 6 | System.SysUtils, System.Classes, NsfwBoxInterfaces, 7 | NsfwBoxOriginConst; 8 | 9 | type 10 | 11 | TNBoxSearchReqBookmarks = class(TNBoxSearchRequestBase) 12 | protected 13 | function GetOrigin: integer; override; 14 | public 15 | function Clone: INBoxSearchRequest; override; 16 | property Origin; 17 | property Request; 18 | property PageId; 19 | end; 20 | 21 | implementation 22 | 23 | { TNBoxSearchReqBookmarks } 24 | 25 | function TNBoxSearchReqBookmarks.Clone: INBoxSearchRequest; 26 | begin 27 | Result := TNBoxSearchReqBookmarks.Create; 28 | with Result do begin 29 | Pageid := self.FPageId; 30 | Request := Self.FRequest; 31 | end; 32 | end; 33 | 34 | function TNBoxSearchReqBookmarks.GetOrigin: integer; 35 | begin 36 | Result := ORIGIN_BOOKMARKS; 37 | end; 38 | 39 | end. 40 | -------------------------------------------------------------------------------- /source/NsfwBoxOriginConst.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxOriginConst; 3 | 4 | interface 5 | 6 | const 7 | ORIGIN_PSEUDO = -2; 8 | ORIGIN_BOOKMARKS = -1; 9 | 10 | ORIGIN_NSFWXXX = 0; 11 | ORIGIN_R34JSONAPI = 1; 12 | ORIGIN_R34APP = 2; 13 | ORIGIN_GIVEMEPORNCLUB = 3; 14 | ORIGIN_9HENTAITO = 4; 15 | ORIGIN_COOMERPARTY = 5; 16 | 17 | implementation 18 | 19 | end. 20 | -------------------------------------------------------------------------------- /source/NsfwBoxOriginCoomerParty.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxOriginCoomerParty; 3 | 4 | interface 5 | uses 6 | System.SysUtils, System.Classes, XSuperObject, 7 | CoomerParty.Types, CoomerParty.Scraper, 8 | NsfwBoxInterfaces, NsfwBoxOriginConst; 9 | 10 | type 11 | 12 | //TCoomerPartySite = (CoomerParty, KemonoParty); 13 | 14 | TNBoxCoomerPartyItem = class(TNBoxItemBase, IUIdAsInt, IHasCaption, 15 | IHasAuthor, IFetchableContent) 16 | private 17 | FSite: String; 18 | FId: int64; 19 | FItem: TPartyPostPage; 20 | function GetContentUrls: TArray; override; 21 | function GetThumbnailUrl: string; override; 22 | function GetContentFetched: boolean; 23 | function GetCaption: string; 24 | function GetUidInt: int64; 25 | function GetAuthorName: string; 26 | public 27 | procedure Assign(ASource: INBoxItem); override; 28 | function Clone: INBoxItem; override; 29 | //--New--// 30 | property Item: TPartyPostPage read FItem write FItem; 31 | property Site: String read FSite write FSite; 32 | //--Properties--// 33 | property Origin; 34 | [DISABLE] property ThumbnailUrl; 35 | [DISABLE] property ContentUrls; 36 | [DISABLE] property AuthorName: string read GetAuthorName; 37 | [DISABLE] property UIdInt: int64 read GetUidInt write FId; 38 | [DISABLE] property Caption: string read GetCaption; // write SetCaption; 39 | [DISABLE] property ContentFetched: boolean read GetContentFetched; 40 | constructor Create; 41 | end; 42 | 43 | TNBoxSearchReqCoomerParty = class(TNBoxSearchRequestBase) 44 | private 45 | FUserId: string; 46 | FService: string; 47 | FSite: String; 48 | protected 49 | function GetOrigin: integer; override; 50 | public 51 | function Clone: INBoxSearchRequest; override; 52 | property Origin; 53 | property Request; 54 | property PageId; 55 | property Site: String read FSite write FSite; 56 | property UserId: string read FUserId write FUserId; 57 | property Service: string read FService write FService; 58 | constructor Create; override; 59 | end; 60 | 61 | function TPartyPostToTPartyPostPage(A: TPartyPost): TPartyPostPage; 62 | 63 | implementation 64 | 65 | function TPartyPostToTPartyPostPage(A: TPartyPost): TPartyPostPage; 66 | begin 67 | Result.Author := A.Author; 68 | Result.Content := A.Content; 69 | Result.Timestamp := A.Timestamp; 70 | if ( not A.Thumbnail.IsEmpty ) then 71 | Result.Thumbnails := [A.Thumbnail]; 72 | end; 73 | 74 | { TNBoxCoomerPartyItem } 75 | 76 | procedure TNBoxCoomerPartyItem.Assign(ASource: INBoxItem); 77 | begin 78 | inherited; 79 | 80 | if (not (ASource is TNBoxCoomerPartyItem) ) then 81 | exit; 82 | 83 | with ( ASource as TNBoxCoomerPartyItem ) do begin 84 | Self.FItem := Item; 85 | Self.FSite := Site; 86 | Self.Fid := UIdInt; 87 | end; 88 | end; 89 | 90 | function TNBoxCoomerPartyItem.Clone: INBoxItem; 91 | begin 92 | Result := TNBoxCoomerPartyItem.Create; 93 | Result.Assign(Self); 94 | end; 95 | 96 | constructor TNBoxCoomerPartyItem.Create; 97 | begin 98 | FOrigin := ORIGIN_COOMERPARTY; 99 | //FSite := TCoomerPartySite.CoomerParty; 100 | FSite := URL_COOMER_PARTY; 101 | FId := -1; 102 | FItem := TPartyPostPage.New; 103 | end; 104 | 105 | function TNBoxCoomerPartyItem.GetAuthorName: string; 106 | begin 107 | Result := FItem.Author.Id; 108 | end; 109 | 110 | function TNBoxCoomerPartyItem.GetCaption: string; 111 | begin 112 | Result := FItem.Content; 113 | end; 114 | 115 | function TNBoxCoomerPartyItem.GetContentFetched: boolean; 116 | begin 117 | Result := (ContentUrlCount > 0); 118 | end; 119 | 120 | function TNBoxCoomerPartyItem.GetContentUrls: TArray; 121 | var 122 | I: integer; 123 | begin 124 | for I := 0 to High(FItem.Files) do 125 | Result := Result + [Self.Site + FItem.Files[I]]; 126 | end; 127 | 128 | function TNBoxCoomerPartyItem.GetThumbnailUrl: string; 129 | begin 130 | if ( length(FItem.Thumbnails) > 0 ) then 131 | Result := Self.Site + Fitem.Thumbnails[0] 132 | else 133 | Result := ''; 134 | end; 135 | 136 | function TNBoxCoomerPartyItem.GetUidInt: int64; 137 | begin 138 | Result := FId; 139 | end; 140 | 141 | { TNBoxSearchReqGmpClub } 142 | 143 | function TNBoxSearchReqCoomerParty.Clone: INBoxSearchRequest; 144 | begin 145 | Result := TNBoxSearchReqCoomerParty.Create; 146 | with ( Result as TNBoxSearchReqCoomerParty ) do begin 147 | Pageid := self.FPageId; 148 | Request := Self.FRequest; 149 | Site := Self.Site; 150 | Service := Self.Service; 151 | UserId := Self.UserId; 152 | end; 153 | end; 154 | 155 | constructor TNBoxSearchReqCoomerParty.Create; 156 | begin 157 | inherited; 158 | FUserId := ''; 159 | FService := ''; 160 | end; 161 | 162 | function TNBoxSearchReqCoomerParty.GetOrigin: integer; 163 | begin 164 | Result := ORIGIN_COOMERPARTY; 165 | end; 166 | 167 | end. 168 | -------------------------------------------------------------------------------- /source/NsfwBoxOriginGivemepornClub.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxOriginGivemepornClub; 3 | 4 | interface 5 | uses 6 | System.SysUtils, System.Classes, XSuperObject, 7 | givemeporn.club.types, NsfwBoxInterfaces, NsfwBoxOriginConst; 8 | 9 | type 10 | 11 | TGmpClubSearchType = (Empty, Tag, Category, Random); 12 | 13 | TNBoxGmpClubItem = class( TNBoxItemBase, IUIdAsInt, IHasTags, 14 | IHasCaption, IFetchableContent, IFetchableTags) 15 | private 16 | FPage: TGmpclubFullPage; 17 | FItem: TGmpclubItem; 18 | //procedure SetTags(const Value: TArray); 19 | function GetTags: TArray; 20 | function GetTagsCount: integer; 21 | function GetTagsFetched: boolean; 22 | function GetContentFetched: boolean; 23 | function GetUidInt: int64; 24 | //procedure SetUIdInt(const Value: int64); 25 | //procedure SetCaption(const Value: String); 26 | function GetCaption: string; 27 | //procedure SetContentUrls(const Value: TArray); override; 28 | function GetContentUrls: TArray; override; 29 | //procedure SetThumbnailUrl(const Value: string); override; 30 | function GetThumbnailUrl: string; override; 31 | public 32 | procedure Assign(ASource: INBoxItem); override; 33 | function Clone: INBoxItem; override; 34 | //--New--// 35 | property Item: TGmpclubItem read FItem write FItem; 36 | property Page: TGmpclubFullPage read Fpage write Fpage; 37 | //--Properties--// 38 | property Origin; 39 | [DISABLE] property ThumbnailUrl; 40 | [DISABLE] property ContentUrls; 41 | [DISABLE] property UIdInt: int64 read GetUidInt; // write SetUidInt; 42 | [DISABLE] property Caption: string read GetCaption; // write SetCaption; 43 | [DISABLE] property ContentFetched: boolean read GetContentFetched; 44 | [DISABLE] property Tags: TArray read GetTags; // write SetTags; 45 | [DISABLE] property TagsFetched: boolean read GetTagsFetched; 46 | constructor Create; 47 | end; 48 | 49 | TNBoxSearchReqGmpClub = class(TNBoxSearchRequestBase) 50 | protected 51 | FSearchtype: TGmpClubSearchType; 52 | function GetOrigin: integer; override; 53 | procedure SetSearchType(const value: TGmpClubSearchType); 54 | public 55 | function Clone: INBoxSearchRequest; override; 56 | property Origin; 57 | property Request; 58 | property PageId; 59 | property SearchType: TGmpClubSearchType read FSearchType write SetSearchType; 60 | constructor Create; override; 61 | end; 62 | 63 | implementation 64 | 65 | { TNBoxGmpClubItem } 66 | 67 | procedure TNBoxGmpClubItem.Assign(ASource: INBoxItem); 68 | begin 69 | if not ( ASource is TNBoxGmpClubItem ) then 70 | Exit; 71 | with ( ASource as TNBoxGmpClubItem ) do begin 72 | Self.Item := Item; 73 | Self.Page := Page; 74 | end; 75 | end; 76 | 77 | function TNBoxGmpClubItem.Clone: INBoxItem; 78 | begin 79 | Result := TNBoxGmpClubItem.Create; 80 | Result.Assign(Self); 81 | end; 82 | 83 | constructor TNBoxGmpClubItem.Create; 84 | begin 85 | inherited; 86 | Item := TGmpclubItem.New; 87 | Page := TGmpclubFullPage.New; 88 | FOrigin := ORIGIN_GIVEMEPORNCLUB; 89 | end; 90 | 91 | function TNBoxGmpClubItem.GetCaption: string; 92 | begin 93 | Result := Item.Title; 94 | end; 95 | 96 | function TNBoxGmpClubItem.GetContentFetched: boolean; 97 | begin 98 | Result := (length(self.ContentUrls) > 0); 99 | end; 100 | 101 | function TNBoxGmpClubItem.GetContentUrls: TArray; 102 | begin 103 | Result := []; 104 | if ( not FPage.ContentUrl.IsEmpty ) then 105 | Result := [ FPage.ContentUrl ]; 106 | end; 107 | 108 | function TNBoxGmpClubItem.GetTags: TArray; 109 | begin 110 | Result := FPage.Tags; 111 | end; 112 | 113 | function TNBoxGmpClubItem.GetTagsCount: integer; 114 | begin 115 | Result := Length(FPage.Tags); 116 | end; 117 | 118 | function TNBoxGmpClubItem.GetTagsFetched: boolean; 119 | begin 120 | Result := ( Length(FPage.Tags) > 0 ); 121 | end; 122 | 123 | function TNBoxGmpClubItem.GetThumbnailUrl: string; 124 | begin 125 | Result := FItem.ThumbnailUrl; 126 | end; 127 | 128 | function TNBoxGmpClubItem.GetUidInt: int64; 129 | begin 130 | Result := FItem.Id; 131 | end; 132 | 133 | //procedure TNBoxGmpClubItem.SetCaption(const Value: String); 134 | //begin 135 | // FItem.Title := Value; 136 | //end; 137 | 138 | //procedure TNBoxGmpClubItem.SetContentUrls(const Value: TArray); 139 | //begin 140 | // if ( Length(Value) > 0 ) then 141 | // FPage.ContentUrl := Value[0]; 142 | //end; 143 | 144 | //procedure TNBoxGmpClubItem.SetTags(const Value: TArray); 145 | //begin 146 | // FPage.Tags := Value; 147 | //end; 148 | 149 | //procedure TNBoxGmpClubItem.SetThumbnailUrl(const Value: string); 150 | //begin 151 | // FItem.ThumbnailUrl := Value; 152 | //end; 153 | 154 | //procedure TNBoxGmpClubItem.SetUIdInt(const Value: int64); 155 | //begin 156 | // FItem.Id := Value; 157 | //end; 158 | 159 | { TNBoxSearchReqXxx } 160 | 161 | function TNBoxSearchReqGmpClub.Clone: INBoxSearchRequest; 162 | begin 163 | Result := TNBoxSearchReqGmpClub.Create; 164 | with Result as TNBoxSearchReqGmpClub do begin 165 | Pageid := self.FPageId; 166 | Request := Self.FRequest; 167 | Searchtype := Self.FSearchtype; 168 | end; 169 | end; 170 | 171 | constructor TNBoxSearchReqGmpClub.Create; 172 | begin 173 | inherited; 174 | FSearchtype := TGmpClubSearchType.Empty; 175 | end; 176 | 177 | function TNBoxSearchReqGmpClub.GetOrigin: integer; 178 | begin 179 | Result := ORIGIN_GIVEMEPORNCLUB; 180 | end; 181 | 182 | procedure TNBoxSearchReqGmpClub.SetSearchType(const value: TGmpClubSearchType); 183 | begin 184 | FSearchType := value; 185 | end; 186 | 187 | end. 188 | -------------------------------------------------------------------------------- /source/NsfwBoxOriginNsfwXxx.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxOriginNsfwXxx; 3 | 4 | interface 5 | uses 6 | System.SysUtils, System.Classes, XSuperObject, 7 | NsfwBoxInterfaces, NsfwBoxOriginConst, NsfwXxx.Types; 8 | 9 | type 10 | 11 | TNsfwXxxSite = (NsfwXxx, PornpicXxx, HdpornPics); 12 | 13 | TNBoxNsfwXxxItem = class( TNBoxItemBase, IUIdAsInt, IHasTags, IHasAuthor, 14 | IHasCaption, IFetchableContent, IFetchableTags) 15 | private 16 | FPage: TNsfwXxxPostPage; 17 | FItem: TNsfwXxxItem; 18 | //procedure SetTags(const Value: TArray); 19 | function GetTags: TArray; 20 | function GetTagsCount: integer; 21 | function GetTagsFetched: boolean; 22 | function GetContentFetched: boolean; 23 | function GetAuthorName: string; 24 | //procedure SetAuthorName(const Value: string); 25 | function GetUidInt: int64; 26 | //procedure SetUIdInt(const Value: int64); 27 | //procedure SetCaption(const Value: String); 28 | function GetCaption: string; 29 | //procedure SetContentUrls(const Value: TArray); override; 30 | function GetContentUrls: TArray; override; 31 | //procedure SetThumbnailUrl(const Value: string); override; 32 | function GetThumbnailUrl: string; override; 33 | function GetHasAuthorName: boolean; 34 | public 35 | procedure Assign(ASource: INBoxItem); override; 36 | function Clone: INBoxItem; override; 37 | //--New--// 38 | property Item: TNsfwXxxitem read Fitem write Fitem; 39 | property Page: TNsfwXxxPostPage read Fpage write Fpage; 40 | //--Properties--// 41 | property Origin; 42 | [DISABLE] property ThumbnailUrl; 43 | [DISABLE] property ContentUrls; 44 | [DISABLE] property UIdInt: int64 read GetUidInt; // write SetUidInt; 45 | [DISABLE] property Caption: string read GetCaption; // write SetCaption; 46 | [DISABLE] property AuthorName: string read GetAuthorName; // write SetAuthorName; 47 | [DISABLE] property ContentFetched: boolean read GetContentFetched; 48 | [DISABLE] property Tags: TArray read GetTags; // write SetTags; 49 | [DISABLE] property TagsFetched: boolean read GetTagsFetched; 50 | constructor Create; 51 | end; 52 | 53 | TNBoxSearchReqNsfwXxx = class(TNBoxSearchRequestBase) 54 | protected 55 | FSearchtype: TNsfwUrlType; 56 | FSortType: TNsfwSort; 57 | FOris: TNsfwOris; 58 | FTypes: TNsfwItemTypes; 59 | FSite: TNsfwXxxSite; 60 | function GetOrigin: integer; override; 61 | procedure SetSearchType(const value: TNsfwUrlType); 62 | procedure SetSortType(const value: TNsfwSort); 63 | procedure SetOris(const value: TNsfwOris); 64 | procedure SetTypes(const value: TNsfwItemTypes); 65 | public 66 | function Clone: INBoxSearchRequest; override; 67 | property Origin; 68 | property Request; 69 | property PageId; 70 | property SearchType: TNsfwUrlType read FSearchType write SetSearchType; 71 | property SortType: TNsfwSort read FSortType write SetSortType; 72 | property Oris: TNsfwOris read FOris write SetOris; 73 | property Types: TNsfwItemTypes read FTypes write SetTypes; 74 | property Site: TNsfwXxxSite read FSite write FSite; 75 | constructor Create; override; 76 | end; 77 | 78 | function TNsfwXxxSiteToUrl(AValue: TNsfwXxxSite): string; 79 | 80 | implementation 81 | 82 | function TNsfwXxxSiteToUrl(AValue: TNsfwXxxSite): string; 83 | begin 84 | case AValue of 85 | NsfwXxx: Result := 'https://nsfw.xxx'; 86 | PornpicXxx: Result := 'https://pornpic.xxx'; 87 | HdpornPics: Result := 'https://hdporn.pics'; 88 | end; 89 | end; 90 | 91 | { TNBoxNsfwXxxItem } 92 | 93 | procedure TNBoxNsfwXxxItem.Assign(ASource: INBoxItem); 94 | begin 95 | if not ( ASource is TNBoxNsfwXxxItem ) then 96 | Exit; 97 | with ( ASource as TNBoxNsfwXxxItem ) do begin 98 | Self.Item := Item; 99 | Self.Page := Page; 100 | end; 101 | end; 102 | 103 | function TNBoxNsfwXxxItem.Clone: INBoxItem; 104 | begin 105 | Result := TNBoxNsfwXxxItem.Create; 106 | Result.Assign(Self); 107 | end; 108 | 109 | constructor TNBoxNsfwXxxItem.Create; 110 | begin 111 | inherited; 112 | Item := TNsfwXxxitem.New; 113 | Page := TNsfwXxxPostPage.New; 114 | FOrigin := ORIGIN_NSFWXXX; 115 | end; 116 | 117 | function TNBoxNsfwXxxItem.GetAuthorName: string; 118 | begin 119 | Result := Item.Username; 120 | end; 121 | 122 | function TNBoxNsfwXxxItem.GetCaption: string; 123 | begin 124 | Result := Item.Caption; 125 | end; 126 | 127 | function TNBoxNsfwXxxItem.GetContentFetched: boolean; 128 | begin 129 | Result := (length(self.ContentUrls) > 0); 130 | end; 131 | 132 | function TNBoxNsfwXxxItem.GetContentUrls: TArray; 133 | begin 134 | Result := []; 135 | if Length(Page.Items) > 0 then 136 | Result := Page.Items[0].Thumbnails; 137 | end; 138 | 139 | function TNBoxNsfwXxxItem.GetHasAuthorName: boolean; 140 | begin 141 | Result := true; 142 | end; 143 | 144 | function TNBoxNsfwXxxItem.GetTags: TArray; 145 | begin 146 | if ( ContentFetched ) then 147 | Result := FPage.Items[0].Categories 148 | else 149 | Result := FItem.Categories; 150 | end; 151 | 152 | function TNBoxNsfwXxxItem.GetTagsCount: integer; 153 | begin 154 | Result := Length(FItem.Categories); 155 | end; 156 | 157 | function TNBoxNsfwXxxItem.GetTagsFetched: boolean; 158 | begin 159 | Result := Self.ContentFetched; 160 | end; 161 | 162 | function TNBoxNsfwXxxItem.GetThumbnailUrl: string; 163 | begin 164 | if Length(Item.Thumbnails) > 0 then 165 | Result := Item.Thumbnails[0]; 166 | end; 167 | 168 | function TNBoxNsfwXxxItem.GetUidInt: int64; 169 | begin 170 | Result := FItem.Id; 171 | end; 172 | 173 | //procedure TNBoxNsfwXxxItem.SetAuthorName(const Value: string); 174 | //begin 175 | // Fitem.Username := Value; 176 | //end; 177 | // 178 | //procedure TNBoxNsfwXxxItem.SetCaption(const Value: String); 179 | //begin 180 | // FItem.Caption := Value; 181 | //end; 182 | 183 | //procedure TNBoxNsfwXxxItem.SetContentUrls(const Value: TArray); 184 | //begin 185 | // if Length(FPage.Items) < 1 then 186 | // FPage.Items := [TNsfwXxxItem.New]; 187 | // FPage.Items[0].Thumbnails := Value; 188 | //end; 189 | 190 | //procedure TNBoxNsfwXxxItem.SetTags(const Value: TArray); 191 | //begin 192 | // FItem.Categories := Value; 193 | //end; 194 | // 195 | //procedure TNBoxNsfwXxxItem.SetThumbnailUrl(const Value: string); 196 | //begin 197 | // if Length(FItem.Thumbnails) > 0 then 198 | // FItem.Thumbnails[0] := Value 199 | // else 200 | // Fitem.Thumbnails := [Value]; 201 | //end; 202 | 203 | //procedure TNBoxNsfwXxxItem.SetUIdInt(const Value: int64); 204 | //begin 205 | // FItem.Id := Value; 206 | //end; 207 | 208 | { TNBoxSearchReqXxx } 209 | 210 | function TNBoxSearchReqNsfwXxx.Clone: INBoxSearchRequest; 211 | begin 212 | Result := TNBoxSearchReqNsfwXxx.Create; 213 | with Result as TNBoxSearchReqNsfwXxx do begin 214 | Pageid := self.FPageId; 215 | Request := Self.FRequest; 216 | Searchtype := Self.FSearchtype; 217 | SortType := Self.FSortType; 218 | Oris := Self.FOris; 219 | Types := Self.FTypes; 220 | Site := Self.FSite; 221 | end; 222 | end; 223 | 224 | constructor TNBoxSearchReqNsfwXxx.Create; 225 | begin 226 | inherited; 227 | FSearchtype := TNsfwUrlType.Default; 228 | FSortType := TNsfwSort.Recommended; 229 | FOris := [Straight, Gay, Shemale, Cartoons]; 230 | FTypes := [Image, video, Gallery]; 231 | FSite := TNsfwXxxSite.NsfwXxx; 232 | end; 233 | 234 | function TNBoxSearchReqNsfwXxx.GetOrigin: integer; 235 | begin 236 | Result := ORIGIN_NSFWXXX; 237 | end; 238 | 239 | procedure TNBoxSearchReqNsfwXxx.SetOris(const value: TNsfwOris); 240 | begin 241 | FOris := Value; 242 | end; 243 | 244 | procedure TNBoxSearchReqNsfwXxx.SetSearchType(const value: TNsfwUrlType); 245 | begin 246 | FSearchType := value; 247 | end; 248 | 249 | procedure TNBoxSearchReqNsfwXxx.SetSortType(const value: TNsfwSort); 250 | begin 251 | FSortType := Value; 252 | end; 253 | 254 | procedure TNBoxSearchReqNsfwXxx.SetTypes(const value: TNsfwItemTypes); 255 | begin 256 | FTypes := value; 257 | end; 258 | 259 | end. 260 | -------------------------------------------------------------------------------- /source/NsfwBoxOriginPseudo.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxOriginPseudo; 3 | 4 | interface 5 | uses 6 | System.SysUtils, System.Classes, NsfwBoxInterfaces, 7 | NsfwBoxOriginConst; 8 | 9 | type 10 | 11 | // This item used to test graphic interface on dev mode 12 | 13 | TNBoxPseudoItem = class(TNBoxItemBase) 14 | private 15 | FUrls: TArray; 16 | FThumb: string; 17 | protected 18 | //--Setters and Getters--// 19 | procedure SetContentUrls(const Value: TArray); 20 | function GetContentUrls: TArray; override; 21 | procedure SetThumbnailUrl(const Value: string); 22 | function GetThumbnailUrl: string; override; 23 | public 24 | procedure Assign(ASource: INBoxItem); override; 25 | function Clone: INBoxItem; override; 26 | //--Properties--// 27 | property Origin; 28 | property ThumbnailUrl read GetThumbnailUrl write SetThumbnailUrl; 29 | property ContentUrls read GetContentUrls write SetContentUrls; 30 | constructor Create; 31 | end; 32 | 33 | TNBoxSearchReqPseudo = class(TNBoxSearchRequestBase) 34 | protected 35 | //--Setters and Getters--// 36 | function GetOrigin: integer; override; 37 | public 38 | function Clone: INBoxSearchRequest; override; 39 | //--Properties--// 40 | property Origin: integer read GetOrigin; 41 | property Request; 42 | property PageId; 43 | end; 44 | 45 | implementation 46 | 47 | { TNBoxPseudoItem } 48 | 49 | procedure TNBoxPseudoItem.Assign(ASource: INBoxItem); 50 | var 51 | I: TNBoxPseudoItem; 52 | begin 53 | if not ( ASource is TNBoxPseudoItem ) then 54 | Exit; 55 | 56 | with ( ASource as TNBoxPseudoItem ) do begin 57 | self.FUrls := ContentUrls; 58 | self.FThumb := ThumbnailUrl; 59 | self.FOrigin := Origin; 60 | end; 61 | end; 62 | 63 | function TNBoxPseudoItem.Clone: INBoxItem; 64 | begin 65 | Result := TNBoxPseudoItem.Create; 66 | Result.Assign(Self); 67 | end; 68 | 69 | constructor TNBoxPseudoItem.Create; 70 | begin 71 | FOrigin := ORIGIN_PSEUDO; 72 | end; 73 | 74 | function TNBoxPseudoItem.GetContentUrls: TArray; 75 | begin 76 | Result := Furls; 77 | end; 78 | 79 | function TNBoxPseudoItem.GetThumbnailUrl: string; 80 | begin 81 | Result := FThumb; 82 | end; 83 | 84 | procedure TNBoxPseudoItem.SetContentUrls(const Value: TArray); 85 | begin 86 | Furls := Value; 87 | end; 88 | 89 | procedure TNBoxPseudoItem.SetThumbnailUrl(const Value: string); 90 | begin 91 | FThumb := Value; 92 | end; 93 | 94 | { TNBoxSearchReqPseudo } 95 | 96 | function TNBoxSearchReqPseudo.Clone: INBoxSearchRequest; 97 | begin 98 | Result := TNBoxSearchReqPseudo.Create; 99 | with Result do begin 100 | Pageid := self.PageId; 101 | Request := Self.Request; 102 | end; 103 | end; 104 | 105 | function TNBoxSearchReqPseudo.GetOrigin: integer; 106 | begin 107 | Result := ORIGIN_PSEUDO; 108 | end; 109 | 110 | end. 111 | -------------------------------------------------------------------------------- /source/NsfwBoxOriginR34App.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxOriginR34App; 3 | 4 | interface 5 | uses 6 | System.SysUtils, System.Classes, NsfwBoxInterfaces, R34App.Types, 7 | NetHttp.R34AppApi, NsfwBoxOriginConst, XSuperObject; 8 | 9 | type 10 | 11 | TNBoxR34AppItem = class(TNBoxItemBase, INBoxitem, IUIdAsInt, 12 | IHasTags, IHasAuthor) 13 | protected 14 | FItem: TR34AppItem; 15 | //procedure SetTags(const Value: TArray); 16 | function GetTags: TArray; 17 | function GetTagsCount: integer; 18 | function GetUidInt: int64; 19 | //procedure SetUIdInt(const Value: int64); 20 | function GetCaption: string; 21 | //procedure SetContentUrls(const Value: TArray); override; 22 | function GetContentUrls: TArray; override; 23 | //procedure SetThumbnailUrl(const Value: string); override; 24 | function GetThumbnailUrl: string; override; 25 | function GetAuthorName: string; 26 | public 27 | //--New--// 28 | property Item: TR34Appitem read FItem write FItem; 29 | //--Properties--// 30 | property Origin; 31 | [DISABLE] property UIdInt: int64 read GetUidInt; // write SetUidInt; 32 | [DISABLE] property ThumbnailUrl read GetThumbnailUrl; // write SetThumbnailUrl; 33 | [DISABLE] property ContentUrls; 34 | [DISABLE] property Tags: TArray read GetTags; // write SetTags; 35 | [DISABLE] property TagsCount: integer read GetTagsCount; 36 | [DISABLE] property AuthorName: string read GetAuthorName; 37 | procedure Assign(ASource: INBoxItem); override; 38 | function Clone: INBoxItem; override; 39 | constructor Create; 40 | end; 41 | 42 | TNBoxSearchReqR34App = class(TNBoxSearchRequestBase) 43 | protected 44 | FBooru: TR34AppFreeBooru; 45 | function GetOrigin: integer; override; 46 | public 47 | function Clone: INBoxSearchRequest; override; 48 | property Origin; 49 | property Request; 50 | property PageId; 51 | property Booru: TR34AppFreeBooru read FBooru write FBooru; 52 | constructor Create; override; 53 | end; 54 | 55 | implementation 56 | uses unit1; 57 | { TNBoxR34XxxItem } 58 | 59 | procedure TNBoxR34AppItem.Assign(ASource: INBoxItem); 60 | begin 61 | if not ( ASource is TNBoxR34AppItem ) then 62 | Exit; 63 | with ( ASource as TNBoxR34Appitem ) do begin 64 | Self.Item := Item; 65 | end; 66 | end; 67 | 68 | function TNBoxR34AppItem.Clone: INBoxItem; 69 | begin 70 | Result := TNBoxR34AppItem.Create; 71 | Result.Assign(self); 72 | end; 73 | 74 | constructor TNBoxR34AppItem.Create; 75 | begin 76 | FOrigin := ORIGIN_R34APP; 77 | end; 78 | 79 | function TNBoxR34AppItem.GetAuthorName: string; 80 | begin 81 | if ( Length(Item.Tags.Artist) > 0 ) then 82 | Result := Item.Tags.Artist[0] 83 | else 84 | Result := ''; 85 | end; 86 | 87 | function TNBoxR34AppItem.GetCaption: string; 88 | begin 89 | Result := Item.Tags.ToString; 90 | end; 91 | 92 | 93 | function TNBoxR34AppItem.GetContentUrls: TArray; 94 | begin 95 | Result := [Item.HighResFile.Url]; 96 | end; 97 | 98 | function TNBoxR34AppItem.GetTags: TArray; 99 | begin 100 | Result := Item.Tags.ToStringAr; 101 | end; 102 | 103 | function TNBoxR34AppItem.GetTagsCount: integer; 104 | begin 105 | Result := Item.Tags.Count; 106 | end; 107 | 108 | function TNBoxR34AppItem.GetThumbnailUrl: string; 109 | begin 110 | Result := item.PreviewFile.Url; 111 | end; 112 | 113 | function TNBoxR34AppItem.GetUidInt: int64; 114 | begin 115 | Result := Item.id; 116 | end; 117 | 118 | //procedure TNBoxR34AppItem.SetContentUrls(const Value: TArray); 119 | //begin 120 | // if length(Value) > 0 then 121 | // Fitem.high_res_file.url := Value[0] 122 | // else 123 | // Fitem.high_res_file.url := ''; 124 | //end; 125 | // 126 | //procedure TNBoxR34AppItem.SetTags(const Value: TArray); 127 | //begin 128 | // FItem.tags := Value; 129 | //end; 130 | // 131 | //procedure TNBoxR34AppItem.SetThumbnailUrl(const Value: string); 132 | //begin 133 | // FItem.preview_file.url := Value; 134 | //end; 135 | // 136 | //procedure TNBoxR34AppItem.SetUIdInt(const Value: int64); 137 | //begin 138 | // FItem.id := Value; 139 | //end; 140 | 141 | { TNBoxSearchReqR34Xxx } 142 | 143 | function TNBoxSearchReqR34App.Clone: INBoxSearchRequest; 144 | begin 145 | Result := TNBoxSearchReqR34App.Create; 146 | with ( Result as TNBoxSearchReqR34App ) do begin 147 | Booru := Self.FBooru; 148 | Pageid := Self.FPageId; 149 | Request := Self.FRequest; 150 | end; 151 | end; 152 | 153 | constructor TNBoxSearchReqR34App.Create; 154 | begin 155 | inherited; 156 | FPageId := 0; 157 | FBooru := TR34AppFreeBooru.rule34xxx; 158 | end; 159 | 160 | function TNBoxSearchReqR34App.GetOrigin: integer; 161 | begin 162 | Result := ORIGIN_R34APP; 163 | end; 164 | 165 | 166 | end. 167 | -------------------------------------------------------------------------------- /source/NsfwBoxOriginR34JsonApi.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxOriginR34JsonApi; 3 | 4 | interface 5 | uses 6 | System.SysUtils, System.Classes, XSuperObject, 7 | NsfwBoxInterfaces, NsfwBoxOriginConst, R34JsonApi.Types; 8 | 9 | type 10 | 11 | TNBoxR34JsonApiItem = class(TNBoxItemBase, IUIdAsInt, IHasTags) 12 | protected 13 | FItem: TR34Item; 14 | //procedure SetTags(const Value: TArray); 15 | function GetTags: TArray; 16 | function GetUidInt: int64; 17 | //procedure SetUIdInt(const Value: int64); 18 | //procedure SetContentUrls(const Value: TArray); override; 19 | function GetContentUrls: TArray; override; 20 | //procedure SetThumbnailUrl(const Value: string); override; 21 | function GetThumbnailUrl: string; override; 22 | public 23 | procedure Assign(ASource: INBoxItem); override; 24 | function Clone: INBoxItem; override; 25 | //--New--// 26 | property Item: TR34item read FItem write FItem; 27 | //--Properties--// 28 | property Origin; 29 | [DISABLE] property UIdInt: int64 read GetUidInt; // write SetUidInt; 30 | [DISABLE] property ThumbnailUrl; 31 | [DISABLE] property ContentUrls; 32 | [DISABLE] property Tags: TArray read GetTags; // write SetTags; 33 | constructor Create; 34 | end; 35 | 36 | TNBoxSearchReqR34JsonApi = class(TNBoxSearchRequestBase) 37 | private 38 | function GetOrigin: integer; override; 39 | public 40 | function Clone: INBoxSearchRequest; override; 41 | property Origin; 42 | property Request: string read FRequest write SetRequest; 43 | property PageId: integer read FPageId write SetPageId; 44 | end; 45 | 46 | implementation 47 | 48 | { TNBoxR34XxxItem } 49 | 50 | procedure TNBoxR34JsonApiItem.Assign(ASource: INBoxItem); 51 | begin 52 | if not ( ASource is TNBoxR34JsonApiItem ) then 53 | Exit; 54 | with ( ASource as TNBoxR34JsonApiItem ) do begin 55 | Self.Item := Item; 56 | end; 57 | end; 58 | 59 | function TNBoxR34JsonApiItem.Clone: INBoxItem; 60 | begin 61 | Result := TNBoxR34JsonApiItem.Create; 62 | Result.Assign(self); 63 | end; 64 | 65 | constructor TNBoxR34JsonApiItem.Create; 66 | begin 67 | FOrigin := ORIGIN_R34JSONAPI; 68 | end; 69 | 70 | function TNBoxR34JsonApiItem.GetContentUrls: TArray; 71 | begin 72 | Result := [FItem.file_url]; 73 | end; 74 | 75 | function TNBoxR34JsonApiItem.GetTags: TArray; 76 | begin 77 | Result := FItem.tags; 78 | end; 79 | 80 | function TNBoxR34JsonApiItem.GetThumbnailUrl: string; 81 | begin 82 | Result := Fitem.preview_url; 83 | end; 84 | 85 | function TNBoxR34JsonApiItem.GetUidInt: int64; 86 | begin 87 | TryStrToInt64(Fitem.id, Result); 88 | end; 89 | 90 | //procedure TNBoxR34JsonApiItem.SetContentUrls(const Value: TArray); 91 | //begin 92 | // if length(Value) > 0 then 93 | // Fitem.file_url := Value[0] 94 | // else 95 | // Fitem.file_url := ''; 96 | //end; 97 | // 98 | //procedure TNBoxR34JsonApiItem.SetTags(const Value: TArray); 99 | //begin 100 | // FItem.tags := Value; 101 | //end; 102 | // 103 | //procedure TNBoxR34JsonApiItem.SetThumbnailUrl(const Value: string); 104 | //begin 105 | // FItem.preview_url := Value; 106 | //end; 107 | 108 | //procedure TNBoxR34JsonApiItem.SetUIdInt(const Value: int64); 109 | //begin 110 | // FItem.id := Value.ToString; 111 | //end; 112 | 113 | { TNBoxSearchReqR34Xxx } 114 | 115 | function TNBoxSearchReqR34JsonApi.Clone: INBoxSearchRequest; 116 | begin 117 | Result := TNBoxSearchReqR34JsonApi.Create; 118 | with Result do begin 119 | Pageid := self.FPageId; 120 | Request := Self.FRequest; 121 | end; 122 | end; 123 | 124 | function TNBoxSearchReqR34JsonApi.GetOrigin: integer; 125 | begin 126 | Result := ORIGIN_R34JSONAPI; 127 | end; 128 | 129 | end. 130 | -------------------------------------------------------------------------------- /source/NsfwBoxSettings.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxSettings; 3 | 4 | interface 5 | uses 6 | Classes, XSuperObject, system.Generics.Collections; 7 | 8 | Const 9 | 10 | ACTION_OPEN_MENU = 0; 11 | ACTION_DOWNLOAD = 1; 12 | ACTION_PLAY_EXTERNALY = 2; 13 | ACTION_ADD_BOOKMARK = 3; 14 | ACTION_DELETE_BOOKMARK = 4; 15 | ACTION_LOG_URLS = 5; 16 | ACTION_COPY_CONTENT_URLS = 6; 17 | ACTION_COPY_THUMB_URL = 7; 18 | ACTION_OPEN_RELATED = 8; 19 | ACTION_OPEN_AUTHOR = 9; 20 | ACTION_SHARE_CONTENT = 10; 21 | ACTION_BROWSE = 11; 22 | ACTION_DELETE_CARD = 12; 23 | ACTION_SHOW_TAGS = 13; 24 | 25 | FORMAT_VAR_CONTENT_URL = '$(NSFWBOX_CONTENT_URL)'; 26 | 27 | type 28 | 29 | TNBoxItemInteraction = NativeInt; 30 | 31 | TNBoxItemInteractions = TArray; 32 | 33 | TNsfwBoxSettings = class 34 | Version: integer; 35 | DefaultUseragent: string; 36 | AllowCookies: boolean; 37 | DefDownloadPath: string; 38 | StyleName: string; 39 | ThreadsCount: integer; 40 | ContentLayoutsCount: integer; 41 | ItemIndent: single; 42 | //Language: string; 43 | Fullscreen: boolean; 44 | AutoSaveSession: boolean; 45 | SaveSearchHistory: boolean; 46 | SaveDownloadHistory: boolean; 47 | SaveTapHistory: boolean; 48 | //HighlightsDownloaded: boolean; 49 | ShowCaptions: boolean; 50 | //AutoRenameExistsFile: boolean; 51 | //DownloadDuplicates: boolean; 52 | MaxDownloadThreads: integer; 53 | AutoStartBrowse: boolean; 54 | AllowDuplicateTabs: boolean; 55 | AutoCloseItemMenu: boolean; 56 | ItemInteractions: TNBoxItemInteractions; 57 | FilenameLogUrls: string; 58 | DevMode: boolean; 59 | AutoCheckUpdates: boolean; 60 | ShowScrollBars: boolean; 61 | {$IFDEF MSWINDOWS} 62 | ContentPlayApp: string; 63 | ContentPlayParams: string; 64 | {$ENDIF} 65 | procedure Assign(ASource: TNsfwBoxSettings); 66 | constructor Create; 67 | end; 68 | 69 | 70 | implementation 71 | 72 | 73 | { TNsfwBoxSettings } 74 | 75 | procedure TNsfwBoxSettings.Assign(ASource: TNsfwBoxSettings); 76 | begin 77 | Self.AssignFromJSON(ASource.AsJSONObject); 78 | end; 79 | 80 | constructor TNsfwBoxSettings.Create; 81 | begin 82 | Version := 4; 83 | DevMode := false; 84 | DefDownloadPath := ''; 85 | DefaultUserAgent := ''; 86 | FilenameLogUrls := ''; 87 | StyleName := 'default.json'; 88 | AllowCookies := false; 89 | ThreadsCount := 6; 90 | ContentLayoutsCount := 2; 91 | MaxDownloadThreads := 4; 92 | ItemIndent := 2; 93 | //Language := 'EN'; 94 | AutoSaveSession := true; 95 | SaveSearchHistory := true; 96 | SaveDownloadHistory := true; 97 | SaveTapHistory := false; 98 | Fullscreen := true; 99 | //HighlightsDownloaded := false; 100 | ShowCaptions := true; 101 | //AutoRenameExistsFile := false; 102 | //DownloadDuplicates := false; 103 | AutoStartBrowse := false; 104 | AllowDuplicateTabs := true; 105 | AutoCloseItemMenu := true; 106 | ItemInteractions := [ ACTION_OPEN_MENU ]; 107 | AutoCheckUpdates := true; 108 | ShowScrollBars := true; 109 | {$IFDEF MSWINDOWS} 110 | ShowScrollBars := false; 111 | ContentPlayApp := 'C:\Program Files\VideoLAN\VLC\vlc.exe'; 112 | ContentPlayParams := '"' + FORMAT_VAR_CONTENT_URL + '"'; 113 | {$ENDIF} 114 | end; 115 | 116 | end. 117 | -------------------------------------------------------------------------------- /source/NsfwBoxStyling.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxStyling; 3 | 4 | interface 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, 7 | System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, 8 | XSuperObject, AlFmxObjects, NsfwBoxGraphics.Rectangle, NsfwBoxGraphics, 9 | System.IOUtils, NsfwBoxFileSystem; 10 | 11 | const 12 | ICON_NSFWBOX = 'app-icon.png'; 13 | ICON_SEARCH = 'search.png'; 14 | ICON_MENU = 'menu.png'; 15 | ICON_CLOSETAB = 'tab-close.png'; 16 | ICON_CURRENT_TAB = 'current-tab.png'; 17 | ICON_BOOKMARKS = 'bookmarks.png'; 18 | ICON_SETTINGS = 'settings.png'; 19 | ICON_NEWTAB = 'new-tab.png'; 20 | ICON_DOWNLOADS = 'downloads.png'; 21 | ICON_DOWNLOAD = 'download.png'; 22 | ICON_TAG = 'tag.png'; 23 | ICON_NEXT = 'next.png'; 24 | ICON_PLAY = 'play.png'; 25 | ICON_COPY = 'copy.png'; 26 | ICON_SAVE = 'save.png'; 27 | ICON_ADD = 'add.png'; 28 | ICON_EDIT = 'edit.png'; 29 | ICON_DELETE = 'delete.png'; 30 | 31 | ICON_IMAGE = 'image.png'; 32 | ICON_VIDEO = 'video.png'; 33 | ICON_STRAIGHT = 'heterosexual.png'; 34 | ICON_TRANS = 'transgender.png'; 35 | ICON_GAY = 'gay.png'; 36 | ICON_CARTOONS = 'cartoons.png'; 37 | 38 | ICON_ORIGIN_PREFIX = 'content-origin-'; 39 | 40 | 41 | type 42 | 43 | TColorAr = TArray; 44 | 45 | TNBoxPos = record 46 | X: Single; 47 | Y: single; 48 | class function New(Ax, Ay: single): TNBoxPos; static; 49 | end; 50 | 51 | TNBoxGradientStyle = class(TObject) 52 | Colors: TColorAr; 53 | Style: TGradientStyle; 54 | StartPos: TNBoxPos; 55 | StopPos: TNBoxPos; 56 | procedure Apply(AGradient: TGradient); virtual; 57 | constructor Create; virtual; 58 | end; 59 | 60 | TNBoxBrushStyle = class(TObject) 61 | Color: TAlphaColor; 62 | Gradient: TNBoxGradientStyle; 63 | Kind: TBrushKind; 64 | procedure Apply(ABrush: TBrush); virtual; 65 | constructor Create; virtual; 66 | destructor Destroy; virtual; 67 | end; 68 | 69 | TNBoxStrokeBrushStyle = class(TNBoxBrushStyle) 70 | Thickness: single; 71 | procedure Apply(AStroke: TStrokeBrush); virtual; 72 | constructor Create; override; 73 | end; 74 | 75 | TNBoxFillAndStroke = class(TObject) 76 | private 77 | Owner: TObject; 78 | public 79 | Fill: TNBoxBrushStyle; 80 | Stroke: TNBoxStrokeBrushStyle; 81 | procedure Apply(AValue: TObject); virtual; 82 | constructor Create(AOwner: TObject); virtual; 83 | destructor Destroy; virtual; 84 | end; 85 | 86 | TNBoxEditStyle = class(TNBoxFillAndStroke) 87 | FontName: string; 88 | FontSize: single; 89 | FontColor: TAlphaColor; 90 | XRadius: single; 91 | YRadius: single; 92 | procedure Apply(AValue: TObject); override; 93 | constructor Create(AOwner: TObject); override; 94 | end; 95 | 96 | TRectRec = record 97 | Left, Top, Right, Bottom: single; 98 | function AsRect: TRectF; 99 | class function New(ALeft, ATop, ARight, ABottom: single): TRectRec; static; 100 | end; 101 | 102 | TNBoxRectStyle = class(TNBoxFillAndStroke) 103 | private 104 | Owner: TObject; 105 | public 106 | ImageFilename: string; 107 | ImageMargins: TRectRec; 108 | Fill2: TNBoxBrushStyle; 109 | Stroke2: TNBoxStrokeBrushStyle; 110 | XRadius: single; 111 | YRadius: single; 112 | procedure Apply(AValue: TObject); override; 113 | constructor Create(AOwner: TObject); virtual; 114 | destructor Destroy; override; 115 | end; 116 | 117 | TNBoxTabStyle = class(TNBoxRectStyle) 118 | public 119 | Item: TNBoxRectStyle; 120 | procedure Apply(AValue: TNboxTab); overload; virtual; 121 | procedure Apply(AValue: TNBoxCheckButton); overload; virtual; 122 | constructor Create(AOwner: TObject); virtual; 123 | destructor Destroy; override; 124 | end; 125 | 126 | TNBoxGUIStyle = class(TObject) 127 | public 128 | StyleName: string; 129 | StyleResPath: string; 130 | TextColors: TColorAr; 131 | Form: TNBoxBrushStyle; 132 | Topbar: TNBoxBrushStyle; 133 | Multiview: TNBoxBrushStyle; 134 | Button: TNBoxRectStyle; 135 | Button2: TNBoxRectStyle; 136 | ButtonIcon: TNBoxRectStyle; 137 | ButtonIcon2: TNBoxRectStyle; 138 | ButtonIcon3: TNBoxRectStyle; 139 | Edit: TNBoxEditStyle; 140 | Tab: TNBoxTabStyle; 141 | Checkbox: TNBoxRectStyle; 142 | CheckButton: TNBoxTabStyle; 143 | SettingsRect: TNBoxRectStyle; 144 | CheckButtonSettings: TNBoxTabStyle; 145 | Memo: TNBoxRectStyle; 146 | ItemCard: TNBoxRectStyle; 147 | ItemCardRequest: TNBoxRectStyle; 148 | function GetImagePath(AOrigin: integer): string; overload; 149 | function GetImagePath(AImageName: string): string; overload; 150 | procedure Assign(AValue: TNBoxGUIStyle); 151 | constructor Create; virtual; 152 | destructor Destroy; virtual; 153 | end; 154 | 155 | 156 | 157 | implementation 158 | 159 | { TNBoxGUIStyle } 160 | 161 | procedure TNBoxGUIStyle.Assign(AValue: TNBoxGUIStyle); 162 | begin 163 | Self.AssignFromJSON(AValue.AsJSONObject); 164 | end; 165 | 166 | constructor TNBoxGUIStyle.Create; 167 | begin 168 | StyleName := ''; 169 | StyleResPath := ''; 170 | TextColors := [ TAlphacolorrec.White, TAlphacolorrec.Lightgray ]; 171 | Form := TNBoxBrushStyle.Create; 172 | Topbar := TNBoxBrushStyle.Create; 173 | Multiview := TNBoxBrushStyle.Create; 174 | Button := TNBoxRectStyle.Create(Self); 175 | Button2 := TNBoxRectStyle.Create(Self); 176 | ButtonIcon := TNBoxRectStyle.Create(Self); 177 | ButtonIcon2 := TNBoxRectStyle.Create(Self); 178 | ButtonIcon3 := TNBoxRectStyle.Create(Self); 179 | Edit := TNBoxEditStyle.Create(Self); 180 | Tab := TNBoxTabStyle.Create(Self); 181 | Checkbox := TNBoxRectStyle.Create(Self); 182 | CheckButton := TNBoxTabStyle.Create(Self); 183 | SettingsRect := TNBoxRectStyle.Create(Self); 184 | CheckButtonSettings := TNBoxTabStyle.Create(Self); 185 | Memo := TNBoxRectStyle.Create(Self); 186 | ItemCard := TNBoxRectStyle.Create(Self); 187 | ItemCardRequest := TNBoxRectStyle.Create(Self); 188 | end; 189 | 190 | destructor TNBoxGUIStyle.Destroy; 191 | begin 192 | Form.Free; 193 | Topbar.Free; 194 | Multiview.Free; 195 | Button.Free; 196 | Button2.Free; 197 | ButtonIcon.Free; 198 | ButtonIcon2.Free; 199 | ButtonIcon3.Free; 200 | Edit.Free; 201 | Checkbox.Free; 202 | Tab.Free; 203 | CheckButton.Free; 204 | SettingsRect.Free; 205 | CheckButtonSettings.Free; 206 | Memo.Free; 207 | ItemCard.Free; 208 | ItemCardRequest.Free; 209 | end; 210 | 211 | 212 | function TNBoxGUIStyle.GetImagePath(AImageName: string): string; 213 | begin 214 | Result := ''; 215 | if AImageName.IsEmpty then 216 | exit; 217 | Result := TPath.Combine(TNBoxPath.GetThemesPath, Self.StyleResPath); 218 | Result := Tpath.Combine(Result, AImageName); 219 | end; 220 | 221 | function TNBoxGUIStyle.GetImagePath(AOrigin: integer): string; 222 | begin 223 | Result := GetImagePath(ICON_ORIGIN_PREFIX + AOrigin.ToString + '.png'); 224 | end; 225 | 226 | 227 | { TNBoxGradientStyle } 228 | 229 | procedure TNBoxGradientStyle.Apply(AGradient: TGradient); 230 | begin 231 | with AGradient do begin 232 | Color := Self.Colors[0]; 233 | color1 := self.Colors[1]; 234 | style := self.Style; 235 | StartPosition.Point := TPointF.Create(StartPos.X, StartPos.Y); 236 | StopPosition.Point := TPointF.Create(StopPos.X, StopPos.Y); 237 | end; 238 | end; 239 | 240 | constructor TNBoxGradientStyle.Create; 241 | begin 242 | Colors := [TAlphacolorrec.Black, TAlphacolorrec.White]; 243 | Style := TGradientStyle.Linear; 244 | StartPos := TNBoxPos.New(0, 0); 245 | StopPos := TNBoxPos.New(0, 0); 246 | end; 247 | 248 | { TNBoxBrushStyle } 249 | 250 | procedure TNBoxBrushStyle.Apply(ABrush: TBrush); 251 | begin 252 | Self.Gradient.Apply(ABrush.Gradient); 253 | ABrush.Color := Color; 254 | ABrush.Kind := Kind; 255 | end; 256 | 257 | constructor TNBoxBrushStyle.Create; 258 | begin 259 | Gradient := TNBoxGradientStyle.Create; 260 | Kind := TBrushKind.Gradient; 261 | Color := TAlphacolorrec.White; 262 | end; 263 | 264 | destructor TNBoxBrushStyle.Destroy; 265 | begin 266 | Gradient.Free; 267 | end; 268 | 269 | { TNBoxStrokeBrushStyle } 270 | 271 | procedure TNBoxStrokeBrushStyle.Apply(AStroke: TStrokeBrush); 272 | begin 273 | inherited Apply(AStroke as TBrush); 274 | AStroke.Thickness := self.Thickness; 275 | end; 276 | 277 | constructor TNBoxStrokeBrushStyle.Create; 278 | begin 279 | inherited; 280 | Self.Thickness := 2; 281 | end; 282 | 283 | { TNBoxFillAndStroke } 284 | 285 | procedure TNBoxFillAndStroke.Apply(AValue: TObject); 286 | begin 287 | with ( AValue as TAlRectangle ) do begin 288 | self.Fill.Apply(Fill); 289 | self.Stroke.Apply(Stroke); 290 | end; 291 | end; 292 | 293 | constructor TNBoxFillAndStroke.Create(AOwner: TObject); 294 | begin 295 | Owner := AOwner; 296 | Fill := TNBoxBrushStyle.Create; 297 | Stroke := TNBoxStrokeBrushStyle.Create; 298 | end; 299 | 300 | destructor TNBoxFillAndStroke.Destroy; 301 | begin 302 | Fill.Free; 303 | Stroke.Free; 304 | end; 305 | 306 | { TNBoxRectStyle } 307 | 308 | procedure TNBoxRectStyle.Apply(AValue: TObject); 309 | var 310 | StylingFinished: boolean; 311 | begin 312 | StylingFinished := false; 313 | 314 | if ( AValue is TRectButton ) then begin 315 | with ( AValue as TRectButton ) do begin 316 | 317 | self.Fill.Apply(FillDef); 318 | Self.Stroke.Apply(StrokeDef); 319 | Self.Fill2.Apply(FillMove); 320 | Self.Stroke2.Apply(StrokeMove); 321 | Image.Margins.Rect := ImageMargins.AsRect; 322 | 323 | if not ImageFilename.IsEmpty then begin 324 | if ( Self.Owner is TNBoxGUIStyle ) then begin 325 | Image.FileName := ( Self.Owner as TNBoxGUIStyle ) 326 | .GetImagePath(self.ImageFilename); 327 | end; 328 | end; 329 | 330 | StylingFinished := true; 331 | end; 332 | end else if ( AValue is TRectTextCheck ) then begin 333 | with ( AValue as TRectTextCheck ) do begin 334 | 335 | self.Fill.Apply(FillChecked); 336 | Self.Stroke.Apply(StrokeChecked); 337 | Self.Fill2.Apply(FillUnchecked); 338 | Self.Stroke2.Apply(StrokeUnchecked); 339 | 340 | StylingFinished := true; 341 | end; 342 | end; 343 | 344 | if ( AValue is TAlRectangle ) then begin 345 | With ( AValue as TAlRectangle ) do begin 346 | XRadius := self.XRadius; 347 | YRadius := self.YRadius; 348 | if not StylingFinished then begin 349 | Self.Fill.Apply(Fill); 350 | Self.Stroke.Apply(Stroke); 351 | end; 352 | end; 353 | end; 354 | 355 | end; 356 | 357 | constructor TNBoxRectStyle.Create(AOwner: TObject); 358 | begin 359 | Inherited; 360 | Owner := AOwner; 361 | ImageFilename := ''; 362 | ImageMargins := TRectRec.New(0, 0, 0, 0); 363 | Fill2 := TNBoxBrushStyle.Create; 364 | stroke2 := TNBoxStrokeBrushStyle.Create; 365 | XRadius := 0; 366 | YRadius := XRadius; 367 | end; 368 | 369 | destructor TNBoxRectStyle.Destroy; 370 | begin 371 | Fill2.Free; 372 | Stroke2.Free; 373 | inherited; 374 | end; 375 | 376 | { TNBoxPos } 377 | 378 | class function TNBoxPos.New(Ax, Ay: single): TNBoxPos; 379 | begin 380 | Result.X := Ax; 381 | Result.Y := Ay; 382 | end; 383 | 384 | { TNBoxTabStyle } 385 | 386 | procedure TNBoxTabStyle.Apply(AValue: TNboxTab); 387 | begin 388 | inherited Apply(AValue); 389 | Item.Apply(AValue.CloseBtn); 390 | end; 391 | 392 | procedure TNBoxTabStyle.Apply(AValue: TNBoxCheckButton); 393 | begin 394 | inherited Apply(AValue); 395 | Item.Apply(AValue.check); 396 | end; 397 | 398 | constructor TNBoxTabStyle.Create(AOwner: TObject); 399 | begin 400 | Inherited Create(AOwner); 401 | Item := TNBoxRectStyle.Create(AOwner); 402 | end; 403 | 404 | destructor TNBoxTabStyle.Destroy; 405 | begin 406 | Item.free; 407 | inherited; 408 | end; 409 | 410 | { TRectRec } 411 | 412 | function TRectRec.AsRect: TRectF; 413 | begin 414 | Result := TRectF.Create(Left, Top, right, bottom); 415 | end; 416 | 417 | class function TRectRec.New(ALeft, ATop, ARight, ABottom: single): TRectRec; 418 | begin 419 | with Result do begin 420 | Left := ALeft; 421 | Right := ARight; 422 | Bottom := ABottom; 423 | Top := ATop; 424 | end; 425 | end; 426 | 427 | { TNBoxEditStyle } 428 | 429 | procedure TNBoxEditStyle.Apply(AValue: TObject); 430 | begin 431 | inherited; 432 | if ( AValue is TNBoxEdit ) then begin 433 | with (AValue as TNBoxEdit) do begin 434 | Edit.FontColor := Self.FontColor; 435 | Edit.Font.Family := Self.FontName; 436 | Edit.Font.Size := Self.FontSize; 437 | XRadius := Self.XRadius; 438 | Yradius := Self.YRadius; 439 | end; 440 | end; 441 | end; 442 | 443 | constructor TNBoxEditStyle.Create(AOwner: TObject); 444 | begin 445 | inherited; 446 | FontName := 'Roboto'; 447 | FontSize := 12; 448 | FontColor := TAlphacolorrec.White; 449 | XRadius := 0; 450 | YRadius := 0; 451 | end; 452 | 453 | 454 | 455 | end. 456 | -------------------------------------------------------------------------------- /source/NsfwBoxThreading.pas: -------------------------------------------------------------------------------- 1 | //♡2022 by Kisspeace. https://github.com/kisspeace 2 | unit NsfwBoxThreading; 3 | 4 | interface 5 | uses 6 | System.SysUtils, System.Generics.Collections, 7 | IoUtils, System.Classes, system.SyncObjs, System.Threading; 8 | 9 | type 10 | 11 | TThreadComponentBase = class(TComponent) 12 | protected 13 | FIsWorkNow: boolean; 14 | FTask: ITask; 15 | FLock: TCriticalSection; 16 | function IsWorkingNow: boolean; 17 | procedure CreateTask; 18 | procedure StartTask; 19 | procedure StopTask; virtual; 20 | procedure WaitTask; 21 | procedure Execute; virtual; abstract; 22 | public 23 | property Lock: TCriticalSection read FLock; 24 | constructor Create(AOwner: TComponent); 25 | destructor Destroy; override; 26 | end; 27 | 28 | TQueuedThreadComponentBase = class(TThreadComponentBase) 29 | protected const 30 | DEFAULT_THREADS_COUNT: integer = 4; 31 | private 32 | procedure SetThreadsCount(const value: integer); 33 | function GetThreadsCount: integer; 34 | protected 35 | FTasks: TArray; 36 | FThreadsCount: integer; 37 | function RunningCount: integer; 38 | { this executes in locked criticalsec } 39 | function QueueCondition: boolean; virtual; abstract; 40 | function AutoRestartCondition: boolean; virtual; 41 | function NewSubTask: ITask; virtual; abstract; 42 | { !! } 43 | procedure Execute; override; 44 | public 45 | property ThreadsCount: integer read GetThreadsCount write SetThreadsCount; 46 | constructor Create(AOwner: TComponent); 47 | end; 48 | 49 | implementation 50 | uses unit1; 51 | 52 | { TThreadComponentBase } 53 | 54 | constructor TThreadComponentBase.Create(AOwner: TComponent); 55 | begin 56 | Inherited; 57 | FLock := TCriticalSection.Create; 58 | FIsWorkNow := false; 59 | CreateTask; 60 | end; 61 | 62 | procedure TThreadComponentBase.CreateTask; 63 | begin 64 | FTask := TTask.Create(procedure begin 65 | Flock.Enter; 66 | try 67 | FIsWorkNow := true; 68 | finally 69 | FLock.Leave; 70 | end; 71 | Self.Execute; 72 | end); 73 | end; 74 | 75 | destructor TThreadComponentBase.Destroy; 76 | begin 77 | StopTask; 78 | WaitTask; 79 | FLock.Free; 80 | inherited; 81 | end; 82 | 83 | function TThreadComponentBase.IsWorkingNow: boolean; 84 | begin 85 | FLock.Enter; 86 | try 87 | Result := Assigned(FTask) and FIsWorkNow; 88 | finally 89 | FLock.Leave; 90 | end; 91 | // Result := Assigned(FTask) 92 | // And ( FTask.Status <> TTaskStatus.Completed ) 93 | // And ( FTask.Status <> TTaskStatus.Canceled ) 94 | // And ( FTask.Status <> TTaskStatus.Created ); 95 | end; 96 | 97 | procedure TThreadComponentBase.StartTask; 98 | begin 99 | //if not Assigned(FTask) then 100 | CreateTask; 101 | FTask.Start; 102 | end; 103 | 104 | procedure TThreadComponentBase.StopTask; 105 | begin 106 | if IsWorkingNow then 107 | FTask.Cancel; 108 | end; 109 | 110 | procedure TThreadComponentBase.WaitTask; 111 | begin 112 | // if IsWorkingNow then begin 113 | // if ( TThread.Current.ThreadID = MainThreadId ) then begin 114 | // try 115 | // while not TTask.WaitForAll([FTask], 100) do 116 | // CheckSynchronize(10); 117 | // except 118 | // 119 | // end; 120 | // end; 121 | // end; 122 | while IsWorkingNow do begin 123 | if ( TThread.Current.ThreadID = MainThreadId ) then 124 | CheckSynchronize(10) 125 | else 126 | Sleep(10); 127 | end; 128 | end; 129 | 130 | { TQueuedThreadComponentBase } 131 | 132 | function TQueuedThreadComponentBase.AutoRestartCondition: boolean; 133 | begin 134 | Result := ( Self.QueueCondition ) 135 | and ( TTask.CurrentTask.Status <> TTaskStatus.Canceled ); 136 | end; 137 | 138 | constructor TQueuedThreadComponentBase.Create(AOwner: TComponent); 139 | begin 140 | Inherited; 141 | FTasks := []; 142 | FThreadsCount := DEFAULT_THREADS_COUNT; 143 | end; 144 | 145 | procedure TQueuedThreadComponentBase.Execute; 146 | const 147 | MICRO_SLEEP_TIME = 10; 148 | var 149 | I: integer; 150 | LNewTask: ITask; 151 | begin 152 | try 153 | try 154 | 155 | while ( TRUE ) do begin 156 | 157 | TTask.CurrentTask.CheckCanceled; 158 | 159 | While ( RunningCount >= Self.ThreadsCount ) do begin 160 | TTask.CurrentTask.CheckCanceled; 161 | Sleep(MICRO_SLEEP_TIME); 162 | end; 163 | 164 | FLock.Enter; 165 | try 166 | if ( not Self.QueueCondition ) then 167 | break; 168 | 169 | LNewTask := NewSubTask; 170 | FTasks := FTasks + [LNewTask]; 171 | LNewTask.Start; 172 | finally 173 | FLock.Leave; 174 | end; 175 | 176 | end; 177 | 178 | // waiting for end 179 | while ( RunningCount > 0 ) do begin 180 | TTask.CurrentTask.CheckCanceled; 181 | sleep(MICRO_SLEEP_TIME); 182 | end; 183 | 184 | finally 185 | try 186 | // Cancel all tasks 187 | for I := 0 to High(FTasks) do begin 188 | FTasks[I].Cancel; 189 | end; 190 | 191 | FLock.Enter; 192 | try 193 | if Self.AutoRestartCondition then 194 | Self.StartTask; 195 | finally 196 | FIsWorkNow := false; 197 | FLock.Leave; 198 | end; 199 | except 200 | On E: Exception do begin 201 | SyncLog(E, 'QueuedThread finally except: '); 202 | end; 203 | end; 204 | end; 205 | except 206 | 207 | On E: EOperationCancelled do begin 208 | // ignore 209 | end; 210 | 211 | on E: Exception do begin 212 | SyncLog(E, 'QueuedThread: '); 213 | end; 214 | 215 | end; 216 | end; 217 | 218 | function TQueuedThreadComponentBase.GetThreadsCount: integer; 219 | begin 220 | FLock.Enter; 221 | try 222 | Result := FThreadsCount; 223 | finally 224 | FLock.Leave; 225 | end; 226 | end; 227 | 228 | function TQueuedThreadComponentBase.RunningCount: integer; 229 | var 230 | I: integer; 231 | begin 232 | Result := 0; 233 | for I := 0 to high(FTasks) do begin 234 | if (FTasks[I].Status <> TTaskStatus.Completed) 235 | and (FTasks[I].Status <> TTaskStatus.Canceled) 236 | then 237 | Inc(Result); 238 | end; 239 | end; 240 | 241 | procedure TQueuedThreadComponentBase.SetThreadsCount(const value: integer); 242 | begin 243 | FLock.Enter; 244 | try 245 | FThreadsCount := value; 246 | finally 247 | FLock.Leave; 248 | end; 249 | end; 250 | 251 | end. 252 | -------------------------------------------------------------------------------- /source/SimpleClipboard.pas: -------------------------------------------------------------------------------- 1 | unit SimpleClipboard; 2 | 3 | interface 4 | Uses 5 | FMX.Platform, FMX.Clipboard; 6 | 7 | function CopyToClipboard(const AText: string): boolean; 8 | 9 | implementation 10 | 11 | function CopyToClipboard(const AText: string): boolean; 12 | var 13 | ClipBoard: IFMXExtendedClipboardService; 14 | begin 15 | if TPlatformServices.Current.SupportsPlatformService 16 | (IFMXExtendedClipboardService, clipboard) then 17 | begin 18 | ClipBoard.SetText(AText); 19 | Result := true; 20 | end else 21 | Result := false; 22 | end; 23 | 24 | end. 25 | -------------------------------------------------------------------------------- /source/bookmarks-db.sql: -------------------------------------------------------------------------------- 1 | --DROP TABLE IF EXISTS `items`; 2 | --DROP TABLE IF EXISTS `groups`; 3 | --DROP VIEW IF EXISTS `only_content`; 4 | --DROP VIEW IF EXISTS `only_requests`; 5 | 6 | -- bookmark groups 7 | CREATE TABLE `groups` ( 8 | `id` INTEGER PRIMARY KEY AUTOINCREMENT, 9 | `name` VARCHAR(255), 10 | `timestamp` DATETIME DEFAULT CURRENT_TIMESTAMP, 11 | `about` TEXT 12 | ); 13 | 14 | -- All bookmark items 15 | CREATE TABLE `items` ( 16 | `origin` INTEGER, 17 | `type` INTEGER, 18 | `about` TEXT, 19 | `timestamp` DATETIME DEFAULT CURRENT_TIMESTAMP, 20 | `object` JSON, 21 | `group_id` INTEGER DEFAULT 1, 22 | FOREIGN KEY(group_id) REFERENCES `groups` (id) 23 | ); 24 | 25 | -- bookmarks with content only 26 | CREATE VIEW `only_content` AS 27 | SELECT * FROM `items` WHERE (`type` = 0); 28 | 29 | -- bookmarks with search requests only 30 | CREATE VIEW `only_requests` AS 31 | SELECT * FROM `items` WHERE (`type` = 1); 32 | 33 | 34 | --------------------------------------------------------------------------------